New commit for additional statistics

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'

NEWS.md

@@ -59,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
 

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
         )
       })