Implementing the DataOrdinal class (#667)

Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: cicdguy <26552821+cicdguy@users.noreply.github.com>

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'

NAMESPACE

@@ -19,6 +19,7 @@ export(.DataDA)
 export(.DataDual)
 export(.DataGrouped)
 export(.DataMixture)
+export(.DataOrdinal)
 export(.DataParts)
 export(.DefaultCohortSizeConst)
 export(.DefaultCohortSizeDLT)
@@ -187,6 +188,7 @@ export(DataDA)
 export(DataDual)
 export(DataGrouped)
 export(DataMixture)
+export(DataOrdinal)
 export(DataParts)
 export(Design)
 export(DualDesign)
@@ -373,6 +375,7 @@ exportClasses(DataDA)
 exportClasses(DataDual)
 exportClasses(DataGrouped)
 exportClasses(DataMixture)
+exportClasses(DataOrdinal)
 exportClasses(DataParts)
 exportClasses(Design)
 exportClasses(DualDesign)

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.