tests/testthat/test-enroll-fastpath.R

In TrialSimulator: Clinical Trial Simulator

# enroll_patients() without stratification takes a fast path that skips
# the per-stratum bookkeeping of the general path. It must consume the
# random number stream exactly as the general path did, so a fixed seed
# must reproduce the patient data generated by TrialSimulator 1.35.3 (the
# last version on which every trial went through the general path). The
# reference values below were computed on 1.35.3.

test_that("non-stratified enrollment reproduces the 1.35.3 patient data", {

  rng <- function(n, prev) {
    data.frame(biomarker = rbinom(n, 1, prev), pfs = rexp(n, .1), pfs_event = 1,
               resp = rbinom(n, 1, .3))
  }
  mk <- function(name, prev) {
    a <- arm(name = name)
    a$add_endpoints(endpoint(name = c("biomarker", "pfs", "resp"),
                             type = c("baseline", "tte", "non-tte"),
                             readout = c(resp = 2), generator = rng, prev = prev))
    a
  }
  pbo <- mk("pbo", .4); trt <- mk("trt", .6); ctl <- mk("ctl", .5)
  tr <- trial(name = "g", n_patients = 150, duration = 30, seed = 20260903,
              enroller = StaggeredRecruiter,
              accrual_rate = data.frame(end_time = Inf, piecewise_rate = 20),
              dropout = rweibull, shape = 1.5, scale = 60, silent = TRUE)
  tr$add_arms(sample_ratio = c(2, 1, 1), pbo, trt, ctl)

  ## the mid-trial sample-ratio update rolls back and re-enrolls the
  ## unenrolled patients, exercising the fast path a second time
  l <- listener(silent = TRUE)
  l$add_milestones(
    milestone(name = "m", when = calendarTime(time = 4),
              action = function(trial) trial$update_sample_ratio("pbo", 1)),
    milestone(name = "final", when = calendarTime(time = 30)))
  controller(tr, l)$run(n = 1, silent = TRUE, plot_event = FALSE)
  d <- tr$get_locked_data("final")

  expect_equal(sum(d$pfs),          1334.4097898539, tolerance = 1e-10)
  expect_equal(sum(d$dropout_time), 7320.7574344397, tolerance = 1e-10)
  expect_identical(sum(d$biomarker), 74L)
  expect_identical(sum(d$resp, na.rm = TRUE), 41L)
  expect_identical(as.integer(table(d$arm)), c(43L, 64L, 43L))
  expect_identical(head(d$patient_id, 12), as.numeric(1:12))
})