Merge branch 'main' into 656_additional_stat

.lintr

@@ -1,6 +1,7 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
   cyclocomp_linter = NULL,
+  indentation_linter = NULL,
   object_usage_linter = NULL,
   object_length_linter = NULL,
   object_name_linter = object_name_linter(c("CamelCase", "camelCase", "snake_case"))

DESCRIPTION

@@ -82,6 +82,7 @@ Collate:
     'Data-validity.R'
     'helpers.R'
     'Data-class.R'
+    'helpers_data.R'
     'Data-methods.R'
     'Rules-validity.R'
     'Rules-class.R'
@@ -111,6 +112,7 @@ Collate:
     'checkmate.R'
     'crmPack-package.R'
     'helpers_covr.R'
+    'helpers_design.R'
     'helpers_model.R'
     'logger.R'
     'utils-pipe.R'

NAMESPACE

@@ -19,6 +19,7 @@ export(.DataDA)
 export(.DataDual)
 export(.DataGrouped)
 export(.DataMixture)
+export(.DataOrdinal)
 export(.DataParts)
 export(.DefaultCohortSizeConst)
 export(.DefaultCohortSizeDLT)
@@ -28,6 +29,7 @@ export(.DefaultCohortSizeParts)
 export(.DefaultCohortSizeRange)
 export(.DefaultDALogisticLogNormal)
 export(.DefaultDataGrouped)
+export(.DefaultDesignGrouped)
 export(.DefaultDualEndpoint)
 export(.DefaultDualEndpointBeta)
 export(.DefaultDualEndpointEmax)
@@ -86,6 +88,7 @@ export(.DefaultStoppingTargetBiomarker)
 export(.DefaultStoppingTargetProb)
 export(.DefaultTITELogisticLogNormal)
 export(.Design)
+export(.DesignGrouped)
 export(.DualDesign)
 export(.DualEndpoint)
 export(.DualEndpointBeta)
@@ -187,8 +190,10 @@ export(DataDA)
 export(DataDual)
 export(DataGrouped)
 export(DataMixture)
+export(DataOrdinal)
 export(DataParts)
 export(Design)
+export(DesignGrouped)
 export(DualDesign)
 export(DualEndpoint)
 export(DualEndpointBeta)
@@ -348,7 +353,7 @@ export(prob)
 export(probFunction)
 export(probit)
 export(saveSample)
-export(setSeed)
+export(set_seed)
 export(size)
 export(stopTrial)
 export(test_length)
@@ -373,8 +378,10 @@ exportClasses(DataDA)
 exportClasses(DataDual)
 exportClasses(DataGrouped)
 exportClasses(DataMixture)
+exportClasses(DataOrdinal)
 exportClasses(DataParts)
 exportClasses(Design)
+exportClasses(DesignGrouped)
 exportClasses(DualDesign)
 exportClasses(DualEndpoint)
 exportClasses(DualEndpointBeta)
@@ -532,10 +539,8 @@ importFrom(kableExtra,kbl)
 importFrom(lifecycle,badge)
 importFrom(magrittr,"%>%")
 importFrom(mvtnorm,rmvnorm)
-importFrom(parallel,clusterApply)
 importFrom(parallel,detectCores)
 importFrom(parallel,makeCluster)
-importFrom(parallel,stopCluster)
 importFrom(parallelly,availableCores)
 importFrom(rjags,jags.model)
 importFrom(rjags,jags.samples)

NEWS.md

@@ -1,5 +1,5 @@
 # Version 1.0.9000.9133
-* Added new `DataGrouped` class to support simultaneous dose escalation with monotherapy and combination therapy.
+* 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 
 definition of generic methods.

R/Data-class.R

@@ -380,6 +380,105 @@ DataDA <- function(u = numeric(),
   )
 }
 
+# DataOrdinal ----
+
+## class ----
+
+#' `DataOrdinal`
+#'
+#' @description `r lifecycle::badge("experimental")`
+#'
+#' [`DataOrdinal`] is a class for ordinal toxicity data.
+#' It inherits from [`GeneralData`] and it describes toxicity responses on an
+#' ordinal rather than binary scale.
+#'
+#' @note This class has been implemented as a sibling of the existing `Data` class
+#' (rather than as a parent or child) to minimise the risk of unintended side
+#' effects on existing classes and methods.
+#'
+#' The default setting for the `yCategories` slot replicates the behaviour
+#' of the existing `Data` class.
+#'
+#' @aliases DataOrdinal
+#' @export
+.DataOrdinal <- setClass(
+  Class = "DataOrdinal",
+  contains = "GeneralData",
+  slots = c(
+    x = "numeric",
+    y = "integer",
+    doseGrid = "numeric",
+    nGrid = "integer",
+    xLevel = "integer",
+    yCategories = "integer",
+    placebo = "logical"
+  ),
+  prototype = prototype(
+    x = numeric(),
+    y = integer(),
+    doseGrid = numeric(),
+    nGrid = 0L,
+    xLevel = integer(),
+    yCategories = c("No DLT" = 0L, "DLT" = 1L),
+    placebo = FALSE
+  ),
+  validity = v_data_ordinal
+)
+
+## constructor ----
+
+#' @rdname DataOrdinal-class
+#' @param yCategories (named `integer`)\cr the names and codes for the
+#' toxicity categories used in the data.  Category labels are taken from the
+#' names of the vector.  The names of the vector must be unique and its values
+#' must be sorted and take the values 0, 1, 2, ...
+#' @inheritParams Data
+#' @inherit Data details note params
+#' @example examples/Data-class-DataOrdinal.R
+#' @export
+DataOrdinal <- function(x = numeric(),
+                        y = integer(),
+                        ID = integer(),
+                        cohort = integer(),
+                        doseGrid = numeric(),
+                        placebo = FALSE,
+                        yCategories = c("No DLT" = 0L, "DLT" = 1L),
+                        ...) {
+  assert_numeric(doseGrid, any.missing = FALSE, unique = TRUE)
+  assert_numeric(yCategories, any.missing = FALSE, unique = TRUE)
+  assert_character(names(yCategories), any.missing = FALSE, unique = TRUE)
+  assert_flag(placebo)
+
+  doseGrid <- as.numeric(sort(doseGrid))
+
+  if (length(ID) == 0 && length(x) > 0) {
+    message("Used default patient IDs!")
+    ID <- seq_along(x)
+  }
+
+  if (!placebo && length(cohort) == 0 && length(x) > 0) {
+    message("Used best guess cohort indices!")
+    # This is just assuming that consecutive patients
+    # in the data set are in the same cohort if they
+    # have the same dose. Note that this could be wrong,
+    # if two subsequent cohorts are at the same dose.
+    cohort <- as.integer(c(1, 1 + cumsum(diff(x) != 0)))
+  }
+
+  .DataOrdinal(
+    x = as.numeric(x),
+    y = safeInteger(y),
+    ID = safeInteger(ID),
+    cohort = safeInteger(cohort),
+    doseGrid = doseGrid,
+    nObs = length(x),
+    nGrid = length(doseGrid),
+    xLevel = matchTolerance(x = x, table = doseGrid),
+    placebo = placebo,
+    yCategories = yCategories
+  )
+}
+
 # DataGrouped ----
 
 ## class ----
@@ -408,8 +507,6 @@ DataDA <- function(u = numeric(),
   validity = v_data_grouped
 )
 
-## constructor ----
-
 #' @rdname DataGrouped-class
 #'
 #' @param group (`factor` or `character`)\cr whether `mono` or `combo` was used.