Merge pull request #34 from RichardHooijmaijers/final_cran_refine

improve selection and add model to report
RichardHooijmaijers · Oct 18, 2024 · cbc39fb · cbc39fb
2 parents cad0bd4 + d7cf889
commit cbc39fb
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 4 deletions.
diff --git a/R/module_overview.R b/R/module_overview.R
@@ -86,7 +86,9 @@ module_overview_server <- function(id, r) {
       modalDialog(title="High level results",easyClose = TRUE,size="l",verbatimTextOutput(ns("res_out")))
     }
     hr_out <- eventReactive(input$hlr, {
-      sel   <- sort(names(r$proj_obj)[names(r$proj_obj)!="meta"])[input$overview_tbl_rows_selected]
+      #sel   <- sort(names(r$proj_obj)[names(r$proj_obj)!="meta"])[input$overview_tbl_rows_selected]
+      mdlc  <- overview(r$proj_obj)
+      sel   <- mdlc$models[sort(input$overview_tbl_rows_selected)][1] # make sure the first occured row is used (instead of first selected!)
       if(length(sel)>0){
         res <- try(readRDS(paste0(r$this_wd,"/shinyMixR/",sel[1],".res.rds")))
         if(!"try-error"%in%class(res)) print(res) else print("No results available")
@@ -105,7 +107,9 @@ module_overview_server <- function(id, r) {
     observeEvent(input$del,{showModal(delmodal())},ignoreInit = TRUE)
     observeEvent(input$del2,{
       if(!is.null(input$overview_tbl_rows_selected)){
-        msel <- sort(names(r$proj_obj)[names(r$proj_obj)!="meta"])[input$overview_tbl_rows_selected]
+        #msel <- sort(names(r$proj_obj)[names(r$proj_obj)!="meta"])[input$overview_tbl_rows_selected]
+        mdlc  <- overview(r$proj_obj)
+        msel  <- mdlc$models[input$overview_tbl_rows_selected]
         if(input$delmodall) {
           try(file.remove(paste0(r$this_wd,"/shinyMixR/",msel,".res.rds")))
           try(file.remove(paste0(r$this_wd,"/shinyMixR/",msel,".ressum.rds")))

diff --git a/R/module_reports.R b/R/module_reports.R
@@ -75,7 +75,7 @@ module_reports_server <- function(id, r) {
             ftr <- paste0(r$this_wd,"/analysis/",input$models,"/",sub("\\.html$",".html.rawhtml",input$results))
             ftr <- ftr[file.exists(ftr)]
             R3port::html_combine(list(ftr),out=paste0(r$this_wd,"/analysis/",input$models,"/",input$name,".html"),show=TRUE,
-                                template=paste0(system.file(package="R3port"),"/bootstrap.html"))
+                                template=paste0(system.file(package="shinyMixR"),"/other/bootstrap.htmltmpl"),rtitle = paste0("report: ",input$models))
           }
         }
       }else{

diff --git a/inst/other/combined.results.html.r b/inst/other/combined.results.html.r
@@ -31,6 +31,7 @@ lapply(files,function(x){
   try(R3port::html_plot(nlmixr2::vpcPlot(res,n=500,show=list(obs_dv=TRUE)),out=paste0(rootl,"/analysis/",mdln,"/06vpc.plot.html"),show=FALSE,title="VPC"))
 
   R3port::html_combine(combine=paste0(rootl,"/analysis/",mdln),out="report.html",show=TRUE,
-                       template=paste0(system.file(package="shinyMixR"),"/other/bootstrap.htmltmpl"),toctheme=TRUE)
+                       template=paste0(system.file(package="shinyMixR"),"/other/bootstrap.htmltmpl"),toctheme=TRUE, 
+                       rtitle = paste0("report:",x))
 })
 cat("Script done!\n")