664: Add DataGrouped class (#665)

* add class

* add helper function to group mono and combo

* fix speling

* add .DefaultDataGrouped()

NAMESPACE

@@ -17,6 +17,7 @@ export(.DASimulations)
 export(.Data)
 export(.DataDA)
 export(.DataDual)
+export(.DataGrouped)
 export(.DataMixture)
 export(.DataParts)
 export(.DefaultCohortSizeConst)
@@ -26,6 +27,7 @@ export(.DefaultCohortSizeMin)
 export(.DefaultCohortSizeParts)
 export(.DefaultCohortSizeRange)
 export(.DefaultDALogisticLogNormal)
+export(.DefaultDataGrouped)
 export(.DefaultDualEndpoint)
 export(.DefaultDualEndpointBeta)
 export(.DefaultDualEndpointEmax)
@@ -181,6 +183,7 @@ export(DASimulations)
 export(Data)
 export(DataDA)
 export(DataDual)
+export(DataGrouped)
 export(DataMixture)
 export(DataParts)
 export(Design)
@@ -365,6 +368,7 @@ exportClasses(DASimulations)
 exportClasses(Data)
 exportClasses(DataDA)
 exportClasses(DataDual)
+exportClasses(DataGrouped)
 exportClasses(DataMixture)
 exportClasses(DataParts)
 exportClasses(Design)

NEWS.md

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

@@ -379,3 +379,66 @@ DataDA <- function(u = numeric(),
     Tmax = as.numeric(Tmax)
   )
 }
+
+# DataGrouped ----
+
+## class ----
+
+#' `DataGrouped`
+#'
+#' @description `r lifecycle::badge("stable")`
+#'
+#' [`DataGrouped`] is a class for a two groups dose escalation data set,
+#' comprised of a monotherapy (`mono`) and a combination therapy (`combo`)
+#' arm. It inherits from [`Data`] and it contains the additional group information.
+#'
+#' @slot group (`factor`)\cr whether `mono` or `combo` was used.
+#'
+#' @aliases DataGrouped
+#' @export
+.DataGrouped <- setClass(
+  Class = "DataGrouped",
+  slots = c(
+    group = "factor"
+  ),
+  prototype = prototype(
+    group = factor(levels = c("mono", "combo"))
+  ),
+  contains = "Data",
+  validity = v_data_grouped
+)
+
+## constructor ----
+
+#' @rdname DataGrouped-class
+#'
+#' @param group (`factor` or `character`)\cr whether `mono` or `combo` was used.
+#'   If `character` then will be coerced to `factor` with the correct levels
+#'   internally.
+#' @param ... parameters passed to [Data()].
+#'
+#' @export
+#' @example examples/Data-class-DataGrouped.R
+#'
+DataGrouped <- function(group = character(),
+                        ...) {
+  d <- Data(...)
+  if (!is.factor(group)) {
+    assert_character(group)
+    assert_subset(group, choices = c("mono", "combo"))
+    group <- factor(group, levels = c("mono", "combo"))
+  }
+  .DataGrouped(
+    d,
+    group = group
+  )
+}
+
+## default constructor ----
+
+#' @rdname DataGrouped-class
+#' @note Typically, end users will not use the `.DefaultDataGrouped()` function.
+#' @export
+.DefaultDataGrouped <- function() {
+  DataGrouped()
+}

R/Data-validity.R

@@ -180,3 +180,19 @@ v_data_da <- function(object) {
   )
   v$result()
 }
+
+#' @describeIn v_data_objects validates that the [`DataGrouped`] object
+#'   contains valid group information.
+v_data_grouped <- function(object) {
+  v <- Validate()
+  v$check(
+    test_factor(
+      object@group,
+      levels = c("mono", "combo"),
+      len = object@nObs,
+      any.missing = FALSE
+    ),
+    "group must be factor with levels mono and combo of length nObs without missings"
+  )
+  v$result()
+}

R/helpers.R

@@ -1080,3 +1080,39 @@ h_calc_report_label_percentage <- function(stop_report) {
   stop_pct_to_print <- stop_pct[!is.na(names(stop_pct))]
   return(stop_pct_to_print)
 }
+
+#' Group Together Mono and Combo Data
+#'
+#' This is only used in the simulation method for `DesignGrouped` to combine
+#' the separately generated data sets from mono and combo arms and to fit the
+#' combined logistic regression model.
+#' Hence the ID and cohort information is not relevant and will be
+#' arbitrarily assigned to avoid problems with the [`DataGrouped`] validation.
+#'
+#' @param mono_data (`Data`)\cr mono data.
+#' @param combo_data (`Data`)\cr combo data.
+#'
+#' @return A [`DataGrouped`] object containing both `mono_data` and `combo_data`,
+#'   but with arbitrary ID and cohort slots.
+#'
+#' @keywords internal
+h_group_data <- function(mono_data, combo_data) {
+  assert_class(mono_data, "Data")
+  assert_class(combo_data, "Data")
+
+  df <- data.frame(
+    x = c(mono_data@x, combo_data@x),
+    y = c(mono_data@y, combo_data@y),
+    group = rep(c("mono", "combo"), c(length(mono_data@x), length(combo_data@x)))
+  )
+  df <- df[order(df$x), ]
+
+  DataGrouped(
+    x = df$x,
+    y = df$y,
+    ID = seq_along(df$x),
+    cohort = as.integer(factor(df$x)),
+    doseGrid = sort(unique(c(mono_data@doseGrid, combo_data@doseGrid))),
+    group = df$group
+  )
+}

_pkgdown.yaml

@@ -41,6 +41,7 @@ reference:
       - DataParts
       - DataMixture
       - DataDA
+      - DataGrouped
       - McmcOptions
       - ModelParamsNormal
       - GeneralModel

examples/Data-class-DataGrouped.R

@@ -0,0 +1,12 @@
+my_data <- DataGrouped(
+  x = c(0.1, 0.5, 1.5, 3, 6, 10, 10, 10),
+  y = c(0, 0, 1, 1, 0, 0, 1, 0),
+  doseGrid = c(0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2)),
+  group = c("mono", "mono", "mono", "mono", "mono", "mono", "combo", "combo")
+)
+
+# Set up an empty data set.
+empty_data <- DataGrouped(
+  doseGrid = c(0.1, 0.5, 1, 1.5, 3, 6, seq(from = 10, to = 80, by = 2))
+)
+empty_data

inst/WORDLIST

@@ -227,6 +227,7 @@ modelled
 modelling
 ModelPseudo
 ModelTox
+monotherapy
 MTD
 multisessions
 multithreaded

tests/testthat/helper-data.R

@@ -1,3 +1,5 @@
+# Data ----
+
 h_get_data <- function(empty = FALSE, placebo = TRUE) {
   dose_grid <- seq(25, 300, 25)
   if (placebo) {
@@ -49,6 +51,8 @@ h_get_data_2 <- function() {
   )
 }
 
+# DataDual ----
+
 h_get_data_dual <- function(empty = FALSE, placebo = TRUE) {
   d <- h_get_data(empty, placebo)
   if (empty) {
@@ -61,6 +65,8 @@ h_get_data_dual <- function(empty = FALSE, placebo = TRUE) {
   }
 }
 
+# DataParts ----
+
 h_get_data_parts <- function(empty = FALSE, placebo = TRUE) {
   d <- h_get_data(empty, placebo)
   if (empty) {
@@ -89,6 +95,8 @@ h_get_data_parts_1 <- function(empty = FALSE, placebo = TRUE) {
   }
 }
 
+# DataMixture ----
+
 h_get_data_mixture <- function(empty = FALSE, placebo = TRUE) {
   d <- h_get_data(empty, placebo)
   if (empty) {
@@ -103,6 +111,8 @@ h_get_data_mixture <- function(empty = FALSE, placebo = TRUE) {
   }
 }
 
+# DataDA ----
+
 h_get_data_da <- function(empty = FALSE, placebo = TRUE) {
   d <- h_get_data(empty, placebo)
   if (empty) {
@@ -151,3 +161,23 @@ h_get_data_sr_2 <- function() {
     doseGrid = c(0.1, 0.5, 1.5, 3, 6, seq(from = 10, to = 80, by = 2))
   )
 }
+
+# DataGrouped ----
+
+h_get_data_grouped <- function(empty = FALSE, placebo = TRUE) {
+  d <- h_get_data(empty, placebo)
+  if (empty) {
+    .DataGrouped(d)
+  } else {
+    .DataGrouped(
+      d,
+      group = factor(
+        c(
+          "mono", "mono", "combo", "combo", "mono", "mono", "combo",
+          "combo", "mono", "mono", "combo", "combo"
+        ),
+        levels = c("mono", "combo")
+      )
+    )
+  }
+}