add feature needed to stop mono arm when combo arm stops (#701)

R/Design-class.R

@@ -887,6 +887,8 @@ DADesign <- function(model, data,
 #'   concurrent mono and combo cohorts.
 #' @slot same_dose (`flag`)\cr whether the lower dose of the separately determined mono and combo
 #'   doses should be used as the next dose for both mono and combo.
+#' @slot stop_mono_with_combo (`flag`)\cr whether the mono arm should be stopped when the combo
+#'   arm is stopped (this makes sense when the only real trial objective is the recommended combo dose).
 #'
 #' @details Note that the model slots inside the `mono` and `combo` parameters
 #'   are ignored (because we don't fit separate regression models for the mono and
@@ -903,14 +905,16 @@ DADesign <- function(model, data,
     mono = "Design",
     combo = "Design",
     first_cohort_mono_only = "logical",
-    same_dose = "logical"
+    same_dose = "logical",
+    stop_mono_with_combo = "logical"
   ),
   prototype = prototype(
     model = .DefaultLogisticLogNormalGrouped(),
     mono = .Design(),
     combo = .Design(),
     first_cohort_mono_only = TRUE,
-    same_dose = TRUE
+    same_dose = TRUE,
+    stop_mono_with_combo = FALSE
   ),
   validity = v_design_grouped,
   contains = "CrmPackClass"
@@ -925,6 +929,7 @@ DADesign <- function(model, data,
 #' @param combo (`Design`)\cr see slot definition.
 #' @param first_cohort_mono_only (`flag`)\cr see slot definition.
 #' @param same_dose (`flag`)\cr see slot definition.
+#' @param stop_mono_with_combo (`flag`)\cr see slot definition.
 #' @param ... not used.
 #'
 #' @export
@@ -935,13 +940,15 @@ DesignGrouped <- function(model,
                           combo = mono,
                           first_cohort_mono_only = TRUE,
                           same_dose = TRUE,
+                          stop_mono_with_combo = FALSE,
                           ...) {
   .DesignGrouped(
     model = model,
     mono = mono,
     combo = combo,
     first_cohort_mono_only = first_cohort_mono_only,
-    same_dose = same_dose
+    same_dose = same_dose,
+    stop_mono_with_combo = stop_mono_with_combo
   )
 }
 

R/Design-methods.R

@@ -4723,6 +4723,22 @@ setMethod(
           if (object@same_dose && !current$mono$stop && !current$combo$stop) {
             current$mono$dose <- current$combo$dose <- min(current$mono$dose, current$combo$dose)
           }
+          if (object@stop_mono_with_combo) {
+            if (current$combo$stop && !current$mono$stop) {
+              current$mono$stop <- structure(
+                TRUE,
+                message = "mono stopped because combo stopped",
+                report_label = "mono stopped because combo stopped"
+              )
+              new_result <- TRUE
+            } else {
+              new_result <- FALSE
+            }
+            current$mono$results <- c(
+              current$mono$results,
+              "mono stopped because combo stopped" = new_result
+            )
+          }
           if (current$first) current$first <- FALSE
         }
         current$mono$fit <- fit(current$samples, object@model, current$grouped, group = "mono")

R/Design-validity.R

@@ -41,5 +41,9 @@ v_design_grouped <- function(object) {
     test_flag(object@same_dose),
     "same_dose must be a flag"
   )
+  v$check(
+    test_flag(object@stop_mono_with_combo),
+    "stop_mono_with_combo must be a flag"
+  )
   v$result()
 }

examples/Design-class-DesignGrouped.R

@@ -40,16 +40,30 @@ my_increments <- IncrementsRelative(
   increments = c(1, 0.33)
 )
 
+# Rules to be used for both arms.
+one_arm <- Design(
+  model = .DefaultModelLogNormal(), # Ignored.
+  nextBest = my_next_best,
+  stopping = my_stopping,
+  increments = my_increments,
+  cohort_size = my_size,
+  data = empty_data,
+  startingDose = 3
+)
+
 # Initialize the design.
 design <- DesignGrouped(
   model = my_model,
-  mono = Design(
-    model = .DefaultModelLogNormal(), # Ignored.
-    nextBest = my_next_best,
-    stopping = my_stopping,
-    increments = my_increments,
-    cohort_size = my_size,
-    data = empty_data,
-    startingDose = 3
-  )
+  mono = one_arm
+)
+
+# Alternative options: Here e.g. use both mono and combo from the start,
+# but allow different dose levels for the cohorts. Stop mono arm too, when combo
+# arm is stopped.
+design2 <- DesignGrouped(
+  model = my_model,
+  mono = one_arm,
+  first_cohort_mono_only = FALSE,
+  same_dose = FALSE,
+  stop_mono_with_combo = TRUE,
 )

examples/Design-method-simulate-DesignGrouped.R

@@ -1,6 +1,6 @@
 # Assemble ingredients for our group design.
 my_stopping <- StoppingTargetProb(target = c(0.2, 0.35), prob = 0.5) |
-  StoppingMinPatients(20) |
+  StoppingMinPatients(10) |
   StoppingMissingDose()
 my_increments <- IncrementsDoseLevels(levels = 3L)
 my_next_best <- NextBestNCRM(
@@ -52,7 +52,7 @@ legend("topright", c("mono", "combo"), lty = c(1, 2), col = c(1, 2))
 set.seed(123)
 my_sims <- simulate(
   my_design,
-  nsim = 4, # This should be at least 100 in actual applications.
+  nsim = 1, # This should be at least 100 in actual applications.
   seed = 123,
   truth = my_truth,
   combo_truth = my_combo_truth

tests/testthat/test-Design-methods.R

@@ -364,6 +364,119 @@ test_that("simulate for DesignGrouped works with different starting doses and fi
   expect_true(all(combo_trial@xLevel[1:3] == 5))
 })
 
+test_that("simulate for DesignGrouped allows to stop mono when combo stops", {
+  mono_arm <- Design(
+    model = .LogisticNormal(),
+    nextBest = NextBestNCRM(target = c(0.3, 0.6), overdose = c(0.6, 1), max_overdose_prob = 0.7),
+    # With a custom label that we can check below.
+    stopping = StoppingMinPatients(nPatients = 20, report_label = "my label"),
+    increments = IncrementsDoseLevels(levels = 5),
+    cohort_size = CohortSizeConst(3),
+    data = Data(doseGrid = 1:100),
+    startingDose = 10
+  )
+  combo_arm <- .Design(
+    mono_arm,
+    # Such that we stop after the first cohort.
+    stopping = StoppingMinPatients(nPatients = 1)
+  )
+  object <- DesignGrouped(
+    model = LogisticLogNormalGrouped(mean = rep(-1, 4), cov = diag(5, 4), ref_dose = 1),
+    mono = mono_arm,
+    combo = combo_arm,
+    same_dose = FALSE,
+    first_cohort_mono_only = FALSE,
+    stop_mono_with_combo = TRUE
+  )
+  my_truth <- function(x) plogis(-4 + 0.2 * log(x / 0.1))
+  my_combo_truth <- function(x) plogis(-4 + 0.5 * log(x / 0.1))
+
+  result <- expect_silent(simulate(
+    object,
+    nsim = 2,
+    seed = 123,
+    truth = my_truth,
+    combo_truth = my_combo_truth,
+    mcmcOptions = h_get_mcmc_options()
+  ))
+
+  expect_list(result)
+  expect_names(names(result), identical.to = c("mono", "combo"))
+  expect_valid(result$mono, "Simulations")
+  expect_valid(result$combo, "Simulations")
+
+  # We see the expected stop reasons.
+  expect_identical(
+    result$mono@stop_reasons,
+    rep(list("mono stopped because combo stopped"), 2)
+  )
+  expect_identical(
+    result$combo@stop_reasons,
+    rep(list("Number of patients is 3 and thus reached the prespecified minimum number 1"), 2)
+  )
+
+  # But mono still had the initial 3 patients in both simulations.
+  expect_identical(
+    lapply(result$mono@data, slot, "nObs"),
+    rep(list(3L), 2)
+  )
+
+  # And we see the stop report includes the previous stopping rule too.
+  expect_identical(
+    colnames(result$mono@stop_report),
+    c("my label", "mono stopped because combo stopped")
+  )
+})
+
+test_that("simulate for DesignGrouped reports correctly when mono is not stopped because of combo", {
+  mono_arm <- Design(
+    model = .LogisticNormal(),
+    nextBest = NextBestNCRM(target = c(0.2, 0.4), overdose = c(0.4, 1), max_overdose_prob = 0.7),
+    # With a custom label that we can check below.
+    stopping = StoppingTargetProb(report_label = "my label"),
+    increments = IncrementsDoseLevels(levels = 5),
+    cohort_size = CohortSizeConst(3),
+    data = Data(doseGrid = 1:100),
+    startingDose = 10
+  )
+  object <- DesignGrouped(
+    model = LogisticLogNormalGrouped(mean = rep(-1, 4), cov = diag(5, 4), ref_dose = 1),
+    mono = mono_arm,
+    combo = mono_arm,
+    same_dose = FALSE,
+    first_cohort_mono_only = FALSE,
+    stop_mono_with_combo = TRUE
+  )
+  my_truth <- function(x) plogis(-4 + 0.2 * log(x / 0.1))
+  my_combo_truth <- function(x) plogis(-4 + 0.5 * log(x / 0.1))
+
+  set.seed(123)
+  result <- expect_silent(simulate(
+    object,
+    nsim = 2,
+    seed = 123,
+    truth = my_truth,
+    combo_truth = my_combo_truth,
+    mcmcOptions = h_get_mcmc_options()
+  ))
+
+  expect_list(result)
+  expect_names(names(result), identical.to = c("mono", "combo"))
+  expect_valid(result$mono, "Simulations")
+  expect_valid(result$combo, "Simulations")
+
+  # We see the stop report includes the previous stopping rule and the mono because combo thing too.
+  expect_identical(
+    colnames(result$mono@stop_report),
+    c("my label", "mono stopped because combo stopped")
+  )
+  # But not for the combo.
+  expect_identical(
+    colnames(result$combo@stop_report),
+    "my label"
+  )
+})
+
 # examine ----
 
 ## DADesign ----

tests/testthat/test-Design-validity.R

@@ -74,11 +74,13 @@ test_that("v_design_grouped messages wrong flag slots as expected", {
 
   object@same_dose <- c(NA, TRUE)
   object@first_cohort_mono_only <- logical()
+  object@stop_mono_with_combo <- c(FALSE, FALSE)
 
   result <- v_design_grouped(object)
   expected <- c(
     "first_cohort_mono_only must be a flag",
-    "same_dose must be a flag"
+    "same_dose must be a flag",
+    "stop_mono_with_combo must be a flag"
   )
   expect_identical(result, expected)
 })