tests/testthat/test-Design-methods.R

In crmPack: Object-Oriented Implementation of Dose Escalation Designs

skip_on_cran()
options(testthat.progress.max_fails = 0)

#' @include("helper-design.R")

# simulate ----

## Design ----

test_that("simulate produces consistent results with placebo data", {
  design <- h_get_design_data(TRUE)
  myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8)
  options <- h_get_mcmc_options()

  result <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE
  )

  expect_snapshot(result)
})

test_that("simulate produces consistent results with sentinel patients", {
  design <- h_get_design_data()
  myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8)
  options <- h_get_mcmc_options()

  result <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE,
    firstSeparate = TRUE
  )

  expect_snapshot(result)
})

test_that("simulate for the class design returns correct objects", {
  design <- h_get_design_data()
  myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8)
  options <- h_get_mcmc_options()

  mySims <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE,
    derive = list(
      max_mtd = max,
      mean_mtd = mean,
      median_mtd = median
    )
  )

  expect_class(mySims, "Simulations") # check for correct class of returned object

  expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric

  expect_equal(length(mySims@stop_report), 6) # check for length

  expect_logical(mySims@stop_report) # check for stop_report to be logical vector

  expect_list(mySims@data)

  expect_class(mySims@data[[1]], "Data") # check for data object has correct class

  expect_list(mySims@additional_stats)

  expect_list(mySims@additional_stats[[1]])

  expect_length(mySims@additional_stats[[1]], 3)

  expect_equal(mySims@doses, 1)
})

test_that("simulate for the class design with placebo returns correct objects", {
  design <- h_get_design_data(TRUE)
  myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8)
  options <- h_get_mcmc_options()

  mySims <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE,
    derive = list(
      max_mtd = max,
      mean_mtd = mean,
      median_mtd = median
    )
  )

  expect_class(mySims, "Simulations") # check for correct class of returned object

  expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric

  expect_equal(length(mySims@stop_report), 6) # check for length

  expect_logical(mySims@stop_report) # check for stop_report to be logical vector

  expect_list(mySims@data)

  expect_class(mySims@data[[1]], "Data") # check for data object has correct class

  expect_list(mySims@additional_stats)

  expect_list(mySims@additional_stats[[1]])

  expect_length(mySims@additional_stats[[1]], 3)

  expect_equal(mySims@doses, 1)
})

test_that("simulate for the class design with placebo and sentinel patients returns correct objects", {
  design <- h_get_design_data(TRUE)
  myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8)
  options <- h_get_mcmc_options()

  mySims <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE,
    firstSeparate = TRUE,
    derive = list(
      max_mtd = max,
      mean_mtd = mean,
      median_mtd = median
    )
  )

  expect_class(mySims, "Simulations") # check for correct class of returned object

  expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric

  expect_equal(length(mySims@stop_report), 6) # check for length

  expect_logical(mySims@stop_report) # check for stop_report to be logical vector

  expect_list(mySims@data)

  expect_class(mySims@data[[1]], "Data") # check for data object has correct class

  expect_list(mySims@additional_stats)

  expect_list(mySims@additional_stats[[1]])

  expect_length(mySims@additional_stats[[1]], 3)

  expect_equal(mySims@doses, 1)
})

test_that("Test if simulate generate the expected output.", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_logistic_normal()
  increments <- h_increments_relative()
  next_best <- h_next_best_ncrm()
  size <- CohortSizeConst(size = 3)

  # Extreme truth function, which has constant probability 1 in dose grid range.
  truth <- probFunction(model, alpha0 = 175, alpha1 = 5)
  stop_rule <- StoppingMinPatients(nPatients = 5)
  design <- Design(
    model = model,
    stopping = stop_rule,
    increments = increments,
    nextBest = next_best,
    cohort_size = size,
    data = data,
    startingDose = 25
  )

  my_options <- McmcOptions(
    burnin = 100,
    step = 2,
    samples = 5,
    rng_kind = "Mersenne-Twister",
    rng_seed = 3
  )

  sim <- simulate(
    design,
    nsim = 1,
    truth = truth,
    seed = 819,
    mcmcOptions = my_options
  )

  expect_snapshot(sim)
})

## NextBestInfTheory ----

test_that("NextBestInfTheory produces consistent results for empty data", {
  emptydata <- Data(doseGrid = seq(from = 40, to = 200, by = 10))

  # Set up the model; sigma0 = 1.0278, sigma1 = 1.65, rho = 0.5.
  model <- LogisticLogNormal(
    mean = c(-4.47, 0.0033),
    cov = matrix(c(1.056373, 0.847935, 0.847935, 2.722500), nrow = 2)
  )

  stop_rule <- StoppingMinPatients(nPatients = 30)
  increments <- IncrementsRelative(interval = 0, increments = 1)
  new_my_next_best <- NextBestInfTheory(target = 0.25, asymmetry = 0.1)
  cohort <- CohortSizeConst(size = 3)
  my_truth <- probFunction(model, alpha0 = 175, alpha1 = 5)

  design <- Design(
    model = model,
    stopping = stop_rule,
    increments = increments,
    nextBest = new_my_next_best,
    cohort_size = cohort,
    data = emptydata,
    startingDose = 40
  )

  sim <- simulate(
    design,
    nsim = 5,
    truth = my_truth,
    mcmcOptions = h_get_mcmc_options()
  )

  result <- summary(sim, truth = my_truth, target = new_my_next_best@target)

  expect_equal(
    result@fit_at_dose_most_selected,
    c(0.985602, 0.985602, 0.985602, 0.985602, 0.985602),
    tolerance = 1e-07
  )
  expect_equal(result@prop_dlts, rep(1L, 5))
  expect_equal(result@mean_tox_risk, rep(1L, 5))
  expect_equal(result@dose_selected, rep(40, 5))
  expect_equal(result@tox_at_doses_selected, rep(1L, 5))
  # expect_snapshot_value doesn't work here regardless of style
  expect_snapshot(result@mean_fit)
})

test_that("NextBestInfTheory produces consistent results with a dataset", {
  my_data <- h_get_data(placebo = FALSE)

  # Set up the model; sigma0 = 1.0278, sigma1 = 1.65, rho = 0.5.
  model <- LogisticLogNormal(
    mean = c(-4.47, 0.0033),
    cov = matrix(c(1.056373, 0.847935, 0.847935, 2.722500), nrow = 2)
  )

  stop_rule <- StoppingMinPatients(nPatients = 5)
  increments <- IncrementsRelative(interval = 0, increments = 1)
  new_my_next_best <- NextBestInfTheory(target = 0.25, asymmetry = 0.1)
  cohort <- CohortSizeConst(size = 3)
  my_truth <- probFunction(model, alpha0 = 175, alpha1 = 5)

  design <- Design(
    model = model,
    stopping = stop_rule,
    increments = increments,
    nextBest = new_my_next_best,
    cohort_size = cohort,
    data = my_data,
    startingDose = 25
  )

  sim <- simulate(
    design,
    nsim = 5,
    truth = my_truth,
    mcmcOptions = h_get_mcmc_options()
  )

  result <- summary(sim, truth = my_truth, target = new_my_next_best@target)
  expect_equal(
    result@fit_at_dose_most_selected,
    c(0.222, 0.222, 0.222, 0.222, 0.222),
    tolerance = 1e-02
  )
  expect_equal(result@prop_dlts, rep(0.267, 5), tolerance = 1e-02)
  expect_equal(result@mean_tox_risk, rep(1L, 5))
  expect_equal(result@dose_selected, rep(50, 5))
  expect_equal(result@tox_at_doses_selected, rep(1L, 5))
  # expect_snapshot_value doesn't work here, regardless of style
  expect_snapshot(result@mean_fit)
})

## stop_reasons integration test ----

test_that("stop_reasons can be NA with certain stopping rule settings", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_logistic_normal()
  increments <- h_increments_relative()
  next_best <- h_next_best_ncrm()
  size <- CohortSizeConst(size = 3)
  # Extreme truth function, which has constant probability 1 in dose grid range.
  truth <- probFunction(model, alpha0 = 175, alpha1 = 5)
  stopping <- StoppingMissingDose()
  design <- Design(
    model = model,
    stopping = stopping,
    increments = increments,
    nextBest = next_best,
    cohort_size = size,
    data = data,
    startingDose = 25
  )
  sim <- simulate(
    design,
    nsim = 5,
    truth = truth,
    seed = 819,
    mcmcOptions = h_get_mcmc_options()
  )
  result <- sim@stop_reasons
  # In this case the trial always stops because no dose is deemed safe enough
  # to continue the trial. This is the default behavior of the
  # stopTrial() method.
  expected <- list(
    "Next dose is NA , i.e., no active dose is safe enough according to the NextBest rule.",
    "Next dose is NA , i.e., no active dose is safe enough according to the NextBest rule.",
    "Next dose is NA , i.e., no active dose is safe enough according to the NextBest rule.",
    "Next dose is NA , i.e., no active dose is safe enough according to the NextBest rule.",
    "Next dose is NA , i.e., no active dose is safe enough according to the NextBest rule."
  )
  expect_identical(result, expected)
})

## RuleDesign ----

test_that("simulate-RuleDesign produces consistent results", {
  design <- ThreePlusThreeDesign(
    doseGrid = c(1, 3, 5, 10, 15, 20, 25, 40, 50, 80, 100)
  )
  myTruth <- function(x) {
    seq(0.05, 0.55, length.out = length(design@data@doseGrid))
  }
  options <- h_get_mcmc_options()

  result <- simulate(
    design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE,
    firstSeparate = TRUE
  )

  expect_snapshot(result)
})

## DualDesign ----

test_that("simulate-DualDesign produces consistent results", {
  design <- h_get_design_dualdata()

  # define scenarios for the TRUE toxicity and efficacy profiles
  betaMod <- function(dose, e0, eMax, delta1, delta2, scal) {
    maxDens <- (delta1^delta1) *
      (delta2^delta2) /
      ((delta1 + delta2)^(delta1 + delta2))
    dose <- dose / scal
    e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2
  }

  trueBiomarker <- function(dose) {
    betaMod(
      dose,
      e0 = 0.2,
      eMax = 0.6,
      delta1 = 5,
      delta2 = 5 * 0.5 / 0.5,
      scal = 100
    )
  }

  trueTox <- function(dose) {
    pnorm((dose - 60) / 10)
  }

  result <- simulate(
    design,
    trueTox = trueTox,
    trueBiomarker = trueBiomarker,
    sigma2W = 0.01,
    rho = 0,
    nsim = 1,
    parallel = FALSE,
    seed = 3,
    startingDose = 6,
    mcmcOptions = McmcOptions(
      burnin = 100,
      step = 1,
      samples = 300,
      rng_kind = "Mersenne-Twister",
      rng_seed = 1234
    )
  )

  expect_snapshot(result)
})

test_that("simulate-DualDesign produces consistent results with sentinel patients", {
  design <- h_get_design_dualdata()

  # define scenarios for the TRUE toxicity and efficacy profiles
  betaMod <- function(dose, e0, eMax, delta1, delta2, scal) {
    maxDens <- (delta1^delta1) *
      (delta2^delta2) /
      ((delta1 + delta2)^(delta1 + delta2))
    dose <- dose / scal
    e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2
  }

  trueBiomarker <- function(dose) {
    betaMod(
      dose,
      e0 = 0.2,
      eMax = 0.6,
      delta1 = 5,
      delta2 = 5 * 0.5 / 0.5,
      scal = 100
    )
  }

  trueTox <- function(dose) {
    pnorm((dose - 60) / 10)
  }

  result <- simulate(
    design,
    trueTox = trueTox,
    trueBiomarker = trueBiomarker,
    sigma2W = 0.01,
    rho = 0,
    nsim = 1,
    parallel = FALSE,
    seed = 3,
    startingDose = 6,
    firstSeparate = TRUE,
    mcmcOptions = McmcOptions(
      burnin = 100,
      step = 1,
      samples = 300,
      rng_kind = "Mersenne-Twister",
      rng_seed = 1234
    )
  )

  expect_equal(result@rho_est, 0.07991541, tolerance = 1e-7) # printed result

  expect_equal(result@rho_est, 0.079915412) # actual result

  expect_equal(result@sigma2w_est, 0.03177778, tolerance = 1e-7) # printed result

  expect_equal(result@sigma2w_est, 0.031777778) # actual result

  expect_equal(any(sapply(result@fit_biomarker[[1]], is.numeric)), TRUE) # all elements of fit are numeric

  expect_equal(dim(result@fit_biomarker[[1]])[1], 11)

  expect_equal(dim(result@fit_biomarker[[1]])[2], 3)

  expect_equal(length(result@stop_report), 4) # check for length

  expect_logical(result@stop_report) # check for stop_report to be logical vector

  expect_list(result@data)

  expect_class(result@data[[1]], "Data") # check for data object has correct class

  expect_list(result@additional_stats)

  expect_list(result@additional_stats[[1]])

  expect_length(result@additional_stats[[1]], 0)

  expect_equal(result@doses, 1)
})

test_that("simulate-DualDesign produces consistent results", {
  design <- h_get_design_dualdata(TRUE)

  # define scenarios for the TRUE toxicity and efficacy profiles
  betaMod <- function(dose, e0, eMax, delta1, delta2, scal) {
    maxDens <- (delta1^delta1) *
      (delta2^delta2) /
      ((delta1 + delta2)^(delta1 + delta2))
    dose <- dose / scal
    e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2
  }

  trueBiomarker <- function(dose) {
    betaMod(
      dose,
      e0 = 0.2,
      eMax = 0.6,
      delta1 = 5,
      delta2 = 5 * 0.5 / 0.5,
      scal = 100
    )
  }

  trueTox <- function(dose) {
    pnorm((dose - 60) / 10)
  }

  result <- simulate(
    design,
    trueTox = trueTox,
    trueBiomarker = trueBiomarker,
    sigma2W = 0.01,
    rho = 0,
    nsim = 1,
    parallel = FALSE,
    seed = 3,
    startingDose = 6,
    mcmcOptions = McmcOptions(
      burnin = 100,
      step = 1,
      samples = 300,
      rng_kind = "Mersenne-Twister",
      rng_seed = 1234
    )
  )

  expect_snapshot(result)
})

test_that("simulate-DualDesign produces consistent results with sentinel patients", {
  design <- h_get_design_dualdata()

  # define scenarios for the TRUE toxicity and efficacy profiles
  betaMod <- function(dose, e0, eMax, delta1, delta2, scal) {
    maxDens <- (delta1^delta1) *
      (delta2^delta2) /
      ((delta1 + delta2)^(delta1 + delta2))
    dose <- dose / scal
    e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2
  }

  trueBiomarker <- function(dose) {
    betaMod(
      dose,
      e0 = 0.2,
      eMax = 0.6,
      delta1 = 5,
      delta2 = 5 * 0.5 / 0.5,
      scal = 100
    )
  }

  trueTox <- function(dose) {
    pnorm((dose - 60) / 10)
  }

  result <- simulate(
    design,
    trueTox = trueTox,
    trueBiomarker = trueBiomarker,
    sigma2W = 0.01,
    rho = 0,
    nsim = 1,
    parallel = FALSE,
    seed = 3,
    startingDose = 6,
    firstSeparate = TRUE,
    mcmcOptions = McmcOptions(
      burnin = 100,
      step = 1,
      samples = 300,
      rng_kind = "Mersenne-Twister",
      rng_seed = 1234
    )
  )

  expect_equal(result@rho_est, 0.07991541, tolerance = 1e-7) # printed result

  expect_equal(result@rho_est, 0.079915412) # actual result

  expect_equal(result@sigma2w_est, 0.03177778, tolerance = 1e-7) # printed result

  expect_equal(result@sigma2w_est, 0.031777778) # actual result

  expect_equal(any(sapply(result@fit_biomarker[[1]], is.numeric)), TRUE) # all elements of fit are numeric

  expect_equal(dim(result@fit_biomarker[[1]])[1], 11)

  expect_equal(dim(result@fit_biomarker[[1]])[2], 3)

  expect_equal(length(result@stop_report), 4) # check for length

  expect_logical(result@stop_report) # check for stop_report to be logical vector

  expect_list(result@data)

  expect_class(result@data[[1]], "Data") # check for data object has correct class

  expect_list(result@additional_stats)

  expect_list(result@additional_stats[[1]])

  expect_length(result@additional_stats[[1]], 0)

  expect_equal(result@doses, 1)
})

test_that("simulate-DualDesign produces consistent results", {
  design <- h_get_design_dualdata(TRUE)

  # define scenarios for the TRUE toxicity and efficacy profiles
  betaMod <- function(dose, e0, eMax, delta1, delta2, scal) {
    maxDens <- (delta1^delta1) *
      (delta2^delta2) /
      ((delta1 + delta2)^(delta1 + delta2))
    dose <- dose / scal
    e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2
  }

  trueBiomarker <- function(dose) {
    betaMod(
      dose,
      e0 = 0.2,
      eMax = 0.6,
      delta1 = 5,
      delta2 = 5 * 0.5 / 0.5,
      scal = 100
    )
  }

  trueTox <- function(dose) {
    pnorm((dose - 60) / 10)
  }

  result <- simulate(
    design,
    trueTox = trueTox,
    trueBiomarker = trueBiomarker,
    sigma2W = 0.01,
    rho = 0,
    nsim = 1,
    parallel = FALSE,
    seed = 3,
    startingDose = 6,
    mcmcOptions = McmcOptions(
      burnin = 100,
      step = 1,
      samples = 300,
      rng_kind = "Mersenne-Twister",
      rng_seed = 1234
    )
  )

  expect_snapshot(result)
})

## TDSamplesDesign ----

test_that("simulate-TDSamplesDesign produces consistent results", {
  data <- Data(doseGrid = seq(25, 300, 25))

  model <- LogisticIndepBeta(
    binDLE = c(1.05, 1.8),
    DLEweights = c(3, 3),
    DLEdose = c(25, 300),
    data = data
  )
  tdNextBest <- NextBestTDsamples(
    prob_target_drt = 0.35,
    prob_target_eot = 0.3,
    derive = function(samples) {
      as.numeric(quantile(samples, probs = 0.3))
    }
  )
  mySize <- CohortSizeConst(size = 3)
  myIncrements <- IncrementsRelative(
    intervals = c(min(data@doseGrid), max(data@doseGrid)),
    increments = c(2, 2)
  )
  myStopping <- StoppingMinPatients(nPatients = 36)

  design <- TDsamplesDesign(
    model = model,
    nextBest = tdNextBest,
    stopping = myStopping,
    increments = myIncrements,
    cohort_size = mySize,
    data = data,
    startingDose = 25
  )
  myTruth <- probFunction(model, phi1 = -53.66584, phi2 = 10.50499)
  options <- McmcOptions(burnin = 100, step = 2, samples = 200)
  result <- simulate(
    object = design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE
  )

  expect_snapshot(result)
})

test_that("simulate-TDSamplesDesign produces consistent results with placebo patients", {
  data <- Data(
    # Note: we cannot use dose = 0 here because that would cause issues for the biomarker
    # modeling because we transform log(dose) there.
    doseGrid = c(1, seq(25, 300, 25)),
    placebo = TRUE
  )
  model <- LogisticIndepBeta(
    binDLE = c(1.05, 1.8),
    DLEweights = c(3, 3),
    DLEdose = c(25, 300),
    data = data
  )
  tdNextBest <- NextBestTDsamples(
    prob_target_drt = 0.35,
    prob_target_eot = 0.3,
    derive = function(samples) {
      as.numeric(quantile(samples, probs = 0.3))
    }
  )
  mySize <- CohortSizeConst(size = 3)
  myIncrements <- IncrementsRelative(
    intervals = c(min(data@doseGrid), max(data@doseGrid)),
    increments = c(2, 2)
  )
  myStopping <- StoppingMinPatients(nPatients = 36)

  design <- TDsamplesDesign(
    model = model,
    nextBest = tdNextBest,
    stopping = myStopping,
    increments = myIncrements,
    cohort_size = mySize,
    pl_cohort_size = CohortSizeConst(size = 1),
    data = data,
    startingDose = 100
  )
  myTruth <- probFunction(model, phi1 = -53.66584, phi2 = 10.50499)
  options <- McmcOptions(burnin = 100, step = 2, samples = 200)
  result <- simulate(
    object = design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    mcmcOptions = options,
    parallel = FALSE
  )
  expect_snapshot(result)
})

## TDDesign ----

test_that("simulate-TDDesign produces consistent results", {
  suppressWarnings({
    design <- h_get_design_tddesign()
  })

  myTruth <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)

  result <- simulate(
    object = design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    parallel = FALSE
  )
  expect_snapshot(result)
})

test_that("simulate-TDDesign with sentinel patient and placebo patients produces consistent results", {
  suppressWarnings({
    design <- h_get_design_tddesign(placebo = TRUE)
  })

  myTruth <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)

  result <- simulate(
    object = design,
    args = NULL,
    truth = myTruth,
    nsim = 1,
    seed = 819,
    firstSeparate = TRUE,
    parallel = FALSE
  )
  expect_snapshot(result)
})

## DualResponsesDesign ----

test_that("simulate-DualResponsesDesign produces consistent results", {
  design <- h_get_design_dualresponses()
  myTruthDLE <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)
  myTruthEff <- efficacyFunction(
    design@eff_model,
    theta1 = -4.818429,
    theta2 = 3.653058
  )

  myTruthGain <- function(dose) {
    myTruthEff(dose) / (1 + (myTruthDLE(dose) / (1 - myTruthDLE(dose))))
  }
  options <- McmcOptions(burnin = 100, step = 2, samples = 200)
  result <- simulate(
    object = design,
    args = NULL,
    trueDLE = myTruthDLE,
    trueEff = myTruthEff,
    trueNu = 1 / 0.025,
    nsim = 1,
    seed = 819,
    parallel = FALSE
  )

  expect_snapshot(result)
})

test_that("simulate-DualResponsesDesign with sentinel patient and placebo patients produces consistent results", {
  design <- h_get_design_dualresponses(placebo = TRUE)
  myTruthDLE <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)
  myTruthEff <- efficacyFunction(
    design@eff_model,
    theta1 = -4.818429,
    theta2 = 3.653058
  )

  myTruthGain <- function(dose) {
    myTruthEff(dose) / (1 + (myTruthDLE(dose) / (1 - myTruthDLE(dose))))
  }
  options <- McmcOptions(burnin = 100, step = 2, samples = 200)
  result <- simulate(
    object = design,
    args = NULL,
    trueDLE = myTruthDLE,
    trueEff = myTruthEff,
    trueNu = 1 / 0.025,
    nsim = 1,
    seed = 819,
    parallel = FALSE,
    firstSeparate = TRUE
  )
  expect_snapshot(result)
})

## DualResponsesSamplesDesign ----

test_that("simulate-DualResponsesSamplesDesign produces consistent results", {
  data <- DataDual(doseGrid = seq(25, 300, 25), placebo = FALSE)
  DLEmodel <- LogisticIndepBeta(
    binDLE = c(1.05, 1.8),
    DLEweights = c(3, 3),
    DLEdose = c(25, 300),
    data = data
  )

  Effmodel <- Effloglog(
    eff = c(1.223, 2.513),
    eff_dose = c(25, 300),
    nu = c(a = 1, b = 0.025),
    data = data
  )

  mynextbest <- NextBestMaxGainSamples(
    prob_target_drt = 0.35,
    prob_target_eot = 0.3,
    derive = function(samples) {
      as.numeric(quantile(samples, prob = 0.3))
    },
    mg_derive = function(mg_samples) {
      as.numeric(quantile(mg_samples, prob = 0.5))
    }
  )

  myIncrements <- IncrementsRelative(
    intervals = c(25, 300),
    increments = c(2, 2)
  )
  mySize <- CohortSizeConst(size = 3)
  myStopping <- StoppingMinPatients(nPatients = 10)

  # Specified the design
  design <- DualResponsesSamplesDesign(
    nextBest = mynextbest,
    cohort_size = mySize,
    startingDose = 25,
    model = DLEmodel,
    eff_model = Effmodel,
    data = data,
    stopping = myStopping,
    increments = myIncrements
  )

  myTruthDLE <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)
  myTruthEff <- efficacyFunction(
    design@eff_model,
    theta1 = -4.818429,
    theta2 = 3.653058
  )

  myTruthGain <- function(dose) {
    myTruthEff(dose) / (1 + (myTruthDLE(dose) / (1 - myTruthDLE(dose))))
  }

  options <- McmcOptions(burnin = 10, step = 1, samples = 50)
  result <- simulate(
    design,
    args = NULL,
    trueDLE = myTruthDLE,
    trueEff = myTruthEff,
    trueNu = 1 / 0.025,
    nsim = 1,
    mcmcOptions = options,
    seed = 819,
    parallel = FALSE
  )

  expect_snapshot(result)
})

test_that("simulate-DualResponsesSamplesDesign with sentinel patient and placebo dose produces consistent results", {
  data <- DataDual(doseGrid = c(10, seq(25, 300, 25)), placebo = TRUE)
  DLEmodel <- LogisticIndepBeta(
    binDLE = c(1.05, 1.8),
    DLEweights = c(3, 3),
    DLEdose = c(25, 300),
    data = data
  )

  Effmodel <- Effloglog(
    eff = c(1.223, 2.513),
    eff_dose = c(25, 300),
    nu = c(a = 1, b = 0.025),
    data = data
  )

  mynextbest <- NextBestMaxGainSamples(
    prob_target_drt = 0.35,
    prob_target_eot = 0.3,
    derive = function(samples) {
      as.numeric(quantile(samples, prob = 0.3))
    },
    mg_derive = function(mg_samples) {
      as.numeric(quantile(mg_samples, prob = 0.5))
    }
  )

  myIncrements <- IncrementsRelative(
    intervals = c(25, 300),
    increments = c(2, 2)
  )
  mySize <- CohortSizeConst(size = 3)
  myStopping <- StoppingMinPatients(nPatients = 10)

  # Specified the design
  design <- DualResponsesSamplesDesign(
    nextBest = mynextbest,
    cohort_size = mySize,
    pl_cohort_size = CohortSizeConst(size = 1),
    startingDose = 25,
    model = DLEmodel,
    eff_model = Effmodel,
    data = data,
    stopping = myStopping,
    increments = myIncrements
  )

  myTruthDLE <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)
  myTruthEff <- efficacyFunction(
    design@eff_model,
    theta1 = -4.818429,
    theta2 = 3.653058
  )

  myTruthGain <- function(dose) {
    myTruthEff(dose) / (1 + (myTruthDLE(dose) / (1 - myTruthDLE(dose))))
  }

  options <- McmcOptions(burnin = 10, step = 1, samples = 50)
  result <- simulate(
    design,
    args = NULL,
    trueDLE = myTruthDLE,
    trueEff = myTruthEff,
    trueNu = 1 / 0.025,
    nsim = 1,
    mcmcOptions = options,
    seed = 819,
    parallel = FALSE
  )
  expect_snapshot(result)
})

test_that("simulate-DualResponsesSamplesDesign with EffFlexi model produces consistent results", {
  data <- DataDual(doseGrid = seq(25, 300, 25), placebo = FALSE)
  DLEmodel <- LogisticIndepBeta(
    binDLE = c(1.05, 1.8),
    DLEweights = c(3, 3),
    DLEdose = c(25, 300),
    data = data
  )
  Effmodel <- EffFlexi(
    eff = c(1.223, 2.513),
    eff_dose = c(25, 300),
    sigma2W = c(a = 0.1, b = 0.1),
    sigma2betaW = 0.01,
    data = data
  )
  mynextbest <- NextBestMaxGainSamples(
    prob_target_drt = 0.35,
    prob_target_eot = 0.3,
    derive = function(samples) {
      as.numeric(quantile(samples, prob = 0.3))
    },
    mg_derive = function(mg_samples) {
      as.numeric(quantile(mg_samples, prob = 0.5))
    }
  )
  myIncrements <- IncrementsRelative(
    intervals = c(25, 300),
    increments = c(2, 2)
  )
  mySize <- CohortSizeConst(size = 3)
  myStopping <- StoppingMinPatients(nPatients = 10) | StoppingMissingDose()

  # Specified the design
  design <- DualResponsesSamplesDesign(
    nextBest = mynextbest,
    cohort_size = mySize,
    startingDose = 25,
    model = DLEmodel,
    eff_model = Effmodel,
    data = data,
    stopping = myStopping,
    increments = myIncrements
  )
  myTruthDLE <- probFunction(design@model, phi1 = -53.66584, phi2 = 10.50499)
  myTruthEff <- data@doseGrid
  myTruthGain <- function(dose) {
    myTruthEff(dose) / (1 + (myTruthDLE(dose) / (1 - myTruthDLE(dose))))
  }
  options <- McmcOptions(burnin = 10, step = 1, samples = 50)
  result <- simulate(
    design,
    args = NULL,
    trueDLE = myTruthDLE,
    trueEff = myTruthEff,
    trueNu = 1 / 0.025,
    trueSigma2 = 0.5,
    nsim = 1,
    mcmcOptions = options,
    seed = 819,
    parallel = FALSE
  )
  expect_snapshot(result)
})

## DesignGrouped ----

test_that("simulate for DesignGrouped works as expected", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsDoseLevels(levels = 5),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 1
    ),
    same_dose_for_all = TRUE,
    first_cohort_mono_only = 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")

  mono_trial <- result$mono@data[[2L]]
  combo_trial <- result$combo@data[[2L]]

  # First cohort is only mono at the starting dose (lowest in dose grid).
  expect_true(all(mono_trial@xLevel[1:3] == 1))

  # We have the same dose for subsequent cohorts.
  expect_true(all(mono_trial@xLevel[4:6] == combo_trial@xLevel[1:3]))
  expect_true(all(mono_trial@xLevel[7:9] == combo_trial@xLevel[4:6]))
})

test_that("simulate for DesignGrouped works as expected with different doses, parallel first cohort", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = 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 = 1
    ),
    same_dose_for_all = FALSE,
    first_cohort_mono_only = FALSE
  )
  my_truth <- function(x) plogis(-4 + 0.2 * log(x / 0.1))
  my_combo_truth <- function(x) plogis(-4 + 0.9 * log(x / 0.1))

  result <- expect_silent(simulate(
    object,
    nsim = 1,
    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")

  mono_trial <- result$mono@data[[1L]]
  combo_trial <- result$combo@data[[1L]]

  # First cohort is joint at starting dose.
  expect_true(all(mono_trial@xLevel[1:3] == combo_trial@xLevel[1:3]))

  # We have different doses in subsequent cohorts.
  expect_false(all(mono_trial@xLevel[4:20] == combo_trial@xLevel[4:20]))
})

test_that("simulate for DesignGrouped works when first patient is dosed separately, different combo design", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 10),
      increments = IncrementsDoseLevels(levels = 3),
      cohort_size = CohortSizeConst(2),
      data = Data(doseGrid = 1:100),
      startingDose = 10
    ),
    combo = 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 = 1
    ),
    same_dose_for_all = FALSE,
    first_cohort_mono_only = FALSE
  )
  my_truth <- function(x) plogis(-4 + 0.2 * log(x / 0.1))
  my_combo_truth <- function(x) plogis(-2 + 0.9 * log(x / 0.1))

  result <- expect_silent(simulate(
    object,
    nsim = 1,
    seed = 123,
    truth = my_truth,
    firstSeparate = TRUE,
    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")

  mono_trial <- result$mono@data[[1L]]
  combo_trial <- result$combo@data[[1L]]

  # We expect at least one cohort with just one patient in the combo arm here
  # because of the high toxicity.
  expect_true(any(table(combo_trial@cohort) == 1))

  # Check that we had the different cohort sizes between the two arms.
  expect_true(max(table(mono_trial@cohort)) == 2)
  expect_true(max(table(combo_trial@cohort)) == 3)

  # Check that we had different starting doses in the two arms.
  expect_true(mono_trial@x[1] == 10)
  expect_true(combo_trial@x[1] == 1)
})

test_that("simulate for DesignGrouped works with different starting doses and first mono", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsDoseLevels(levels = 5),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 10
    ),
    combo = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsRelative(c(0, 100), c(2, 1)),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 5
    ),
    same_dose_for_all = FALSE,
    first_cohort_mono_only = 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")

  mono_trial <- result$mono@data[[2L]]
  combo_trial <- result$combo@data[[2L]]

  # First cohort is only mono at the starting dose.
  expect_true(all(mono_trial@xLevel[1:3] == 10))

  # In first combo cohort we have the expected starting dose.
  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_for_all = 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.
  lapply(
    result$mono@stop_reasons,
    function(x) expect_subset("Based on external result stop", unlist(x))
  )
  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(NA, "my label", "Stop Mono with Combo")
  )
})

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_for_all = 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(NA, "my label", "Stop Mono with Combo")
  )
  # But not for the combo.
  expect_identical(
    colnames(result$combo@stop_report),
    "my label"
  )
})

test_that("simulate for DesignGrouped works with parallel start when first cohort mono only", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsDoseLevels(levels = 5),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 1
    ),
    combo = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsRelative(c(0, 100), c(2, 1)),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 1
    ),
    same_dose_for_all = FALSE,
    first_cohort_mono_only = TRUE,
    same_dose_for_start = 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")

  mono_trial <- result$mono@data[[1L]]
  combo_trial <- result$combo@data[[1L]]

  # First cohort is only mono at the starting dose.
  expect_true(all(mono_trial@x[1:3] == 1))

  # Second cohort in mono is again the starting dose because of parallel start.
  expect_true(all(mono_trial@x[4:6] == 1))

  # In first combo cohort we have the expected starting dose.
  expect_true(all(combo_trial@x[1:3] == 1))
})

test_that("simulate for DesignGrouped works with parallel start when first cohort mono and combo", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsDoseLevels(levels = 5),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 1
    ),
    combo = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsRelative(c(0, 100), c(2, 1)),
      cohort_size = CohortSizeConst(3),
      data = Data(doseGrid = 1:100),
      startingDose = 3
    ),
    same_dose_for_all = FALSE,
    first_cohort_mono_only = FALSE,
    same_dose_for_start = 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")

  mono_trial <- result$mono@data[[1L]]
  combo_trial <- result$combo@data[[1L]]

  # First cohort is only mono at the starting dose.
  expect_true(all(mono_trial@x[1:3] == 1))

  # In first combo cohort we have the lower, mono starting dose too, because
  # of parallel start.
  expect_true(all(combo_trial@x[1:3] == 1))
})

test_that("simulate for DesignGrouped uses DLT probabilities and cohort sizes correctly", {
  object <- DesignGrouped(
    model = LogisticLogNormalGrouped(
      mean = rep(-1, 4),
      cov = diag(5, 4),
      ref_dose = 1
    ),
    mono = Design(
      model = .LogisticNormal(),
      nextBest = NextBestNCRM(
        target = c(0.3, 0.6),
        overdose = c(0.6, 1),
        max_overdose_prob = 0.7
      ),
      stopping = StoppingMinPatients(nPatients = 9),
      increments = IncrementsDoseLevels(levels = 5),
      # Make sure that cohort size changes across doses.
      cohort_size = CohortSizeRange(
        intervals = c(0, 5, 10),
        cohort_size = c(1, 2, 3)
      ),
      data = Data(doseGrid = 1:100),
      startingDose = 1
    ),
    same_dose_for_all = TRUE,
    first_cohort_mono_only = TRUE
  )
  # Make sure that the true DLT probabilities change heavily across doses.
  my_truth <- stats::stepfun(x = c(0, 5, 10), y = c(0, 0, 0.5, 0.99))
  my_combo_truth <- my_truth

  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")

  mono_trial <- result$mono@data[[2L]]
  combo_trial <- result$combo@data[[2L]]

  # We have seen doses of 5 or larger.
  expect_true(any(mono_trial@x >= 5))
  expect_true(any(combo_trial@x >= 5))

  # And therefore we must have seen DLTs.
  expect_true(any(mono_trial@y > 0))
  expect_true(any(combo_trial@y > 0))

  # And therefore we must also have had cohort sizes larger than 1.
  expect_true(any(table(mono_trial@cohort) > 1))
  expect_true(any(table(combo_trial@cohort) > 1))
})

## DADesign ----

test_that("simulate for DADesign works consistently", {
  design <- h_get_design_da()

  myTruth <- probFunction(design@model, alpha0 = 2, alpha1 = 3)
  exp_cond_cdf <- function(x, onset = 15) {
    a <- pexp(28, 1 / onset, lower.tail = FALSE)
    1 - (pexp(x, 1 / onset, lower.tail = FALSE) - a) / (1 - a)
  }

  mySims <- simulate(
    design,
    args = NULL,
    truthTox = myTruth,
    truthSurv = exp_cond_cdf,
    trueTmax = 80,
    nsim = 2,
    seed = 819,
    mcmcOptions = h_get_mcmc_options(),
    firstSeparate = TRUE,
    deescalate = FALSE,
    parallel = FALSE
  )
  expect_snapshot(mySims)
})

test_that("simulate for DADesign with placebo and deescalation works consistently", {
  design <- h_get_design_da(placebo = TRUE)

  myTruth <- probFunction(design@model, alpha0 = 2, alpha1 = 3)
  exp_cond_cdf <- function(x, onset = 15) {
    a <- pexp(28, 1 / onset, lower.tail = FALSE)
    1 - (pexp(x, 1 / onset, lower.tail = FALSE) - a) / (1 - a)
  }

  mySims <- simulate(
    design,
    args = NULL,
    truthTox = myTruth,
    truthSurv = exp_cond_cdf,
    trueTmax = 80,
    nsim = 2,
    seed = 819,
    mcmcOptions = h_get_mcmc_options(),
    firstSeparate = FALSE,
    deescalate = TRUE,
    parallel = FALSE
  )
  expect_snapshot(mySims)
})


# examine ----

## DADesign ----

test_that("examine for DADesign works as expected", {
  t_max <- 60

  emptydata <- DataDA(
    doseGrid = c(
      0.1,
      0.5,
      1,
      1.5,
      3,
      6,
      seq(from = 10, to = 80, by = 2)
    ),
    Tmax = t_max
  )

  n_pieces <- 10
  lambda_prior <- function(k) {
    n_pieces / (t_max * (n_pieces - k + 0.5))
  }
  l_vector <- as.numeric(t(apply(
    as.matrix(c(1:n_pieces), 1, n_pieces),
    2,
    lambda_prior
  )))

  model <- DALogisticLogNormal(
    mean = c(-0.85, 1),
    cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
    ref_dose = 56,
    npiece = n_pieces,
    l = l_vector
  )

  my_increments <- IncrementsRelative(
    intervals = c(0, 20),
    increments = c(1, 0.33)
  )
  my_next_best <- NextBestNCRM(
    target = c(0.2, 0.35),
    overdose = c(0.35, 1),
    max_overdose_prob = 0.25
  )
  my_size_1 <- CohortSizeRange(
    intervals = c(0, 30),
    cohort_size = c(1, 3)
  )
  my_size_2 <- CohortSizeDLT(
    intervals = c(0, 1),
    cohort_size = c(1, 3)
  )
  my_size <- maxSize(my_size_1, my_size_2)
  my_stopping_1 <- StoppingTargetProb(
    target = c(0.2, 0.35),
    prob = 0.5
  )
  my_stopping_2 <- StoppingMinPatients(nPatients = 50)
  my_stopping <- (my_stopping_1 | my_stopping_2)
  my_safety <- SafetyWindowConst(c(6, 2), 7, 7)

  design <- DADesign(
    model = model,
    increments = my_increments,
    nextBest = my_next_best,
    stopping = my_stopping,
    cohort_size = my_size,
    data = emptydata,
    safetyWindow = my_safety,
    startingDose = 3
  )

  options <- McmcOptions(
    burnin = 10,
    step = 1,
    samples = 100,
    rng_kind = "Mersenne-Twister",
    rng_seed = 12
  )
  expect_warning(
    result <- examine(design, mcmcOptions = options, maxNoIncrement = 2L),
    "Stopping because 2 times no increment"
  )
  expect_data_frame(result)
  expect_named(
    result,
    c("DLTsearly_1", "dose", "DLTs", "nextDose", "stop", "increment")
  )
})

## Design ----

test_that("examine produces consistent results", {
  design <- h_get_design_data()
  options <- h_get_mcmc_options()

  result <- examine(design, mcmcOptions = options)

  expect_snapshot(result)
})

test_that("examine produces consistent results with placebo data", {
  design <- h_get_design_data(TRUE)
  options <- h_get_mcmc_options()

  result <- examine(design, mcmcOptions = options)

  expect_snapshot(result)
})

## RuleDesign ----

test_that("simulate-RuleDesign produces consistent results", {
  design <- ThreePlusThreeDesign(
    doseGrid = c(1, 3, 5, 10, 15, 20, 25, 40, 50, 80, 100)
  )
  options <- h_get_mcmc_options()

  result <- examine(design, mcmcOptions = options)

  expect_snapshot(result)
})

# tidy ----

## DualDesign ----
test_that("tidy-DualDesign works correctly", {
  obj <- .DefaultDualDesign()
  result <- tidy(obj)
  # style = "deparse" fails with Could not find function numeric
  expect_snapshot_value(result, style = "serialize")
})