Merge branch '866-tidy-dataordinal-produces-incorrect-results' of git…

…hub.com:openpharma/crmPack into 866-tidy-dataordinal-produces-incorrect-results

NAMESPACE

@@ -141,6 +141,7 @@ export(.DefaultGeneralSimulationsSummary)
 export(.DefaultIncrements)
 export(.DefaultIncrementsDoseLevels)
 export(.DefaultIncrementsHSRBeta)
+export(.DefaultIncrementsMaxToxProb)
 export(.DefaultIncrementsMin)
 export(.DefaultIncrementsOrdinal)
 export(.DefaultIncrementsRelative)
@@ -239,6 +240,7 @@ export(.GeneralSimulations)
 export(.GeneralSimulationsSummary)
 export(.IncrementsDoseLevels)
 export(.IncrementsHSRBeta)
+export(.IncrementsMaxToxProb)
 export(.IncrementsMin)
 export(.IncrementsOrdinal)
 export(.IncrementsRelative)
@@ -348,6 +350,7 @@ export(FractionalCRM)
 export(GeneralSimulations)
 export(IncrementsDoseLevels)
 export(IncrementsHSRBeta)
+export(IncrementsMaxToxProb)
 export(IncrementsMin)
 export(IncrementsOrdinal)
 export(IncrementsRelative)
@@ -558,6 +561,7 @@ exportClasses(GeneralSimulationsSummary)
 exportClasses(Increments)
 exportClasses(IncrementsDoseLevels)
 exportClasses(IncrementsHSRBeta)
+exportClasses(IncrementsMaxToxProb)
 exportClasses(IncrementsMin)
 exportClasses(IncrementsOrdinal)
 exportClasses(IncrementsRelative)

NEWS.md

@@ -1,5 +1,6 @@
 # Version 2.0.0.9000
 * **Note: This release (1.0 -> 2.0) signifies a major breaking revamp of the package.** Users are advised to carefully review the release notes and documentation for detailed information on the changes and any necessary updates to their existing code.
+* Implemented the `IncrementsMaxToxProb` class
 * Implemented `knit_print` methods for almost all `crmPack` classes to improve rendering in Markdown and Quarto documents.  See the vignette for more details.
 * Provided basic support for ordinal CRM models.  See the vignette for more details.
 * Implemented `broom`-like `tidy` methods for all concrete `crmPack` classes.  See the vignette for more details.

R/Rules-class.R

@@ -1539,6 +1539,65 @@ IncrementsOrdinal <- function(grade, rule) {
   )
 }
 
+# IncrementsMaxToxProb ----
+
+## class ----
+
+#' `IncrementsMaxToxProb`
+#'
+#' @description `r lifecycle::badge("experimental")`
+#'
+#' [`IncrementsMaxToxProb`] is the class for increments control based on
+#' probability of toxicity
+#'
+#' @slot prob (`numeric`)\cr See Usage Notes below.
+#'
+#' @section Usage Notes:
+#' For binary models, `prob` should be a scalar probability.
+#'
+#' For ordinal models, `prob` should be a named vector containing the maximum
+#' permissible probability of toxicity by grade.  The names should match the
+#' names of the `yCategories` slot of the associated `DataOrdinal` object.
+#'
+#' @aliases IncrementsMaxToxProb
+#' @export
+#'
+.IncrementsMaxToxProb <- setClass(
+  Class = "IncrementsMaxToxProb",
+  slots = c(
+    prob = "numeric"
+  ),
+  prototype = prototype(
+    prob = c("DLAE" = 0.2, "DLT" = 0.05)
+  ),
+  contains = "Increments",
+  validity = v_increments_maxtoxprob
+)
+
+## constructor ----
+
+#' @rdname IncrementsMaxToxProb-class
+#'
+#' @param prob (`numeric`)\cr see slot definition.
+#'
+#' @export
+#' @example examples/Rules-class-IncrementsMaxToxProb.R
+#'
+IncrementsMaxToxProb <- function(prob) {
+  .IncrementsMaxToxProb(
+    prob = prob
+  )
+}
+
+## default constructor ----
+
+#' @rdname IncrementsMaxToxProb-class
+#' @note Typically, end users will not use the `.DefaultIncrementsMaxToxProb()` function.
+#' @export
+.DefaultIncrementsMaxToxProb <- function() {
+  IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "DLT" = 0.05))
+}
+
 # Stopping ----
 
 ## class ----

R/Rules-methods.R

@@ -1725,6 +1725,92 @@ setMethod(
   }
 )
 
+## IncrementsMaxToxProb ----
+
+#' @describeIn maxDose determine the maximum possible next dose based on the
+#' probability of toxicity
+#' @param model (`GeneralModel`)\cr The model on which probabilities will be based
+#' @param samples (`Samples`)\cr The MCMC samples to which `model` will be applied
+#'
+#' @aliases maxDose-IncrementsMaxToxProb
+#'
+#' @export
+#' @example examples/Rules-method-maxDose-IncrementsMaxToxProb.R
+#'
+setMethod(
+  f = "maxDose",
+  signature = signature(
+    increments = "IncrementsMaxToxProb",
+    data = "DataOrdinal"
+  ),
+  definition = function(increments, data, model, samples, ...) {
+    assert_class(samples, "Samples")
+    assert_true(length(increments@prob) == length(data@yCategories) - 1)
+    nm <- utils::tail(names(data@yCategories), -1)
+    assert_set_equal(names(increments@prob), nm)
+
+    probs <- dplyr::bind_rows(
+      lapply(
+        seq_along(increments@prob),
+        function(g) {
+          fitted_probs <- fit(samples, model, data, grade = g, ...)
+          safe_fitted_probs <- dplyr::filter(fitted_probs, middle < increments@prob[nm[g]])
+          highest_safe_fitted_prob <- utils::tail(safe_fitted_probs, 1)
+        }
+      )
+    )
+    min(probs$dose)
+  }
+)
+#' @describeIn maxDose determine the maximum possible next dose based on the
+#' probability of toxicity
+#' @param model (`GeneralModel`)\cr The model on which probabilities will be based
+#' @param samples (`Samples`)\cr The MCMC samples to which `model` will be applied
+#'
+#' @aliases maxDose-IncrementsMaxToxProb
+#'
+#' @export
+#' @example examples/Rules-method-maxDose-IncrementsMaxToxProb.R
+#'
+setMethod(
+  f = "maxDose",
+  signature = signature(
+    increments = "IncrementsMaxToxProb",
+    data = "Data"
+  ),
+  definition = function(increments, data, model, samples, ...) {
+    assert_class(samples, "Samples")
+    assert_true(length(increments@prob) == 1)
+
+    fitted_prob <- fit(samples, model, data, ...)
+    safe_fitted_prob <- dplyr::filter(fitted_prob, middle < increments@prob)
+    highest_safe_fitted_prob <- utils::tail(safe_fitted_prob, 1)
+    highest_safe_fitted_prob$dose
+  }
+)
+
+## tidy-IncrementsMaxToxProb ----
+
+#' @rdname tidy
+#' @aliases tidy-IncrementsMaxToxProb
+#' @example examples/Rules-method-tidyIncrementsMaxToxProb.R
+#' @export
+setMethod(
+  f = "tidy",
+  signature = signature(x = "IncrementsMaxToxProb"),
+  definition = function(x, ...) {
+    grades <- names(x@prob)
+    if (is.null(grades)) {
+      grades <- "1"
+    }
+    tibble(
+      Grade = grades,
+      Prob = x@prob
+    ) %>%
+      h_tidy_class(x)
+  }
+)
+
 # nolint start
 
 ## ============================================================

R/Rules-validity.R

@@ -330,6 +330,16 @@ v_increments_min <- function(object) {
   v$result()
 }
 
+#' @describeIn v_increments validates the [`IncrementsMaxToxProb`]
+v_increments_maxtoxprob <- function(object) {
+  v <- Validate()
+  v$check(
+    test_probabilities(object@prob),
+    "prob must be a vector of probabilities with minimum length 1 and no missing values"
+  )
+  v$result()
+}
+
 # Stopping ----
 
 #' Internal Helper Functions for Validation of [`Stopping`] Objects

_pkgdown.yaml

@@ -115,6 +115,7 @@ reference:
       - IncrementsDoseLevels
       - IncrementsHSRBeta
       - IncrementsMin
+      - IncrementsMaxToxProb
       - Stopping
       - StoppingMissingDose
       - StoppingCohortsNearDose
@@ -244,6 +245,7 @@ reference:
       - v_increments_dose_levels
       - v_increments_hsr_beta
       - v_increments_min
+      - v_increments_maxtoxprob
       - v_starting_dose
       - v_stopping_cohorts_near_dose
       - v_stopping_min_cohorts
@@ -395,6 +397,7 @@ reference:
       - maxDose-IncrementsDoseLevels
       - maxDose-IncrementsHSRBeta
       - maxDose-IncrementsMin
+      - maxDose-IncrementsMaxToxProb
   - title: Functions
     contents:
       - enable_logging
@@ -421,6 +424,7 @@ reference:
       - GeneralSimulations-class
       - GeneralSimulations
       - GeneralSimulationsSummary-class
+      - IncrementsMaxToxProb-class
       - LogisticLogNormalOrdinal-class
       - MinimalInformative
       - NextBestOrdinal-class

examples/Rules-class-IncrementsMaxToxProb.R

@@ -0,0 +1,5 @@
+# For use with binary models and data
+IncrementsMaxToxProb(prob = 0.35)
+
+# For use with ordinal models and data
+IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "DLT" = 0.05))

examples/Rules-method-maxDose-IncrementsMaxToxProb.R

@@ -0,0 +1,17 @@
+model <- LogisticLogNormalOrdinal(
+  mean = c(0.25, 0.15, 0.5),
+  cov = matrix(c(1.5, 0, 0, 0, 2, 0, 0, 0, 1), nrow = 3),
+  ref_dose = 30
+)
+
+emptyData <- DataOrdinal(
+  doseGrid = c(1, 3, 9, 25, 50, 75, 100),
+  yCategories = c("No tox" = 0L, "DLAE" = 1L, "CRS" = 2L)
+)
+
+# For warning regarding tox, see issue #748 https://github.com/openpharma/crmPack/issues/748
+suppressWarnings({
+  samples <- mcmc(emptyData, model, .DefaultMcmcOptions())
+})
+toxIncrements <- IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05))
+maxDose(toxIncrements, emptyData, model, samples)

examples/Rules-method-tidyIncrementsMaxToxProb.R

@@ -0,0 +1 @@
+IncrementsMaxToxProb(prob = c("DLAE" = 0.2, "CRS" = 0.05)) %>% tidy()