diff --git a/R/Design-class.R b/R/Design-class.R index 05db7632b..260d21820 100644 --- a/R/Design-class.R +++ b/R/Design-class.R @@ -552,6 +552,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 @@ -568,14 +570,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" @@ -590,6 +594,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 @@ -600,13 +605,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 ) } diff --git a/R/Design-methods.R b/R/Design-methods.R index e82331454..36b529ea5 100644 --- a/R/Design-methods.R +++ b/R/Design-methods.R @@ -4659,6 +4659,14 @@ 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 (current$combo$stop && !current$mono$stop && object@stop_mono_with_combo) { + current$mono$stop <- structure( + TRUE, + message = "mono stopped because combo stopped", + report_label = "mono stopped because combo stopped" + ) + current$mono$results <- h_unpack_stopit(current$mono$stop) + } if (current$first) current$first <- FALSE } current$mono$fit <- fit(current$samples, object@model, current$grouped, group = "mono") diff --git a/R/Design-validity.R b/R/Design-validity.R index e5e53be4c..e9a2937ec 100644 --- a/R/Design-validity.R +++ b/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() } diff --git a/examples/Design-class-DesignGrouped.R b/examples/Design-class-DesignGrouped.R index d116306ca..5d7230522 100644 --- a/examples/Design-class-DesignGrouped.R +++ b/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, ) diff --git a/man/DesignGrouped-class.Rd b/man/DesignGrouped-class.Rd index d44ef56eb..88174d3f1 100644 --- a/man/DesignGrouped-class.Rd +++ b/man/DesignGrouped-class.Rd @@ -14,6 +14,7 @@ DesignGrouped( combo = mono, first_cohort_mono_only = TRUE, same_dose = TRUE, + stop_mono_with_combo = FALSE, ... ) } @@ -28,6 +29,8 @@ DesignGrouped( \item{same_dose}{(\code{flag})\cr see slot definition.} +\item{stop_mono_with_combo}{(\code{flag})\cr see slot definition.} + \item{...}{not used.} } \description{ @@ -60,6 +63,9 @@ concurrent mono and combo cohorts.} \item{\code{same_dose}}{(\code{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.} + +\item{\code{stop_mono_with_combo}}{(\code{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).} }} \note{ @@ -108,17 +114,31 @@ 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, ) } diff --git a/tests/testthat/test-Design-methods.R b/tests/testthat/test-Design-methods.R index 25d02705f..52a17dc05 100644 --- a/tests/testthat/test-Design-methods.R +++ b/tests/testthat/test-Design-methods.R @@ -330,6 +330,62 @@ 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), + stopping = StoppingMinPatients(nPatients = 20), + increments = IncrementsDoseLevels(levels = 5), + cohort_size = CohortSizeConst(3), + data = Data(doseGrid = 1:100), + startingDose = 10 + ) + combo_arm <- .Design( + mono_arm, + stopping = StoppingMinPatients(nPatients = 1) # Such that we stop after the first cohort. + ) + 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) + ) +}) + # examine ---- ## DADesign ---- diff --git a/tests/testthat/test-Design-validity.R b/tests/testthat/test-Design-validity.R index 651a1e3ba..71cc03041 100644 --- a/tests/testthat/test-Design-validity.R +++ b/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) })