Skip to content

Commit b33d27c

Browse files
Konrad1991Konrad1991
committed
put all processes into a background R process
1 parent 7488292 commit b33d27c

19 files changed

+1113
-904
lines changed

‎Direct_Test_App.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ library(jose)
2525
library(openssl)
2626
library(emmeans)
2727
Sys.setenv(RUN_MODE = "LOCAL")
28-
setwd("bs/R")
28+
if (!grepl("R", getwd())) setwd("bs/R")
29+
options(shiny.launch.browser = TRUE)
2930
files <- list.files(".")
3031
trash <- lapply(files, source)
3132
app <- app()

‎bs/R/DoseResponse.R‎

Lines changed: 51 additions & 100 deletions
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,8 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
5858
currentPage = 1,
5959
currentPageOverview = 1,
6060
outliers = NULL,
61-
df_dr = NULL
61+
df_dr = NULL,
62+
promise_result_name = NULL
6263
)
6364

6465
# Render names of substances
@@ -91,6 +92,7 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
9192
DoseResponseState$currentPageOverview <- 1
9293
DoseResponseState$outliers <- NULL
9394
DoseResponseState$df_dr <- NULL
95+
DoseResponseState$promise_result_name <- NULL
9496
}
9597

9698
check_dr <- function() {
@@ -100,12 +102,12 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
100102
req(!is.null(DataModelState$formula))
101103
}
102104

103-
run_dr <- function(df, outliers) {
105+
run_dr <- function(df, outliers, new_name) {
104106
dr <- dose_response_V1_2$new(
105107
df, outliers, input$xTransform, input$yTransform,
106108
input$substanceNames, DataModelState$formula
107109
)
108-
dr$eval(NULL)
110+
dr$eval(ResultsState, new_name)
109111
}
110112

111113
dr_complete <- function() {
@@ -114,54 +116,48 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
114116
reset_dr()
115117
resDF <- NULL
116118
resP <- NULL
117-
e <- try(
118-
{
119-
res <- run_dr(df, NULL)
120-
if (inherits(res, "try-error")) {
121-
m <- conditionMessage(attr(res, "condition"))
122-
stop(m)
123-
}
124-
resDF <- res[[1]]
125-
resP <- res[[2]]
126-
DoseResponseState$plots <- resP
127-
DoseResponseState$names <- resDF$name
128-
DoseResponseState$df_dr <- resDF
129-
overviewPlots <- create_plot_pages(resP)
130-
DoseResponseState$overview_plots <- overviewPlots
131-
},
132-
silent = TRUE
133-
)
134-
if (inherits(e, "try-error")) {
135-
err <- conditionMessage(attr(e, "condition"))
136-
reset_dr()
137-
output$dr_result <- renderTable(data.frame(), digits = 6)
138-
print_err(err)
139-
} else {
140-
output$dr_result <- renderTable(resDF, digits = 6)
141-
ResultsState$curr_data <- new("doseResponse", df = resDF, p = resP, outlier_info = "")
142-
ResultsState$curr_name <- paste(
143-
"Test Nr", length(ResultsState$all_names) + 1,
144-
"Conducted dose response analysis"
145-
)
146-
ResultsState$counter <- ResultsState$counter + 1
147-
new_result_name <- paste0("DoseResponseNr", ResultsState$counter)
148-
ResultsState$all_data[[new_result_name]] <- new(
149-
"doseResponse",
150-
df = resDF, p = resP, outlier_info = ""
151-
)
152-
exportTestValues(
153-
doseresponse_res = ResultsState$curr_data
154-
)
155-
ResultsState$history[[length(ResultsState$history) + 1]] <- list(
156-
type = "DoseResponse",
157-
"Column containing the names" = input$substanceNames,
158-
"Log transform x-axis" = input$xTransform,
159-
"Log transform y-axis" = input$yTransform,
160-
"formula" = deparse(DataModelState$formula),
161-
"Result name" = new_result_name
162-
)
119+
new_name <- paste0(ResultsState$counter + 1, " DoseResponse")
120+
e <- try(run_dr(df, NULL, new_name))
121+
if (!inherits(e, "try-error")) {
122+
DoseResponseState$promise_result_name <- new_name
163123
}
164124
}
125+
observe({
126+
if (!is.null(DoseResponseState$promise_result_name)) {
127+
invalidateLater(500)
128+
# TODO: requires check whether process is alive or died
129+
# Or even better when process throws an error the promise result name in DoseResponseState
130+
# should be set to NULL
131+
if (!is.null(ResultsState$all_data[[DoseResponseState$promise_result_name]])) {
132+
res <- ResultsState$all_data[[DoseResponseState$promise_result_name]]
133+
if (is.null(DoseResponseState$outliers)) {
134+
DoseResponseState$plots <- res@p
135+
DoseResponseState$names <- res@df$name
136+
DoseResponseState$df_dr <- res@df
137+
overviewPlots <- create_plot_pages(res@p)
138+
DoseResponseState$overview_plots <- overviewPlots
139+
DoseResponseState$promise_result_name <- NULL
140+
output$dr_result <- renderTable(res@df, digits = 6)
141+
} else {
142+
names <- DoseResponseState$names
143+
name <- DoseResponseState$names[DoseResponseState$currentPage]
144+
idx <- which(name == names)
145+
resDF <- res@df
146+
resP <- res@p
147+
old_plots <- DoseResponseState$plots
148+
old_df_dr <- DoseResponseState$df_dr
149+
old_plots[[idx]] <- resP[[1]]
150+
old_df_dr[idx, ] <- resDF
151+
DoseResponseState$plots <- old_plots
152+
DoseResponseState$df_dr <- old_df_dr
153+
overviewPlots <- create_plot_pages(DoseResponseState$plots)
154+
DoseResponseState$overview_plots <- overviewPlots
155+
DoseResponseState$promise_result_name <- NULL
156+
output$dr_result <- renderTable(DoseResponseState$df_dr, digits = 6)
157+
}
158+
}
159+
}
160+
})
165161

166162
observeEvent(input$ic50, {
167163
dr_complete()
@@ -222,68 +218,23 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
222218
outliers <- NULL
223219
e <- try(
224220
{
221+
new_name <- paste0(ResultsState$counter + 1, " DoseResponse")
225222
outliers <- list(DoseResponseState$outliers[[name]])
226223
names(outliers) <- name
227224
if (length(outliers[[name]]) == 0) {
228225
outliers <- list(NULL)
229226
names(outliers) <- name
230227
}
231-
res <- run_dr(df, outliers)
228+
res <- run_dr(df, outliers, new_name)
232229
if (inherits(res, "try-error")) {
233230
m <- conditionMessage(attr(res, "condition"))
234231
stop(m)
235232
}
236-
names <- DoseResponseState$names
237-
idx <- which(name == names)
238-
resDF <- res[[1]]
239-
resP <- res[[2]][[1]]
240-
old_plots <- DoseResponseState$plots
241-
old_df_dr <- DoseResponseState$df_dr
242-
old_plots[[idx]] <- resP
243-
old_df_dr[idx, ] <- resDF
244-
DoseResponseState$plots <- old_plots
245-
DoseResponseState$df_dr <- old_df_dr
246-
resP <- DoseResponseState$plots
247-
resDF <- DoseResponseState$df_dr
248-
overviewPlots <- create_plot_pages(resP)
249-
DoseResponseState$overview_plots <- overviewPlots
250-
check_rls(ResultsState$all_data, res)
251233
},
252234
silent = TRUE
253235
)
254-
if (inherits(e, "try-error")) {
255-
err <- conditionMessage(attr(e, "condition"))
256-
output$dr_result <- renderTable(data.frame(), digits = 6)
257-
print_err(err)
258-
} else {
259-
output$dr_result <- renderTable(resDF, digits = 6)
260-
ResultsState$curr_data <- new(
261-
"doseResponse",
262-
df = resDF, p = resP, outlier_info = create_outlier_info(DoseResponseState$outliers)
263-
)
264-
ResultsState$curr_name <- paste(
265-
"Test Nr", length(ResultsState$all_names) + 1,
266-
"Conducted dose response analysis"
267-
)
268-
ResultsState$counter <- ResultsState$counter + 1
269-
new_result_name <- paste0("DoseResponseNr", ResultsState$counter)
270-
ResultsState$all_data[[new_result_name]] <- new(
271-
"doseResponse",
272-
df = resDF, p = resP, outlier_info = create_outlier_info(DoseResponseState$outliers)
273-
)
274-
exportTestValues(
275-
doseresponse_res = ResultsState$curr_data
276-
)
277-
outliers <- list(DoseResponseState$outliers[[name]])
278-
ResultsState$history[[length(ResultsState$history) + 1]] <- list(
279-
type = "DoseResponse",
280-
"Column containing the names" = input$substanceNames,
281-
"Log transform x-axis" = input$xTransform,
282-
"Log transform y-axis" = input$yTransform,
283-
"formula" = deparse(DataModelState$formula),
284-
outliers = create_outlier_info(DoseResponseState$outliers),
285-
"Result name" = new_result_name
286-
)
236+
if (!inherits(e, "try-error")) {
237+
DoseResponseState$promise_result_name <- new_name
287238
}
288239
}
289240

@@ -296,8 +247,8 @@ DoseResponseServer <- function(id, DataModelState, ResultsState) {
296247
name_col <- input$substanceNames
297248
df <- DataModelState$df
298249
sub_df <- df[df[, name_col] == DoseResponseState$names[DoseResponseState$currentPage], ]
299-
f <- as.character(DataModelState$formula)
300-
formula <- DataModelState$formula
250+
f <- as.character(DataModelState$formula@formula)
251+
formula <- DataModelState$formula@formula
301252
check_formula(formula)
302253
dep <- f[2]
303254
indep <- f[3]

0 commit comments

Comments
 (0)