55# '
66# ' @param id Module id
77# ' @param proj_obj Project object
8- # '
8+ # '
99# ' @export
1010# ' @return A list of html tags used for th UI of the app
1111module_run_ui <- function (id , proj_obj ) {
@@ -16,22 +16,22 @@ module_run_ui <- function(id, proj_obj) {
1616 actionButton(ns(" monMdl" " Monitor Model(s)" icon = icon(" play"
1717 checkboxGroupInput(ns(" addExtra" label = NULL ,choices = c(" Add CWRES to output" " Add NPDE to output" selected = c(" Add CWRES to output" " Add NPDE to output" inline = TRUE ),
1818 div(verbatimTextOutput(ns(" progrTxt" class = " card card-body bg-light p-0" id = " progph"
19-
19+
2020 )
2121}
2222# ------------------------------------------ module_run_server ------------------------------------------
2323# ' Run model module for server
24- # '
24+ # '
2525# ' @param id Module id
2626# ' @param r reactive values object that is defined top-level
27- # '
27+ # '
2828# ' @export
2929# ' @return No return value, called for side effects
3030module_run_server <- function (id , r ) {
3131 moduleServer(id , function (input , output , session ) {
32-
32+
3333 # print("Im here")
34- # Adapt/update model list
34+ # Adapt/update model list
3535 observeEvent(r $ active_tab ,{
3636 if (r $ active_tab == " run"
3737 updateSelectInput(session , " runLst" choices = sort(names(r $ proj_obj )[names(r $ proj_obj )!= " meta" selected = input $ runmod_runLst )
@@ -46,7 +46,7 @@ module_run_server <- function(id, r) {
4646 proj <- r $ proj_obj
4747 checkall <- unlist(sapply(input $ runLst ,function (x ){
4848 chk <- proj [[x ]]$ model
49- chkdat <- proj [[x ]]$ modeleval $ meta $ data
49+ chkdat <- proj [[x ]]$ modeleval $ meta $ data
5050 chksrc <- try(source(chk ,local = TRUE ),silent = TRUE )
5151 if (" try-error" %in% class(chksrc )){
5252 return (" syntax error within model file"
@@ -77,54 +77,54 @@ module_run_server <- function(id, r) {
7777 myalert(" Please select models to run" type = " error"
7878 }
7979 })
80-
80+
8181 runmodmonit <- reactive({
82-
82+
8383 progFn <- list.files(paste0(r $ this_wd ," /shinyMixR/temp" pattern = " prog\\ .txt$" full.names = TRUE )
8484 txt <- lapply(progFn ,function (x ) c(paste0(" \n ***************" x ," ***************" x , warn = FALSE )))
85-
85+
8686 if (r $ models_running > 0 ) {
87-
87+
8888 invalidateLater(1000 , session )
89-
89+
9090 if (any(grepl(" run finished" txt ))) {
9191
9292 finished_models <- progFn [which(grepl(" run finished" txt ))]
93-
93+
9494 if (! all(finished_models %in% r $ finished_models )) {
95-
95+
9696 print(sprintf(" %s model(s) finished running" finished_models )))
97-
97+
9898 r $ finished_models <- c(isolate(r $ finished_models ), finished_models )
9999 r $ models_running <- length(setdiff(progFn , finished_models ))
100100 r $ model_updated <- isolate(r $ model_updated ) + 1
101-
101+
102102 exportTestValues(
103103 model_updated = r $ model_updated
104104 )
105105 }
106106 }
107-
107+
108108 return (paste(unlist(txt ), collapse = " \n "
109-
109+
110110 } else {
111111 return (paste(unlist(txt ), collapse = " \n "
112112 }
113113 })
114-
114+
115115 output $ progrTxt <- renderText(runmodmonit())
116-
116+
117117 model_updated_d <- debounce(reactive(r $ model_updated ), millis = 1000 )
118-
118+
119119 observe({
120120 req(model_updated_d() > 0 )
121121 r $ proj_obj <- get_proj(r $ this_wd )
122122 })
123-
123+
124124 # Disable suspend for output$myplot, otherwise necessary reactives
125125 # don't trigger when user is not on this tab anymore
126126 outputOptions(output , " progrTxt" suspendWhenHidden = FALSE )
127-
127+
128128 # Monitor all external runs
129129 rv <- reactiveValues(montbl = NULL )
130130 monmodal <- function (){
@@ -141,11 +141,11 @@ module_run_server <- function(id, r) {
141141 if (any(grepl(" shinyMixR/temp/script" cmd )) & ! any(grepl(" prog\\ .txt" cmd ))){
142142 scrf <- sub(" --file=" " " cmd [grepl(" shinyMixR/temp/script" cmd )])
143143 scrf <- try(readLines(scrf ),silent = TRUE )
144- # runin <- grepl("modres <- try\\(nlmixr\\(",scrf)
145- runin <- grepl(" modres <- try\\ (nlmixr2 ::nlmixr\\ (" scrf )
144+ # runin <- grepl("modres <- try\\(nlmixr\\(",scrf)
145+ runin <- grepl(" modres <- try\\ (nlmixr2est ::nlmixr\\ (" scrf )
146146 if (any(runin )){
147147 # modf <- gsub("modres <- try\\(nlmixr\\(|,.*","",scrf[runin])
148- modf <- gsub(" modres <- try\\ (nlmixr2 ::nlmixr\\ (|,.*" " " scrf [runin ])
148+ modf <- gsub(" modres <- try\\ (nlmixr2est ::nlmixr\\ (|,.*" " " scrf [runin ])
149149 tim <- try(ps :: ps_cpu_times(x )[" user" silent = TRUE )
150150 pid <- try(ps :: ps_pid(x ), silent = TRUE )
151151 if (! inherits(tim ," try-error" && ! inherits(pid ," try-error"
@@ -166,7 +166,7 @@ module_run_server <- function(id, r) {
166166 output $ mon_out <- DT :: renderDT(hr_out())
167167 observeEvent(input $ monMdl ,{showModal(monmodal())},ignoreInit = TRUE )
168168 observeEvent(input $ killMdl ,{
169- pid <- rv $ montbl [input $ mon_out_rows_selected ,]
169+ pid <- rv $ montbl [input $ mon_out_rows_selected ,]
170170 try(tools :: pskill(pid ))
171171 removeModal()
172172 },ignoreInit = TRUE )
0 commit comments