Suggested changes: additional_statistics and validation

openpharma · Sep 14, 2023 · bea2537 · bea2537
1 parent 969b530
commit bea2537
Show file tree

Hide file tree

Showing 17 changed files with 307 additions and 151 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -98,13 +98,15 @@ Collate:
     'Samples-validity.R'
     'Samples-class.R'
     'mcmc.R'
+    'Simulations-validity.R'
     'Simulations-class.R'
     'helpers_rules.R'
     'Model-methods.R'
     'Rules-methods.R'
     'Design-methods.R'
     'fromQuantiles.R'
     'Samples-methods.R'
+    'Simulation-validity.R'
     'Simulations-methods.R'
     'checkmate.R'
     'crmPack-package.R'

diff --git a/NEWS.md b/NEWS.md
@@ -58,6 +58,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
@@ -190,7 +190,7 @@ getResultList <- function(fun,
 ##' @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 list of functions which derives statistics, based on the
+##' @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.
 ##'
@@ -708,7 +708,7 @@ 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 list of functions which derives statistics, based on the
+##' @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.
 ##'
@@ -4183,7 +4183,7 @@ 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 list of functions which derives statistics, based on the
+##' @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.
 ##'

diff --git a/R/Simulations-class.R b/R/Simulations-class.R
@@ -1,5 +1,6 @@
 #' @include helpers.R
 #' @include Data-class.R
+#' @include Simulations-validity.R
 #' @include CrmPackClass-class.R
 NULL
 
@@ -53,23 +54,7 @@ NULL
       seed = 1L
     ),
     contains = "CrmPackClass",
-    validity =
-      function(object) {
-        o <- Validate()
-
-        nSims <- length(object@data)
-
-        o$check(
-          all(sapply(object@data, is, "Data")),
-          "all data elements must be Data objects"
-        )
-        o$check(
-          identical(length(object@doses), nSims),
-          "doses must have same length as the data list"
-        )
-
-        o$result()
-      }
+    validity = v_general_simulations
   )
 
 ## constructor ----
@@ -101,8 +86,8 @@ GeneralSimulations <- function(data,
 #' @description `r lifecycle::badge("stable")`
 #'
 #' This class captures the trial simulations from model based designs.
-#' Additional slots `fit` and `stop_reasons` compared to the general class
-#' [`GeneralSimulations`].
+#' Additional slots `fit`, `stop_reasons`, `stop_report`,`additional_stats` compared to
+#' the general class [`GeneralSimulations`].
 #'
 #' @slot fit (`list`)\cr final fits
 #' @slot stop_reasons (`list`)\cr stopping reasons for each simulation run
@@ -129,42 +114,10 @@ GeneralSimulations <- function(data,
       stop_reasons =
         list("A", "A"),
       additional_stats =
-        list(1, 1)
+        list(a = 1, b = 1)
     ),
     contains = "GeneralSimulations",
-    validity =
-      function(object) {
-        o <- Validate()
-
-        nSims <- length(object@data)
-
-        o$check(
-          identical(length(object@fit), nSims),
-          "fit must have same length as data"
-        )
-        o$check(
-          identical(length(object@stop_reasons), nSims),
-          "stop_reasons must have same length as data"
-        )
-
-        o$check(
-          checkmate::test_matrix(object@stop_report,
-            mode = "logical",
-            nrows = nSims,
-            min.cols = 1,
-            any.missing = FALSE
-          ),
-          "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()
-      }
+    validity = v_simulations
   )
 
 ## constructor ----
@@ -229,27 +182,7 @@ Simulations <- function(fit,
         )
     ),
     contains = "Simulations",
-    validity =
-      function(object) {
-        o <- Validate()
-
-        nSims <- length(object@data)
-
-        o$check(
-          identical(length(object@fit_biomarker), nSims),
-          "fit_biomarker list has to have same length as data"
-        )
-        o$check(
-          identical(length(object@rho_est), nSims),
-          "rho_est vector has to have same length as data"
-        )
-        o$check(
-          identical(length(object@sigma2w_est), nSims),
-          "sigma2w_est has to have same length as data"
-        )
-
-        o$result()
-      }
+    validity = v_dual_simulations
   )
 
 
@@ -441,18 +374,7 @@ DualSimulations <- function(rho_est,
         list("A", "A")
     ),
     contains = "GeneralSimulations",
-    validity =
-      function(object) {
-        o <- Validate()
-
-        nSims <- length(object@data)
-        o$check(
-          identical(length(object@stopReasons), nSims),
-          "stopReasons must have same length as data"
-        )
-
-        o$result()
-      }
+    validity = v_pseudo_simulations
   )
 validObject(.PseudoSimulations())
 
@@ -555,16 +477,7 @@ PseudoSimulations <- function(fit,
       sigma2est = c(0.001, 0.002)
     ),
     contains = "PseudoSimulations",
-    validity =
-      function(object) {
-        o <- Validate()
-        nSims <- length(object@data)
-        o$check(
-          identical(length(object@sigma2est), nSims),
-          "sigma2est has to have same length as data"
-        )
-        o$result()
-      }
+    validity = v_pseudo_dual_simulations
   )
 
 validObject(.PseudoDualSimulations())
@@ -626,16 +539,7 @@ PseudoDualSimulations <- function(fitEff,
     representation(sigma2betaWest = "numeric"),
     prototype(sigma2betaWest = c(0.001, 0.002)),
     contains = "PseudoDualSimulations",
-    validity =
-      function(object) {
-        o <- Validate()
-        nSims <- length(object@data)
-        o$check(
-          identical(length(object@sigma2betaWest), nSims),
-          "sigma2betaWest has to have same length as data"
-        )
-        o$result()
-      }
+    validity = v_pseudo_dual_flex_simulations
   )
 
 validObject(.PseudoDualFlexiSimulations())
@@ -801,19 +705,7 @@ PseudoDualFlexiSimulations <- function(sigma2betaWest,
     representation(trialduration = "numeric"),
     prototype(trialduration = rep(0, 2)),
     contains = "Simulations",
-    validity =
-      function(object) {
-        o <- Validate()
-
-        nSims <- length(object@data)
-
-        o$check(
-          identical(length(object@trialduration), nSims),
-          "trialduration vector has to have same length as data"
-        )
-
-        o$result()
-      }
+    validity = v_da_simulations
   )
 validObject(.DASimulations())