New commit for additional statistics

R/Design-methods.R

@@ -209,7 +209,7 @@ setMethod("simulate",
              truth, args = NULL, firstSeparate = FALSE,
              mcmcOptions = McmcOptions(),
              parallel = FALSE, nCores =
-               min(parallel::detectCores(), 5),
+               min(parallel::detectCores(), 5), derive = list(),
              ...) {
       nsim <- safeInteger(nsim)
 
@@ -417,6 +417,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(
@@ -431,7 +443,8 @@ setMethod("simulate",
                 stopit,
                 "message"
               ),
-            report_results = stopit_results
+            report_results = stopit_results,
+            additional_stats = additional_stats
           )
         return(thisResult)
       }
@@ -470,13 +483,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
       )
 
@@ -706,7 +723,7 @@ setMethod("simulate",
              mcmcOptions = McmcOptions(),
              parallel = FALSE,
              nCores =
-               min(parallel::detectCores(), 5),
+               min(parallel::detectCores(), 5), derive = list(),
              ...) {
       nsim <- safeInteger(nsim)
 
@@ -1001,6 +1018,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(
@@ -1025,7 +1055,8 @@ setMethod("simulate",
               attr(
                 stopit,
                 "message"
-              )
+              ),
+            additional_stats = additional_stats
           )
 
         return(thisResult)
@@ -1075,6 +1106,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,
@@ -1085,6 +1119,7 @@ setMethod("simulate",
         fit_biomarker = fitBiomarkerList,
         stop_report = stop_report,
         stop_reasons = stopReasons,
+        additional_stats = additional_stats,
         seed = RNGstate
       )
 
@@ -4162,6 +4197,7 @@ setMethod("simulate",
              mcmcOptions = McmcOptions(),
              DA = TRUE,
              parallel = FALSE, nCores = min(parallel::detectCores(), 5),
+             derive = list(),
              ...) {
       nsim <- safeInteger(nsim) ## remove  in the future
 
@@ -4636,6 +4672,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(
@@ -4650,7 +4699,8 @@ setMethod("simulate",
               attr(
                 stopit,
                 "message"
-              )
+              ),
+            additional_stats = additional_stats
           )
         return(thisResult)
       }
@@ -4693,17 +4743,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)
     }
 )

R/Simulations-class.R

@@ -107,6 +107,7 @@ GeneralSimulations <- function(data,
 #' @slot fit (`list`)\cr final fits
 #' @slot stop_reasons (`list`)\cr stopping reasons for each simulation run
 #' @slot stop_report matrix of stopping rule outcomes
+#' @slot additional_stats list of additional statistical summary
 #' @aliases Simulations
 #' @export
 .Simulations <-
@@ -115,7 +116,8 @@ GeneralSimulations <- function(data,
     slots = c(
       fit = "list",
       stop_report = "matrix",
-      stop_reasons = "list"
+      stop_reasons = "list",
+      additional_stats = "list"
     ),
     prototype = prototype(
       fit =
@@ -125,7 +127,9 @@ GeneralSimulations <- function(data,
         ),
       stop_report = matrix(TRUE, nrow = 2),
       stop_reasons =
-        list("A", "A")
+        list("A", "A"),
+      additional_stats =
+        list(1, 1)
     ),
     contains = "GeneralSimulations",
     validity =
@@ -153,6 +157,12 @@ GeneralSimulations <- function(data,
           "stop_report must be a matrix of mode logical in which the number of rows equals the number of simulations
       and which must not contain any missing values"
         )
+
+        o$check(
+          identical(length(object@additional_stats), nSims),
+          "additional_stats must have same length as the number of simulations"
+        )
+
         o$result()
       }
   )
@@ -164,19 +174,22 @@ GeneralSimulations <- function(data,
 #' @param fit (`list`)\cr see slot definition.
 #' @param stop_reasons (`list`)\cr see slot definition.
 #' @param stop_report see [`Simulations`]
+#' @param additional_stats (`list`)\cr see slot definition.
 #' @param \dots additional parameters from [`GeneralSimulations`]
 #'
 #' @example examples/Simulations-class-Simulations.R
 #' @export
 Simulations <- function(fit,
                         stop_reasons,
                         stop_report,
+                        additional_stats,
                         ...) {
   start <- GeneralSimulations(...)
   .Simulations(start,
     fit = fit,
     stop_report = stop_report,
-    stop_reasons = stop_reasons
+    stop_reasons = stop_reasons,
+    additional_stats = additional_stats
   )
 }
 
@@ -319,6 +332,7 @@ DualSimulations <- function(rho_est,
 ##' initialization function is provided for this class.
 ##'
 ##' @slot stop_report matrix of stopping rule outcomes
+##' @slot additional_stats list of additional statistical summary
 ##' @slot fitAtDoseMostSelected fitted toxicity rate at dose most often selected
 ##' @slot meanFit list with the average, lower (2.5%) and upper (97.5%)
 ##' quantiles of the mean fitted toxicity at each dose level
@@ -331,6 +345,7 @@ DualSimulations <- function(rho_est,
     representation(
       stop_report = "matrix",
       fitAtDoseMostSelected = "numeric",
+      additional_stats = "list",
       meanFit = "list"
     ),
     contains = "GeneralSimulationsSummary"

R/Simulations-methods.R

@@ -634,6 +634,7 @@ setMethod("summary",
       ret <- .SimulationsSummary(
         start,
         stop_report = object@stop_report,
+        additional_stats = object@additional_stats,
         fitAtDoseMostSelected = fitAtDoseMostSelected,
         meanFit = meanFit
       )
@@ -642,7 +643,6 @@ setMethod("summary",
     }
 )
 
-
 ##' Summarize the dual-endpoint design simulations, relative to given true
 ##' dose-toxicity and dose-biomarker curves
 ##'
@@ -977,14 +977,23 @@ setMethod("show",
       )
 
 
-
-
       ## add one reporting line
       r$report(
         "fitAtDoseMostSelected",
         "Fitted toxicity rate at dose most often selected"
       )
 
+      # Report results of additional statistics summary
+
+      if (length(list()) > 0) {
+        summary_stat_op <- unlist(object@additional_stats)
+
+        cat(
+          "Results of Additional Statistical Calculation : \n",
+          paste(names(summary_stat_op), ":", round(summary_stat_op), "\n")
+        )
+      }
+
 
       # Report individual stopping rules with non-<NA> labels.
 

examples/Simulations-class-DualSimulations.R

@@ -27,13 +27,16 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2)
 
 stop_reasons <- list("A", "B")
 
+additional_stats <- list(1, 1)
+
 dual_simulations_obj <- DualSimulations(
   rho_est = c(0.25, 0.35),
   sigma2w_est = c(0.15, 0.25),
   fit_biomarker = list(c(0.3, 0.4), c(0.4, 0.5)),
   fit = fit,
   stop_report = stop_report,
   stop_reasons = stop_reasons,
+  additional_stats = additional_stats,
   data = data_list,
   doses = doses,
   seed = seed

examples/Simulations-class-Simulations.R

@@ -28,5 +28,14 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2)
 
 stop_reasons <- list("A", "B")
 
+additional_stats <- list(1, 1)
 
-simulations <- Simulations(fit = fit, stop_report = stop_report, stop_reasons = stop_reasons, data, doses, seed)
+simulations <- Simulations(
+  fit = fit,
+  stop_report = stop_report,
+  stop_reasons = stop_reasons,
+  additional_stats = additional_stats,
+  data,
+  doses,
+  seed
+)

examples/Simulations-method-summary.R

@@ -74,7 +74,18 @@ time <- system.time(mySims <- simulate(design,
   nsim = 1,
   seed = 819,
   mcmcOptions = options,
-  parallel = FALSE
+  parallel = FALSE,
+  derive = list(
+    "max_mtd" = function(x) {
+      max(x)
+    },
+    "mean_mtd" = function(y) {
+      mean(y)
+    },
+    "median_mtd" = function(z) {
+      median(z)
+    }
+  ),
 ))[3]
 
 # Summarize the Results of the Simulations