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 = NULL,
              ...) {
       nsim <- safeInteger(nsim)
 
@@ -418,17 +418,20 @@ setMethod("simulate",
         )
 
         # Get the MTD estimate from the samples.
+
         target_dose_samples <- dose(
           mean(object@nextBest@target),
           model = object@model,
           samples = thisSamples
         )
 
-        # Create list with median MTD and CV.
-        additional_stats <- list(
-          median_mtd = median(target_dose_samples),
-          cv_mtd = mad(target_dose_samples) / median(target_dose_samples)
-        )
+        # Create a function for additional statistical summary.
+        if (is.null(derive)) {
+          additional_stats <- list()
+        } else {
+          additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+        }
+
 
         ## return the results
         thisResult <-
@@ -484,7 +487,7 @@ setMethod("simulate",
       stopResults <- lapply(resultList, "[[", "report_results")
       stop_matrix <- as.matrix(do.call(rbind, stopResults))
 
-      # Result list of additional stats such as median MTD and mean CV MTD values.
+      # Result list of additional statistical summary.
       additional_stats <- lapply(resultList, "[[", "additional_stats")
 
       ## return the results in the Simulations class object
@@ -1020,17 +1023,19 @@ setMethod("simulate",
         )
 
         # Get the MTD estimate from the samples.
+
         target_dose_samples <- dose(
           mean(object@nextBest@target),
           model = object@model,
           samples = thisSamples
         )
 
-        # Create list with median MTD and CV.
-        additional_stats <- list(
-          median_mtd = median(target_dose_samples),
-          cv_mtd = mad(target_dose_samples) / median(target_dose_samples)
-        )
+        # Create a function for additional statistical summary.
+        if (is.null(derive)) {
+          additional_stats <- list()
+        } else {
+          additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+        }
 
         ## return the results
         thisResult <-
@@ -4672,16 +4677,20 @@ setMethod("simulate",
           data = thisData
         )
 
+        # Get the MTD estimate from the samples.
+
         target_dose_samples <- dose(
           mean(object@nextBest@target),
           model = object@model,
           samples = thisSamples
         )
 
-        additional_stats <- list(
-          median_mtd = median(target_dose_samples),
-          cv_mtd = mad(target_dose_samples) / median(target_dose_samples)
-        )
+        # Create a function for additional statistical summary.
+        if (is.null(derive)) {
+          additional_stats <- list()
+        } else {
+          additional_stats <- lapply(derive, function(f) f(target_dose_samples))
+        }
 
         ## return the results
         thisResult <-

R/Simulations-class.R

@@ -107,7 +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 median MTD and mean CV MTD values
+#' @slot additional_stats list of addtional statistical summary
 #' @aliases Simulations
 #' @export
 .Simulations <-
@@ -129,7 +129,7 @@ GeneralSimulations <- function(data,
       stop_reasons =
         list("A", "A"),
       additional_stats =
-        list(1, 0.4)
+        list(1, 1)
     ),
     contains = "GeneralSimulations",
     validity =
@@ -160,7 +160,7 @@ GeneralSimulations <- function(data,
 
         o$check(
           identical(length(object@additional_stats), nSims),
-          "additional_stats must have same length as data"
+          "additional_stats must have same length as the number of simulations"
         )
 
         o$result()
@@ -332,7 +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 median MTD and mean CV MTD values
+##' @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

R/Simulations-methods.R

@@ -643,7 +643,6 @@ setMethod("summary",
     }
 )
 
-
 ##' Summarize the dual-endpoint design simulations, relative to given true
 ##' dose-toxicity and dose-biomarker curves
 ##'
@@ -978,25 +977,23 @@ setMethod("show",
       )
 
 
-
-
       ## add one reporting line
       r$report(
         "fitAtDoseMostSelected",
         "Fitted toxicity rate at dose most often selected"
       )
 
-      # Report results of additional statistics such as median MTD and mean CV MTD
+      # Report results of additional statistics summary
 
-      cat(
-        "Median MTD : ",
-        round(unlist(object@additional_stats)[1], 2), "\n"
-      )
+      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")
+        )
+      }
 
-      cat(
-        "Mean CV (MTD) [%] : ",
-        round(unlist(object@additional_stats)[2] * 100, 2), "\n"
-      )
 
       # Report individual stopping rules with non-<NA> labels.
 

examples/Simulations-class-DualSimulations.R

@@ -27,7 +27,7 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2)
 
 stop_reasons <- list("A", "B")
 
-additional_stats <- list(1, 0.4)
+additional_stats <- list(1, 1)
 
 dual_simulations_obj <- DualSimulations(
   rho_est = c(0.25, 0.35),

examples/Simulations-class-Simulations.R

@@ -28,7 +28,7 @@ stop_report <- matrix(c(TRUE, FALSE), nrow = 2)
 
 stop_reasons <- list("A", "B")
 
-additional_stats <- list(1, 0.4)
+additional_stats <- list(1, 1)
 
 simulations <- Simulations(
   fit = fit,

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

tests/testthat/test-Simulations-class.R

@@ -63,7 +63,7 @@ test_that("Simulations object can be created with the user constructor", {
 
   stop_report <- matrix(c(TRUE, FALSE), nrow = 2)
 
-  additional_stats <- list(1, 0.4)
+  additional_stats <- list(1, 1)
 
   data <- list(
     Data(
@@ -151,7 +151,7 @@ test_that("DualSimulations object can be created with the user constructor", {
 
   stop_reasons <- list("A", "B")
 
-  additional_stats <- list(1, 0.4)
+  additional_stats <- list(1, 1)
 
   result <- expect_silent(
     DualSimulations(