RichardHooijmaijers · RichardHooijmaijers · May 14, 2024 · Apr 16, 2024 · Apr 16, 2024 · Apr 16, 2024
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,2 +1,9 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^\.github$
+^\.vscode$
+^LICENSE\.md$
+^_pkgdown\.yml$
+^pkgdown$
+^docs$
+^cran-comments\.md$
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,18 +1,19 @@
 Package: shinyMixR
-Title: Shiny dashboard interface for nlmixr and nlmixr2
-Version: 0.4.0
+Title: Interactive 'shiny' Dashboard for 'nlmixr2'
+Version: 0.5.0
 Authors@R: c(person("Richard", "Hooijmaijers", email = "richardhooijmaijers@gmail.com", role = c("aut", "cre","cph")),
              person("Teun", "Post", email = "teunpost@gmail.com",role = c("aut","cph")),
              person("LAPP Consultants",email = "info@lapp.nl", role=c("fnd","cph")),
              person("Matthew Fidler",role=c("ctb")))
 Author: Richard Hooijmaijers
 Maintainer: Richard Hooijmaijers <richardhooijmaijers@gmail.com>
-Description: The package is developed as an interface for the nlmixr and nlmixr2 package. Furthermore additional functions
-  are included to work with the nlmixr package through the command line
+Description: An interface for the 'nlmixr2' package. Furthermore additional functions
+  are included to work with the 'nlmixr2' package through the command line.
 Depends:
   R (>= 3.5.0),
   shiny,
-  ggplot2
+  ggplot2,
+  magrittr
 Imports:
   gridExtra,
   collapsibleTree,
@@ -37,7 +38,7 @@ Suggests:
     knitr,
     rmarkdown,
     rlang
-License: MIT+LICENSE
+License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.2.3

diff --git a/LICENSE.md b/LICENSE.md
@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2024 shinyMixR authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/NAMESPACE b/NAMESPACE
@@ -42,4 +42,58 @@ export(update_inits)
 import(bs4Dash)
 import(ggplot2)
 import(gridExtra)
+importFrom(magrittr,"%>%")
+importFrom(shiny,HTML)
+importFrom(shiny,NS)
+importFrom(shiny,br)
+importFrom(shiny,checkboxGroupInput)
+importFrom(shiny,checkboxInput)
+importFrom(shiny,conditionalPanel)
+importFrom(shiny,div)
+importFrom(shiny,em)
+importFrom(shiny,eventReactive)
+importFrom(shiny,exportTestValues)
+importFrom(shiny,fluidRow)
+importFrom(shiny,hr)
+importFrom(shiny,icon)
+importFrom(shiny,insertUI)
+importFrom(shiny,isTruthy)
+importFrom(shiny,isolate)
+importFrom(shiny,modalDialog)
+importFrom(shiny,moduleServer)
+importFrom(shiny,numericInput)
+importFrom(shiny,observe)
+importFrom(shiny,observeEvent)
+importFrom(shiny,plotOutput)
+importFrom(shiny,radioButtons)
+importFrom(shiny,reactive)
+importFrom(shiny,reactivePoll)
+importFrom(shiny,reactiveVal)
+importFrom(shiny,reactiveValues)
+importFrom(shiny,reactiveValuesToList)
+importFrom(shiny,removeModal)
+importFrom(shiny,removeUI)
+importFrom(shiny,renderPlot)
+importFrom(shiny,renderPrint)
+importFrom(shiny,renderText)
+importFrom(shiny,req)
 importFrom(shiny,runApp)
+importFrom(shiny,selectInput)
+importFrom(shiny,showModal)
+importFrom(shiny,sliderInput)
+importFrom(shiny,span)
+importFrom(shiny,tabPanel)
+importFrom(shiny,tagList)
+importFrom(shiny,tags)
+importFrom(shiny,textInput)
+importFrom(shiny,updateSelectInput)
+importFrom(shiny,updateSliderInput)
+importFrom(shiny,updateTabsetPanel)
+importFrom(shiny,updateTextInput)
+importFrom(shiny,verbatimTextOutput)
+importFrom(stats,na.omit)
+importFrom(stats,setNames)
+importFrom(utils,getParseData)
+importFrom(utils,installed.packages)
+importFrom(utils,read.csv)
+importFrom(utils,tail)
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# shinyMixR 0.5
+
+This version is a preview version of the package. The main changes are:
+
+- Refactoring of the code to remove global assignments and implement use of reactiveValues.
+- Added codecoverage to the package.
+- Added a new testing structure to the package including `shinytest2` for automated testing of the app.
+- Improved documentation to prepare for CRAN submission.
+
 # shinyMixR 0.4
 
 Within this version some updates have been implemented, see below the most important changes:

diff --git a/R/create_proj.r b/R/create_proj.r
@@ -16,15 +16,20 @@
 #'  create_proj()
 #' }
 create_proj <- function(loc=".", overwrite=FALSE){
+
+  loc <- paste0(loc, "/shinyMixR/app")
+
+  if(!dir.exists(loc)) dir.create(loc, recursive = TRUE)
+
   # First create the folder structure
-  dirs <- paste0(loc,c("/analysis","/data","/models","/shinyMixR","/scripts"))
+  dirs <- paste0(loc, c("/analysis","/data","/models","/shinyMixR","/scripts"))
   if(!all(dirs%in%list.files(loc,full.names = TRUE))){
     sapply(dirs,dir.create,showWarnings = FALSE,recursive=TRUE)
     # Now place in some default models and data
-    if(!file.exists(paste0(loc,"/models/run1.r")) | overwrite)      file.copy(paste0(system.file(package = "shinyMixR"),"/Other/run1.r"),paste0(loc,"/models/run1.r"))
-    if(!file.exists(paste0(loc,"/data/theo_sd.rds")) | overwrite)   file.copy(paste0(system.file(package = "shinyMixR"),"/Other/theo_sd.rds"),paste0(loc,"/data/theo_sd.rds"))
-    if(!file.exists(paste0(loc,"/scripts/eta.plot.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/Other/eta.plot.r"),paste0(loc,"/scripts/eta.plot.r"))
-    if(!file.exists(paste0(loc,"/scripts/vpc.plot.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/Other/vpc.plot.r"),paste0(loc,"/scripts/vpc.plot.r"))
-    if(!file.exists(paste0(loc,"/scripts/combined.results.html.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/Other/combined.results.html.r"),paste0(loc,"/scripts/combined.results.html.r"))
+    if(!file.exists(paste0(loc,"/models/run1.r")) | overwrite)      file.copy(paste0(system.file(package = "shinyMixR"),"/other/run1.r"),paste0(loc,"/models/run1.r"))
+    if(!file.exists(paste0(loc,"/data/theo_sd.rds")) | overwrite)   file.copy(paste0(system.file(package = "shinyMixR"),"/other/theo_sd.rds"),paste0(loc,"/data/theo_sd.rds"))
+    if(!file.exists(paste0(loc,"/scripts/eta.plot.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/other/eta.plot.r"),paste0(loc,"/scripts/eta.plot.r"))
+    if(!file.exists(paste0(loc,"/scripts/vpc.plot.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/other/vpc.plot.r"),paste0(loc,"/scripts/vpc.plot.r"))
+    if(!file.exists(paste0(loc,"/scripts/combined.results.html.r")) | overwrite) file.copy(paste0(system.file(package = "shinyMixR"),"/other/combined.results.html.r"),paste0(loc,"/scripts/combined.results.html.r"))
   }
 }
diff --git a/R/exploreplot.r b/R/exploreplot.r
@@ -27,11 +27,11 @@ exploreplot <- function(inputlist){
 
   # take into account that colour is used to map colour/fill and shape is used to map shape and linetype
   inputlist$attrl <- FALSE
-  if(inputlist$attrl==TRUE) {ggstr <- "dataIn <- assign_attr(dataIn,attrl)"}else{ggstr <- NULL} # paste(ggstr,"+\n ",lay1)
-  if(inputlist$subset=="" & inputlist$nondups=="")  ggstr <-  paste0(ggstr,"\n","ggplot(dataIn)")
-  if(inputlist$subset=="" & inputlist$nondups!="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(dataIn, !duplicated(",inputlist$nondups,")))")
-  if(inputlist$subset!="" & inputlist$nondups=="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(dataIn,",inputlist$subset,"))")
-  if(inputlist$subset!="" & inputlist$nondups!="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(dataIn, !duplicated(",inputlist$nondups,") & ",inputlist$subset,"))")
+  ggstr <- NULL
+  if(inputlist$subset=="" & inputlist$nondups=="")  ggstr <-  paste0(ggstr,"\n","ggplot(r$dataIn)")
+  if(inputlist$subset=="" & inputlist$nondups!="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(r$dataIn, !duplicated(",inputlist$nondups,")))")
+  if(inputlist$subset!="" & inputlist$nondups=="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(r$dataIn,",inputlist$subset,"))")
+  if(inputlist$subset!="" & inputlist$nondups!="")  ggstr <-  paste0(ggstr,"\n","ggplot(subset(r$dataIn, !duplicated(",inputlist$nondups,") & ",inputlist$subset,"))")
 
   addlay <- function(ageom,ayval,axval,agroup,acolour,ashape,asize,alabel,astats,afcol,afsize,afalph){
     if(astats!='[empty]' &  ageom%in%c("boxplot","bar","histogram","smooth","jitter","text")) stop("Stats can only be displayed as 'line' or 'point'")
@@ -65,11 +65,11 @@ exploreplot <- function(inputlist){
 	aess  <-  paste(paste(names(aess),aess,sep="="),collapse=", ")
 
 	if(astats%in%c("mean","median")){
-	  lay  <- paste0("stat_summary","(aes(",aess,"), fun.y=",astats,", geom='", ageom,"', ",argm,")")
+	  lay  <- paste0("stat_summary","(aes(",aess,"), fun=",astats,", geom='", ageom,"', ",argm,")")
 	}else if(astats=="mean (SD)"){
-	  lay  <- paste0("stat_summary","(aes(",aess,"), fun.y=mean, fun.ymin=function(x) mean(x) - sd(x), fun.ymax=function(x) mean(x) + sd(x), geom='errorbar', width = 0.2, ",argm,")")
+	  lay  <- paste0("stat_summary","(aes(",aess,"), fun=mean, funmin=function(x) mean(x) - sd(x), funmax=function(x) mean(x) + sd(x), geom='errorbar', width = 0.2, ",argm,")")
 	}else if(astats=="median (5-95th perc.)"){
-	  lay  <- paste0("stat_summary","(aes(",aess,"), fun.y=median, fun.ymin=function(x) quantile(x,0.05), fun.ymax=function(x) quantile(x,0.95), geom='errorbar', width = 0.2, ",argm,")")
+	  lay  <- paste0("stat_summary","(aes(",aess,"), fun=median, funmin=function(x) quantile(x,0.05), funmax=function(x) quantile(x,0.95), geom='errorbar', width = 0.2, ",argm,")")
 	}else{
 	  lay  <- paste0("geom_",ageom,"(aes(",aess,"), ",argm,")")
 	}
@@ -105,9 +105,9 @@ exploreplot <- function(inputlist){
   if(inputlist$facet1!='[empty]' & inputlist$facet2!='[empty]' & inputlist$facet3!='[empty]') fct <- paste0("~",inputlist$facet1,"+",inputlist$facet2,"+",inputlist$facet3)
   if(is.na(inputlist$ncol)){ncols <- NULL}else{ncols <- inputlist$ncol}
   if(!is.null(fct)) add <- c(add,fac=paste0("facet_wrap(",fct,",scales='",inputlist$facetsc,"', labeller=label_both, ncol=",ncols,")"))
-
-  xlb    <- ifelse(inputlist$xlab!="",inputlist$xlab, ifelse(inputlist$attrl==TRUE && !is.null(attrl) && !is.null(attrl[[inputlist$Xval1]]$label),attrl[[inputlist$Xval1]]$label,inputlist$Xval1))
-  ylb    <- ifelse(inputlist$ylab!="",inputlist$ylab, ifelse(inputlist$attrl==TRUE && !is.null(attrl) && !is.null(attrl[[inputlist$Yval1]]$label),attrl[[inputlist$Yval1]]$label,inputlist$Yval1))
+  
+  xlb    <- ifelse(inputlist$xlab != "", inputlist$xlab, inputlist$Xval1)
+  ylb    <- ifelse(inputlist$ylab != "", inputlist$ylab, inputlist$Yval1)
   if(ylb=="[empty]") ylb <- "Count" # y label could only be empty in case of histogram, otherwise y variable should be selected
   #if(inputlist$xlab!='') add <- c(add,xlab=paste0("xlab('",inputlist$xlab,"')"))
   #if(inputlist$ylab!='') add <- c(add,ylab=paste0("ylab('",inputlist$ylab,"')"))
@@ -116,9 +116,9 @@ exploreplot <- function(inputlist){
   if(inputlist$ptitle!='') add <- c(add,ggtitle=paste0("ggtitle('",inputlist$ptitle,"')"))
 
   # set manual color scale or fill in case one of the layers has colors (AND it is set as factor!!)
-  cond1 <- inputlist$colour1!='[empty]' & grepl(paste0("factor\\(dataIn.",inputlist$colour1),inputlist$precode)
-  cond2 <- inputlist$colour2!='[empty]' & grepl(paste0("factor\\(dataIn.",inputlist$colour2),inputlist$precode)
-  cond3 <- inputlist$colour3!='[empty]' & grepl(paste0("factor\\(dataIn.",inputlist$colour3),inputlist$precode)
+  cond1 <- inputlist$colour1!='[empty]' & grepl(paste0("factor\\(r$dataIn.",inputlist$colour1),inputlist$precode)
+  cond2 <- inputlist$colour2!='[empty]' & grepl(paste0("factor\\(r$dataIn.",inputlist$colour2),inputlist$precode)
+  cond3 <- inputlist$colour3!='[empty]' & grepl(paste0("factor\\(r$dataIn.",inputlist$colour3),inputlist$precode)
   cond4 <- inputlist$colour1!='[empty]' & inputlist$geoms1%in%c("boxplot","bar","histogram")
   cond5 <- inputlist$colour2!='[empty]' & inputlist$geoms2%in%c("boxplot","bar","histogram")
   cond6 <- inputlist$colour3!='[empty]' & inputlist$geoms3%in%c("boxplot","bar","histogram")

diff --git a/R/get_proj.r b/R/get_proj.r
@@ -14,29 +14,22 @@
 #'   proj <- get_proj()
 #' }
 get_proj <- function(projloc=".",geteval=TRUE){
-
+  
   # Read in models and place in result objects
-  dir.create(paste0(projloc,"/shinyMixR"),showWarnings = FALSE,recursive = TRUE)
-  mdln    <- normalizePath(list.files(paste0(projloc,"/models"),pattern="run[[:digit:]]*\\.[r|R]",full.names = TRUE))
+  dir.create(paste0(projloc,"/shinyMixR/app/shinyMixR"),showWarnings = FALSE,recursive = TRUE)
+  mdln    <- normalizePath(list.files(paste0(projloc,"/shinyMixR/app/models"),pattern="run[[:digit:]]*\\.[r|R]",full.names = TRUE))
   mdlnb   <- sub("\\.[r|R]","",basename(mdln))
-  sumres  <- normalizePath(list.files(paste0(projloc,"/shinyMixR"),pattern="run[[:digit:]]*\\.ressum\\.rds",full.names = TRUE))
+  sumres  <- normalizePath(list.files(paste0(projloc,"/shinyMixR/app/shinyMixR"),pattern="run[[:digit:]]*\\.ressum\\.rds",full.names = TRUE))
   sumresi <- file.info(sumres)
   summdli <- file.info(mdln)
-
+  
   # read in data folder (only in case objects are not yet present)
-  datf  <- list.files(paste0(projloc,"/data"))
+  datf  <- list.files(paste0(projloc,"/shinyMixR/app/data"))
   grepd <- " |^[[:digit:]]|\\!|\\#|\\$|\\%|\\&|\\'|\\(|\\)|\\-|\\;|\\=|\\@|\\[|\\]|\\^\\`\\{\\|\\}"
   if(any(grepl(grepd,datf))) warning("Data files with special characters found, take into acount that models that use these can crash")
-  # not relevant to read all data for running nlmixr in separate session (should be loaded in this session!)
-  lapply(list.files(paste0(projloc,"/data"),full.names = TRUE),function(x){
-    if(!grepl(grepd,x) & !exists(sub("\\.rds$|\\.csv$","",basename(x),ignore.case = TRUE),envir=.GlobalEnv)){
-      if(grepl("\\.rds$",x,ignore.case = TRUE)) assign(sub("\\.rds$","",basename(x),ignore.case = TRUE),readRDS(x),pos = .GlobalEnv)
-      if(grepl("\\.csv$",x,ignore.case = TRUE)) assign(sub("\\.csv$","",basename(x),ignore.case = TRUE),read.csv(x),pos = .GlobalEnv)
-    }
-  })
 
   # Read in models and results
-  if(!file.exists(paste0(projloc,"/shinyMixR/project.rds"))){
+  if(!file.exists(paste0(projloc,"/shinyMixR/app/shinyMixR/project.rds"))){
     mdls <- lapply(mdln,list)
     names(mdls) <- sub("\\.[r|R]","",basename(mdln))
     if(length(mdln)==0){
@@ -52,7 +45,7 @@ get_proj <- function(projloc=".",geteval=TRUE){
     for(i in sumres) mdls[[sub("\\.ressum\\.rds","",basename(i))]]$results <- readRDS(i)
     mdls$meta <- list(lastrefresh=Sys.time())
   }else{
-    mdls   <- readRDS(paste0(projloc,"/shinyMixR/project.rds"))
+    mdls   <- readRDS(paste0(projloc,"/shinyMixR/app/shinyMixR/project.rds"))
     # for the list with models, check if new models are available or old models are deleted
     # and if models are updated after last refresh:
     # inproj <- unlist(sapply(mdls[names(mdls)[names(mdls)!="meta"]],"[",1))
@@ -92,6 +85,6 @@ get_proj <- function(projloc=".",geteval=TRUE){
   chk       <- chk[which(chk$mdlsv>chk$ressv),]
   #if(nrow(chk)>0) noret <- apply(chk,1,function(x) cat("Be aware that model is saved after results for",x['mdl'],"\n"))
 
-  saveRDS(mdls,file=paste0(projloc,"/shinyMixR/project.rds"))
+  saveRDS(mdls,file=paste0(projloc,"/shinyMixR/app/shinyMixR/project.rds"))
   return(mdls)
 }
diff --git a/R/module_dataexplore.R b/R/module_dataexplore.R
@@ -148,23 +148,23 @@ module_dataexplore_server <- function(id, r) {
     # Adapt model list based on selected project location
     observeEvent(r$active_tab,{
       if(r$active_tab=="expl"){
-        updateSelectInput(session, "mdls", choices = names(get("proj_obj",pos = .GlobalEnv))[names(get("proj_obj",pos = .GlobalEnv))!="meta"],selected=input$mdls)
+        updateSelectInput(session, "mdls", choices = names(r$proj_obj)[names(r$proj_obj)!="meta"],selected=input$mdls)
       }
     },ignoreInit=TRUE)
 
-    # Select different model (for now assign in global environment)
+    # Select different model (store in reactive values object)
     updfunc <- function(){
       if(input$use_input){
-        assign("dataIn",try(readRDS(paste0("shinyMixR/",input$mdls[1],".res.rds"))$origData),envir=.GlobalEnv)  
+        r$dataIn <- try(readRDS(paste0("shinyMixR/",input$mdls[1],".res.rds"))$origData)
       }else{
-        assign("dataIn",try(as.data.frame(readRDS(paste0("shinyMixR/",input$mdls[1],".res.rds")))),envir=.GlobalEnv)          
+        r$dataIn <- try(as.data.frame(readRDS(paste0("shinyMixR/",input$mdls[1],".res.rds"))))
       }
-      if(!"try-error"%in%class(dataIn)){
+      if(!"try-error" %in% class(r$dataIn)){
         set1 <- paste0(c("Xval","Yval","group","colour","shape","size","label","facet"),rep(1:3,each=8))
         set1 <- lapply(set1,function(x) {
-          updateSelectInput(session,x,choices=c("[empty]",names(dataIn)),selected=ifelse(input[[x]]=="","[empty]",input[[x]]))
+          updateSelectInput(session,x,choices=c("[empty]",names(r$dataIn)),selected=ifelse(input[[x]]=="","[empty]",input[[x]]))
         })
-        updateSelectInput(session,"nondups",choices=c("",names(dataIn)),selected="")
+        updateSelectInput(session,"nondups",choices=c("",names(r$dataIn)),selected="")
       }
     }
     observeEvent(input$mdls,{updfunc()},ignoreInit=TRUE)
@@ -207,9 +207,9 @@ module_dataexplore_server <- function(id, r) {
     upDT  <- eventReactive(input$maketbl,{
       if(!is.null(input$mdls)){
         if(!is.null(input$precode) && input$precode!="")     eval(parse(text=input$precode))
-        if(!is.null(input$subset)  && input$subset!="")    eval(parse(text=paste0("dataIn <- subset(dataIn,",input$subset,")")))
-        if(!is.null(input$nondups)  && input$nondups!="")  eval(parse(text=paste0("dataIn <- subset(dataIn, !duplicated(",input$nondups,"))")))
-        dataIn
+        if(!is.null(input$subset)  && input$subset!="")    eval(parse(text=paste0("r$dataIn <- subset(r$dataIn,",input$subset,")")))
+        if(!is.null(input$nondups)  && input$nondups!="")  eval(parse(text=paste0("r$dataIn <- subset(r$dataIn, !duplicated(",input$nondups,"))")))
+        r$dataIn
       }
     })
     output$tableout <- DT::renderDT(upDT(),options=list(scrollX=TRUE,pageLength=100,lengthMenu=c(10,100,1000,10000)))  # Show entire dataset