Merge pull request #44 from RichardHooijmaijers/final_cran_refine

fix all cran comments
RichardHooijmaijers · Nov 14, 2024 · 8e3cf71 · 8e3cf71
2 parents f82be2e + 4c613cf
commit 8e3cf71
Show file tree

Hide file tree

Showing 58 changed files with 143 additions and 34 deletions.
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
@@ -1,3 +1,3 @@
 Version: 0.5.0
-Date: 2024-11-11 14:52:47 UTC
-SHA: 6383cfbb58ebad20005d83d85265f7f010208320
+Date: 2024-11-12 15:06:04 UTC
+SHA: d52926094d51d21be79ff3d152278ffb53cb831b
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -6,8 +6,9 @@ Authors@R: c(person("Richard", "Hooijmaijers", email = "richardhooijmaijers@gmai
              person("LAPP Consultants",email = "info@lapp.nl", role=c("fnd","cph")),
              person("Matthew Fidler",role=c("ctb")),
              person("Veerle van Leemput",role=c("ctb")))
-Description: An interface for the 'nlmixr2' package. Furthermore additional functions
-  are included to work with the 'nlmixr2' package through the command line.
+Description: An R shiny user interface for the 'nlmixr2' (Fidler et al (2019) <doi:10.1002/psp4.12445>) package, 
+  designed to simplify the modeling process for users. Additionally, this package includes supplementary functions 
+  to further enhances the usage of 'nlmixr2'.
 Depends:
   R (>= 3.5.0),
   shiny,

diff --git a/R/fit_plot.r b/R/fit_plot.r
@@ -42,7 +42,7 @@ fit_plot <- function(dfrm,type="xpose",by="ID",idv="TIME",obs="DV",pred="PRED",i
 
   if(type=="xpose"){
     if((length(by)==1 && by!="ID") || length(by)>1 || idv!="TIME" || obs!="DV" || pred!="PRED" || ipred!="IPRED" || grp!="ID") stop("Changing variables does not work with xpose type of plots")
-    if("nlmixr2" %in% rownames(installed.packages())){
+    if(length(find.package("nlmixr2", quiet = TRUE))>0){
       xpdb <- xpose.nlmixr2::xpose_data_nlmixr2(dfrm)
     }else{
       stop("nlmixr2 package is not installed")

diff --git a/R/get_meta.r b/R/get_meta.r
@@ -6,6 +6,7 @@
 #' @param mdl character with the path of the model function
 #'
 #' @export
+#' @return A list with the models meta data
 #' @examples
 #'
 #' \dontrun{

diff --git a/R/get_proj.r b/R/get_proj.r
@@ -1,13 +1,14 @@
 #------------------------------------------ get_proj ------------------------------------------
 #' Read in and update model results in project object
 #'
-#' This function creates or updates a project object with models and/or results emerged from nlmixr runs
+#' This function creates or updates a project object with models and/or results emerged from nlmixr2 runs.
 #' A check is performed to see if newer results are present and only updates these.
 #'
 #' @param projloc character with the base location of the shinyMixR project
 #' @param geteval logical indicating if the model functions should be evaluated
 #'
 #' @export
+#' @return A named list with information for each model in the 'projloc'
 #' @examples
 #'
 #' \dontrun{

diff --git a/R/gof_plot.r b/R/gof_plot.r
@@ -34,7 +34,7 @@
 #' }
 gof_plot <- function(dfrm,type="xpose",mdlnm=NULL,colby=NULL,ptype="all",outnm=NULL,projloc=".",title=NULL,linscale=FALSE,...){
   if(type=="xpose" & !is.null(colby)) stop("Color by does not work with xpose type of plots")
-  if(type=="xpose" && "nlmixr2" %in% rownames(installed.packages())){
+  if(type=="xpose" && length(find.package("nlmixr2", quiet = TRUE))>0){
     dat <- xpose.nlmixr2::xpose_data_nlmixr2(dfrm)
   }else{
     dat <- as.data.frame(dfrm)

diff --git a/R/misc.r b/R/misc.r
@@ -5,6 +5,7 @@
 #' @param x a numerical vector
 #' @param sdig a single number defining the number of significant digits
 #' @export
+#' @return A character vector with formatted numbers
 sigdigs <- function(x,sdig=3){
   om <- floor(log10(abs(x)))
   dp <- sdig-om-1
@@ -20,6 +21,7 @@ sigdigs <- function(x,sdig=3){
 #' @param type character with the type of alert to display
 #' @param ... other arguments passed to class
 #' @export
+#' @return No return value, called for side effects
 myalert <- function(text,type,...){
   shinyWidgets::sendSweetAlert(text = text,type = type,
     showClass=list(backdrop='swal2-noanimation'),width="30%",
@@ -33,6 +35,7 @@ myalert <- function(text,type,...){
 #' This function provides a custom theme for ggplot output
 #' @param fontsize numeric with the default fontsize passed through to theme
 #' @export
+#' @return A list with ggplot theme elements
 theme_shinyMixR <- function(fontsize=12){
   ret <- theme_bw(base_size = fontsize) + 
     theme(panel.border     = element_rect(color="grey30", size=0.75),

diff --git a/R/module_dataexplore.R b/R/module_dataexplore.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_dataexplore_ui <- function(id) {
   ns <- NS(id)
   tagList(
@@ -143,6 +144,7 @@ module_dataexplore_ui <- function(id) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_dataexplore_server <- function(id, r) {
   moduleServer(id, function(input, output, session) {
 

diff --git a/R/module_edit.R b/R/module_edit.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_edit_ui <- function(id) {
   ns <- NS(id)
   tagList(
@@ -25,6 +26,7 @@ module_edit_ui <- function(id) {
 #' @param settings reactive value with the app settings
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_edit_server <- function(id, r, settings) {
   moduleServer(id, function(input, output, session) {
     # Adapt model list based on selected project location

diff --git a/R/module_fitplots.R b/R/module_fitplots.R
@@ -7,6 +7,7 @@
 #' @param proj_obj Project object
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_fitplots_ui <- function(id, proj_obj) {
   ns <- NS(id)
   tagList(
@@ -42,6 +43,7 @@ module_fitplots_ui <- function(id, proj_obj) {
 #' @param settings reactive value with the app settings
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_fitplots_server <- function(id, r, settings) {
   moduleServer(id, function(input, output, session) {
     # Adapt model list based on selected project location

diff --git a/R/module_gof.R b/R/module_gof.R
@@ -7,6 +7,7 @@
 #' @param proj_obj Project object
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_gof_ui <- function(id, proj_obj) {
   ns <- NS(id)
   tagList(
@@ -36,6 +37,7 @@ module_gof_ui <- function(id, proj_obj) {
 #' @param settings reactive value with the app settings
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_gof_server <- function(id, r, settings) {
   moduleServer(id, function(input, output, session) {
     # Adapt model list based on selected project location

diff --git a/R/module_metadata.R b/R/module_metadata.R
@@ -7,6 +7,7 @@
 #' @param type character with the type of button to present (either "save" or "overview")
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_metadata_ui <- function(id,type) {
   ns  <- NS(id)
   lbl <- ifelse(type=="save","Save as","Adapt meta data") 
@@ -25,6 +26,7 @@ module_metadata_ui <- function(id,type) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return a reactive with the meta data information
 module_metadata_server <- function(id,type,selline=NULL,sellmod=NULL,sellcont=NULL,r){
   moduleServer(id, function(input, output, session){
 

diff --git a/R/module_overview.R b/R/module_overview.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_overview_ui <- function(id) {
   ns <- NS(id)
   tagList(
@@ -33,6 +34,7 @@ module_overview_ui <- function(id) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_overview_server <- function(id, r) {
   moduleServer(id, function(input, output, session){
 

diff --git a/R/module_partable.R b/R/module_partable.R
@@ -7,6 +7,7 @@
 #' @param proj_obj Project object
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_pt_ui <- function(id, proj_obj) {
   ns <- NS(id)
   tagList(
@@ -29,6 +30,7 @@ module_pt_ui <- function(id, proj_obj) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_pt_server <- function(id, r) {
   moduleServer(id, function(input, output, session) {
     # Adapt model list based on selected project location

diff --git a/R/module_reports.R b/R/module_reports.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_reports_ui <- function(id) {
   ns <- NS(id)
   actionButton(ns("createreport"), label = "Create report",icon=icon("book"))
@@ -17,6 +18,7 @@ module_reports_ui <- function(id) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_reports_server <- function(id, r) {
   moduleServer(id,function(input, output, session) {
     # Function for the modal

diff --git a/R/module_run.R b/R/module_run.R
@@ -7,6 +7,7 @@
 #' @param proj_obj Project object
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_run_ui <- function(id, proj_obj) {
   ns <- NS(id)
   tagList(
@@ -25,6 +26,7 @@ module_run_ui <- function(id, proj_obj) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_run_server <- function(id, r) {
   moduleServer(id, function(input, output, session) {
 

diff --git a/R/module_scripts.R b/R/module_scripts.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_scripts_ui <- function(id) {
   ns <- NS(id)
   actionButton(ns("runscript"), label = "Run Script",icon=icon("code"))
@@ -19,6 +20,7 @@ module_scripts_ui <- function(id) {
 #' @param r reactive values object that is defined top-level
 #' 
 #' @export
+#' @return No return value, called for side effects
 module_scripts_server <- function(id, files=NULL, loc="temp", r) {
   # Decided that the files and script arguments should contain the path as well 
   # In the end the modal will show the basenames but on the background the entire 

diff --git a/R/module_settings.R b/R/module_settings.R
@@ -6,6 +6,7 @@
 #' @param id Module id
 #' 
 #' @export
+#' @return A list of html tags used for th UI of the app
 module_settings_ui <- function(id) {
   ns <- NS(id)
   tagList(
@@ -22,6 +23,7 @@ module_settings_ui <- function(id) {
 #' @param id Module id
 #' 
 #' @export
+#' @return a reactive with all input elements
 module_settings_server <- function(id) {
   moduleServer(id,function(input, output, session) {
     ret <- reactive({reactiveValuesToList(input)})

diff --git a/R/run_nmx.r b/R/run_nmx.r
@@ -34,7 +34,7 @@ run_nmx <- function(mod,proj=proj,ext=TRUE,saverds=TRUE,autoupdate=TRUE,projloc=
   sret <- try(source(proj[[mod]]$model,local=TRUE))
   meta <- suppressMessages(try(eval(parse(text=c("nlmixr2::nlmixr(",readLines(proj[[mod]]$model),")$meta"))),silent=TRUE))
   if(inherits(meta, "try-error") || inherits(sret, "try-error")){
-    cat("Error in model syntax please check before running\n")
+    warning("Error in model syntax please check before running\n")
     if(ext) writeLines(meta, paste0(projloc,"/shinyMixR/temp/",mod,".prog.txt"))
     return()
   }
@@ -75,7 +75,7 @@ run_nmx <- function(mod,proj=proj,ext=TRUE,saverds=TRUE,autoupdate=TRUE,projloc=
     data <- readRDS(paste0(projloc,"/data/", meta$data, ".rds"))
     if(!is.null(meta$subs) && meta$subs!="") data_nlm <- subset(data,eval(parse(text=(meta$subs)))) else data_nlm <- data
     modres  <- nlmixr2::nlmixr(eval(parse(text=readLines(proj[[mod]]$model))), data_nlm, est=meta$est,control=meta$control,nlmixr2::tableControl(cwres=addcwres, npde=addnpde))
-    if("nlmixr2" %in% rownames(installed.packages())){
+    if(length(find.package("nlmixr2", quiet = TRUE))>0){
       ressum  <- list(OBJF=modres$objective,CONDNR=modres$conditionNumberCor,partbl=modres$parFixedDf,partblf=modres$parFixed,omega=modres$omega,tottime=rowSums(modres$time))
     }else{
       ressum  <- list(OBJF=modres$objective,partbl=modres$popDf,partblf=modres$par.fixed,omega=modres$omega,tottime=rowSums(modres$time))

diff --git a/R/run_shinymixr.r b/R/run_shinymixr.r
@@ -14,7 +14,7 @@
 #' updateTextInput verbatimTextOutput shinyApp invalidateLater debounce outputOptions stopApp
 #' @import bs4Dash ggplot2 gridExtra
 #' @export
-#' @return runs the shinyMixR interface
+#' @return No return value, runs the shinyMixR interface
 #' @author Richard Hooijmaijers
 #' @examples
 #'

diff --git a/R/shinymixr_gadget.R b/R/shinymixr_gadget.R
@@ -2,7 +2,7 @@
 #' Rstudio gadget to select project and start app
 #'
 #' @export
-#' @return runs the shinyMixR interface
+#' @return No return value, runs a gadget to start the shinyMixR interface
 #' @author Richard Hooijmaijers
 #' @examples
 #'

diff --git a/inst/installation/install_fun.r b/inst/installation/install_fun.r
@@ -2,9 +2,9 @@
 # if packages can be loaded and models can be correctly submitted
 install_fun <- function(pkg=TRUE,test=TRUE){
   sect    <- function(txt) paste(paste0(rep("-",40),collapse = ""),txt,paste0(rep("-",40),collapse = ""))
-  cat("------------- Start installation function (Make sure all R sessions are closed!)...\n")
+  message("------------- Start installation function (Make sure all R sessions are closed!)...\n")
   if(pkg){
-    cat("------------- Installing all necessary R packages (this could take a while, please ignore warnings here)...\n")
+    message("------------- Installing all necessary R packages (this could take a while, please ignore warnings here)...\n")
     # Install regular pacakges first, then delete all possible nlmixr2 related packages (and reinstall clean version 3.0.0)
     ins1 <- try(install.packages('devtools', dependencies = TRUE,repos='https://cloud.r-project.org', quiet=TRUE), silent=TRUE)
     ins2 <- try(install.packages('xpose.nlmixr2', dependencies = FALSE, repos='https://cloud.r-project.org', quiet=TRUE), silent=TRUE)
@@ -25,7 +25,7 @@ install_fun <- function(pkg=TRUE,test=TRUE){
                 sect("R package installation - n1qn1c"),ins7, sect("R package installation - dparser"),ins8)
   }
   if(test){
-    cat("------------- Testing the installation (this could take a while)...\n")
+    message("------------- Testing the installation (this could take a while)...\n")
     tst1 <- suppressWarnings(system2("Rscript", "-e \"library(nlmixr2)\"", stdout=TRUE, stderr=TRUE))
     tst2 <- suppressWarnings(system2("Rscript", "-e \"library(shinyMixR)\"", stdout=TRUE, stderr=TRUE))
     try({
@@ -58,7 +58,7 @@ install_fun <- function(pkg=TRUE,test=TRUE){
   allres <- c(allres,"\n\n",capture.output(sessionInfo()))
   writeLines(allres,paste0(path.expand('~'),"/InstallationResults.log"))
 
-  cat(paste0("------------- Done! Results for the test can be found here: ",paste0(path.expand('~'),"/InstallationResults.log"),
-             "\nPlease mail this file to r.hooijmaijers@lapp.nl (please ignore warnings below) \n\n\n\n\n"))
+  message(paste0("------------- Done! Results for the test can be found here: ",paste0(path.expand('~'),"/InstallationResults.log"),
+                 "\nPlease mail this file to r.hooijmaijers@lapp.nl (please ignore warnings below) \n\n\n\n\n"))
 
 }
diff --git a/inst/other/combined.results.html.r b/inst/other/combined.results.html.r
@@ -1,4 +1,4 @@
-#files <- c("G:/Computerised systems/R/Packages/shinyMixR/Testing/Appwithmodules/dummy project 1/models/run1.r")
+# files <- c("~/dummy project 1/models/run1.r")
 # Script to create combined results
 library(xpose.nlmixr2)
 library(shinyMixR)
@@ -34,4 +34,4 @@ lapply(files,function(x){
                        template=paste0(system.file(package="shinyMixR"),"/other/bootstrap.htmltmpl"),toctheme=TRUE, 
                        rtitle = paste0("report:",x))
 })
-cat("Script done!\n")
+message("Script done!\n")
diff --git a/inst/other/eta.plot.arg.r b/inst/other/eta.plot.arg.r
@@ -16,4 +16,4 @@ lapply(files,function(x){
     R3port::html_plot(pll,out=paste0(rootl,"/analysis/",mdln,"/hist.eta.html"),show=FALSE,title="ETA distribution")
   }
 })
-cat("Script done!\n")
+message("Script done!\n")
diff --git a/inst/other/eta.plot.r b/inst/other/eta.plot.r
@@ -15,4 +15,4 @@ lapply(files,function(x){
     R3port::html_plot(pll,out=paste0(rootl,"/analysis/",mdln,"/hist.eta.html"),show=FALSE,title="ETA distribution")
   }
 })
-cat("Script done!\n")
+message("Script done!\n")
diff --git a/inst/other/run_nmx.tmp b/inst/other/run_nmx.tmp
@@ -1,9 +1,9 @@
-if("nlmixr2" %in% rownames(installed.packages())){
+if(length(find.package("nlmixr2", quiet = TRUE))>0){
   library(nlmixr2)
-}else if("nlmixr" %in% rownames(installed.packages())){
+}else if(length(find.package("nlmixr", quiet = TRUE))>0){
   library(nlmixr)
 }else{
-  cat("You need either the 'nlmixr' or 'nlmixr2' package to run models. This step will crash\n")
+  warning("You need either the 'nlmixr' or 'nlmixr2' package to run models. This step will crash\n")
 }
 options(keep.source = TRUE)
 if(!exists("{{{data}}}", envir=.GlobalEnv)) {
@@ -28,7 +28,7 @@ modres <- try(nlmixr2::nlmixr({{{modelname}}}, data=data_nlm, est="{{{est}}}",co
 {{#saveres}}
 if(length(class(modres))>1 && !"try-error"%in%class(modres)){
   saveRDS(modres,file="../{{{modelname}}}.res.rds")
-  if("nlmixr2" %in% rownames(installed.packages())){
+  if(length(find.package("nlmixr2", quiet = TRUE))>0){
     saveRDS(list(OBJF=modres$objective,CONDNR=modres$conditionNumberCor,partbl=modres$parFixedDf,partblf=modres$parFixed,omega=modres$omega,
                  tottime=rowSums(modres$time)),file="../{{{modelname}}}.ressum.rds")
   }else{

diff --git a/inst/other/vpc.plot.r b/inst/other/vpc.plot.r
@@ -7,10 +7,10 @@ lapply(files,function(x){
   rootl <- normalizePath(paste0(dirname(x),"/../"),winslash = "/")
   res   <- readRDS(paste0(rootl,"/shinyMixR/",mdln,".res.rds"))
   dir.create(paste0(rootl,"/analysis/",mdln),showWarnings=FALSE)
-  if("nlmixr2" %in% rownames(installed.packages())){
+  if(length(find.package("nlmixr2", quiet = TRUE))>0){
     try(R3port::html_plot(nlmixr2plot::vpcPlot(res,n=500,show=list(obs_dv=TRUE)),out=paste0(rootl,"/analysis/",mdln,"/vpc.plot.html"),show=FALSE,title="VPC"))
   }else{
     try(R3port::html_plot(nlmixr::vpc(res,nsim=500,show=list(obs_dv=TRUE)),out=paste0(rootl,"/analysis/",mdln,"/vpc.plot.html"),show=FALSE,title="VPC"))
   }
 })
-cat("Script done!\n")
+message("Script done!\n")