lintr requests

Merge branch '698-improve-test-coverage-in-design-methodsr' of github.com:Roche/crmPack into 698-improve-test-coverage-in-design-methodsr # Conflicts: # tests/testthat/test-Design-methods.R
openpharma · Oct 11, 2023 · c8b26d8 · c8b26d8
2 parents fff28d6 + 5165ab0
commit c8b26d8
Show file tree

Hide file tree

Showing 32 changed files with 592 additions and 473 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -99,6 +99,7 @@ Collate:
     'Samples-validity.R'
     'Samples-class.R'
     'mcmc.R'
+    'Simulations-validity.R'
     'Simulations-class.R'
     'helpers_rules.R'
     'Model-methods.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export("%~%")
 export(.CohortSizeConst)
 export(.CohortSizeDLT)
 export(.CohortSizeMax)
@@ -342,7 +341,6 @@ export(maxDose)
 export(maxSize)
 export(mcmc)
 export(minSize)
-export(multiplot)
 export(nextBest)
 export(ngrid)
 export(plotDualResponses)
@@ -522,9 +520,6 @@ importFrom(graphics,lines)
 importFrom(graphics,matlines)
 importFrom(graphics,matplot)
 importFrom(graphics,plot)
-importFrom(grid,grid.newpage)
-importFrom(grid,pushViewport)
-importFrom(grid,viewport)
 importFrom(gridExtra,arrangeGrob)
 importFrom(kableExtra,add_footnote)
 importFrom(kableExtra,add_header_above)

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,5 @@
 # Version 1.0.9000.9133
+* Removed `multiplot` function.  Use Please use equivalent functionality in other packages, such as `cowplot` or `ggpubr`.
 * Added new `DataGrouped` and `DesignGrouped` classes with corresponding model `LogisticLogNormalGrouped` to support simultaneous dose escalation with monotherapy and combination therapy arms.
 * Created the `CrmPackClass` class as the ultimate ancestor of all other 
 `crmPack` classes to allow identification of crmPack classes and simpler 
@@ -58,6 +59,8 @@ usable instances of all concrete subclasses of `Increments`, `Model`, `NextBest`
 * Include rolling CRM design, which was previously only available in a separate
   GitHub branch.
 * Additional authors and change of maintainer.
+* Included 'additional_stats' to add reporting of additional parameters to method simulate to summarize MTD.
+* 'report_label' can be added to stopping rules for individual or combined stopping rule reporting.
 
 # Version 1.0.0
 

diff --git a/R/Design-methods.R b/R/Design-methods.R
@@ -38,6 +38,9 @@ NULL
 ##' @param nCores how many cores should be used for parallel computing?
 ##' Defaults to the number of cores on the machine, maximum 5.
 ##' @param \dots not used
+##' @param derive a named list of functions which derives statistics, based on the
+##' vector of posterior MTD samples. Each list element must therefore accept
+##' one and only one argument, which is a numeric vector, and return a number.
 ##'
 ##' @return an object of class \code{\linkS4class{Simulations}}
 ##'
@@ -57,7 +60,7 @@ setMethod("simulate",
              truth, args = NULL, firstSeparate = FALSE,
              mcmcOptions = McmcOptions(),
              parallel = FALSE, nCores =
-               min(parallel::detectCores(), 5L),
+               min(parallel::detectCores(), 5), derive = list(),
              ...) {
       ## checks and extracts
       assert_function(truth)
@@ -259,6 +262,18 @@ setMethod("simulate",
           data = thisData
         )
 
+        # Get the MTD estimate from the samples.
+
+        target_dose_samples <- dose(
+          mean(object@nextBest@target),
+          model = object@model,
+          samples = thisSamples
+        )
+
+        # Create a function for additional statistical summary.
+
+        additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+
         ## return the results
         thisResult <-
           list(
@@ -273,7 +288,8 @@ setMethod("simulate",
                 stopit,
                 "message"
               ),
-            report_results = stopit_results
+            report_results = stopit_results,
+            additional_stats = additional_stats
           )
         return(thisResult)
       }
@@ -313,13 +329,17 @@ setMethod("simulate",
       stopResults <- lapply(resultList, "[[", "report_results")
       stop_matrix <- as.matrix(do.call(rbind, stopResults))
 
+      # Result list of additional statistical summary.
+      additional_stats <- lapply(resultList, "[[", "additional_stats")
+
       ## return the results in the Simulations class object
       ret <- Simulations(
         data = dataList,
         doses = recommendedDoses,
         fit = fitList,
         stop_report = stop_matrix,
         stop_reasons = stopReasons,
+        additional_stats = additional_stats,
         seed = RNGstate
       )
 
@@ -528,6 +548,9 @@ setMethod("simulate",
 ##' @param nCores how many cores should be used for parallel computing?
 ##' Defaults to the number of cores on the machine, maximum 5.
 ##' @param \dots not used
+##' @param derive a named list of functions which derives statistics, based on the
+##' vector of posterior MTD samples. Each list element must therefore accept
+##' one and only one argument, which is a numeric vector, and return a number.
 ##'
 ##' @return an object of class \code{\linkS4class{DualSimulations}}
 ##'
@@ -546,7 +569,7 @@ setMethod("simulate",
              mcmcOptions = McmcOptions(),
              parallel = FALSE,
              nCores =
-               min(parallel::detectCores(), 5L),
+               min(parallel::detectCores(), 5), derive = list(),
              ...) {
       ## checks and extracts
       assert_function(trueTox)
@@ -837,6 +860,19 @@ setMethod("simulate",
           data = thisData
         )
 
+        # Get the MTD estimate from the samples.
+
+        target_dose_samples <- dose(
+          mean(object@nextBest@target),
+          model = object@model,
+          samples = thisSamples
+        )
+
+        # Create a function for additional statistical summary.
+
+        additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+
+
         ## return the results
         thisResult <-
           list(
@@ -861,7 +897,8 @@ setMethod("simulate",
               attr(
                 stopit,
                 "message"
-              )
+              ),
+            additional_stats = additional_stats
           )
 
         return(thisResult)
@@ -912,6 +949,9 @@ setMethod("simulate",
       ## for dual simulations as it would fail in summary otherwise (for dual simulations reporting is not implemented)
       stop_report <- matrix(TRUE, nrow = nsim)
 
+      ## For dual simulations summary of additional statistics.
+      additional_stats <- lapply(resultList, "[[", "additional_stats")
+
       ## return the results in the DualSimulations class object
       ret <- DualSimulations(
         data = dataList,
@@ -922,6 +962,7 @@ setMethod("simulate",
         fit_biomarker = fitBiomarkerList,
         stop_report = stop_report,
         stop_reasons = stopReasons,
+        additional_stats = additional_stats,
         seed = RNGstate
       )
 
@@ -3968,6 +4009,9 @@ setMethod("simulate",
 ##' @param nCores how many cores should be used for parallel computing?
 ##' Defaults to the number of cores on the machine (maximum 5)
 ##' @param \dots not used
+##' @param derive a named list of functions which derives statistics, based on the
+##' vector of posterior MTD samples. Each list element must therefore accept
+##' one and only one argument, which is a numeric vector, and return a number.
 ##'
 ##' @return an object of class \code{\linkS4class{Simulations}}
 ##'
@@ -3987,7 +4031,8 @@ setMethod("simulate",
              deescalate = TRUE,
              mcmcOptions = McmcOptions(),
              DA = TRUE,
-             parallel = FALSE, nCores = min(parallel::detectCores(), 5L),
+             parallel = FALSE, nCores = min(parallel::detectCores(), 5),
+             derive = list(),
              ...) {
       ## checks and extracts
       assert_function(truthTox)
@@ -4456,6 +4501,19 @@ setMethod("simulate",
           data = thisData
         )
 
+        # Get the MTD estimate from the samples.
+
+        target_dose_samples <- dose(
+          mean(object@nextBest@target),
+          model = object@model,
+          samples = thisSamples
+        )
+
+        # Create a function for additional statistical summary.
+
+        additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+
+
         ## return the results
         thisResult <-
           list(
@@ -4470,7 +4528,8 @@ setMethod("simulate",
               attr(
                 stopit,
                 "message"
-              )
+              ),
+            additional_stats = additional_stats
           )
         return(thisResult)
       }
@@ -4514,17 +4573,22 @@ setMethod("simulate",
       stopReasons <- lapply(resultList, "[[", "stop")
 
       stop_report <- matrix(TRUE, nrow = nsim)
+
+      additional_stats <- lapply(resultList, "[[", "additional_stats")
+
       ## return the results in the Simulations class object
       ret <- DASimulations(
         data = dataList,
         doses = recommendedDoses,
         fit = fitList,
         trialduration = trialduration,
         stop_report = stop_report,
+        additional_stats = additional_stats,
         stop_reasons = stopReasons,
         seed = RNGstate
       )
 
+
       return(ret)
     }
 )
@@ -4686,13 +4750,15 @@ setMethod(
         stop_reasons <- lapply(this_list, "[[", "stop")
         report_results <- lapply(this_list, "[[", "results")
         stop_report <- as.matrix(do.call(rbind, report_results))
+        additional_stats <- lapply(this_list, "[[", "additional_stats")
 
         Simulations(
           data = data_list,
           doses = recommended_doses,
           fit = fit_list,
           stop_reasons = stop_reasons,
           stop_report = stop_report,
+          additional_stats = additional_stats,
           seed = rng_state
         )
       })

diff --git a/R/Rules-class.R b/R/Rules-class.R
@@ -2698,7 +2698,8 @@ setClass(
 #' @example examples/Rules-class-CohortSizeRange.R
 #'
 CohortSizeRange <- function(intervals, cohort_size) {
-  assert_integerish(cohort_size, lower = 1, any.missing = FALSE)
+  # Cohort size 0 is needed to allow for no-placebo designs
+  assert_integerish(cohort_size, lower = 0, any.missing = FALSE)
 
   .CohortSizeRange(
     intervals = intervals,
@@ -2759,7 +2760,8 @@ CohortSizeRange <- function(intervals, cohort_size) {
 #'
 CohortSizeDLT <- function(intervals, cohort_size) {
   assert_integerish(intervals, lower = 0, any.missing = FALSE)
-  assert_integerish(cohort_size, lower = 1, any.missing = FALSE)
+  # Cohort size 0 is needed to allow for no-placebo designs
+  assert_integerish(cohort_size, lower = 0, any.missing = FALSE)
 
   .CohortSizeDLT(
     intervals = as.integer(intervals),
@@ -2810,7 +2812,8 @@ CohortSizeDLT <- function(intervals, cohort_size) {
 #' @example examples/Rules-class-CohortSizeConst.R
 #'
 CohortSizeConst <- function(size) {
-  assert_integerish(size, min = 1)
+  # Cohort size 0 is needed to allow for no-placebo designs
+  assert_integerish(size, lower = 0)
   .CohortSizeConst(size = as.integer(size))
 }
 
@@ -2859,7 +2862,8 @@ CohortSizeConst <- function(size) {
 #' @example examples/Rules-class-CohortSizeParts.R
 #'
 CohortSizeParts <- function(cohort_sizes) {
-  assert_integerish(cohort_sizes, min = 1, any.missing = FALSE)
+  # Cohort size 0 is needed to allow for no-placebo designs
+  assert_integerish(cohort_sizes, lower = 0, any.missing = FALSE)
   .CohortSizeParts(cohort_sizes = as.integer(cohort_sizes))
 }