tests/testthat/test-developer-pw_info.R

In gsDesign2: Group Sequential Design with Non-Constant Effect

test_that("Output column of n matches with expected_accrual with Inf in the fail_rate", {

  enroll_rate <- define_enroll_rate(duration = 24, rate = 1)
  fail_rate <- define_fail_rate(duration = c(3, Inf), hr = c(1, 0.6),
                                fail_rate = log(2)/10, dropout_rate = 0.001)

  # A single time point before the delayed effect at 3 months
  my_time  <-  2
  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)
  x2 <- expected_accrual(enroll_rate = enroll_rate,
                         time = my_time)
  expect_equal(cumsum(x1$n), x2)

  # A single time point after the delayed effect at 3 months
  my_time  <-  10
  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)
  x2 <- expected_accrual(enroll_rate = enroll_rate,
                         time = c(fail_rate$duration[1], my_time))
  expect_equal(cumsum(x1$n), x2)

  # Two time points, one before and one after the delayed effect at 3 months
  my_time  <- c(2, 10)

  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)

  expect_equal(sum(x1$n[x1$time == 2]), expected_accrual(enroll_rate = enroll_rate, time = 2))
  expect_equal(sum(x1$n[x1$time == 10]), expected_accrual(enroll_rate = enroll_rate, time = 10))
})

test_that("Output column of n matches with expected_accrual without Inf in the fail_rate", {

  enroll_rate <- define_enroll_rate(duration = 24, rate = 1)
  fail_rate <- define_fail_rate(duration = c(3, 100), hr = c(1, 0.6),
                                fail_rate = log(2)/10, dropout_rate = 0.001)

  # A single time point before the delayed effect at 3 months
  my_time  <-  2
  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)
  x2 <- expected_accrual(enroll_rate = enroll_rate,
                         time = my_time)
  expect_equal(cumsum(x1$n), x2)

  # A single time point after the delayed effect at 3 months
  my_time  <-  10
  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)
  x2 <- expected_accrual(enroll_rate = enroll_rate,
                         time = c(fail_rate$duration[1], my_time))
  expect_equal(cumsum(x1$n), x2)

  # Two time points, one before and one after the delayed effect at 3 months
  my_time  <- c(2, 10)

  x1 <- pw_info(enroll_rate = enroll_rate,
                fail_rate = fail_rate,
                total_duration = my_time)

  expect_equal(sum(x1$n[x1$time == 2]), expected_accrual(enroll_rate = enroll_rate, time = 2))
  expect_equal(sum(x1$n[x1$time == 10]), expected_accrual(enroll_rate = enroll_rate, time = 10))

})

test_that("Column order is consistent", {
  observed <- colnames(pw_info())
  expected <- c("time", "stratum", "t", "hr", "n", "event", "info", "info0")
  expect_equal(observed, expected)
})

test_that("When there are many pieces of HRs", {
  # Expected enrollment duration is 223 months with constant enrollment rate
  enroll_rate <- tibble(stratum = "All", duration = 24, rate = 1)
  # Control group long-term RFS
  cure_rate_control <- .5
  # Control group RFS at 18 months
  rfs_18_control <- .7

  # Poisson mixture model from
  # https://merck.github.io/gsDesign2/articles/story-arbitrary-distribution.html?q=cure#poisson-mixture-model
  p_pm <- function(x, theta, lambda, lower_tail = FALSE) {
    exp(-theta * (1 - exp(-lambda * x)))
  }
  # Cure rate determines theta
  theta <- -log(cure_rate_control)
  # lambda parameter driven by both cure rate and interim time rfs_18_control
  lambda <- -log((theta + log(rfs_18_control)) / theta) / 18

  # Time points of interest in design rate
  weeks <- c(0, 6, 30)
  months <- c(weeks / (52 + 1.25/7), 1:7) * 12
  # Get control failure rates
  fail_rate_control = s2pwe(times = months[-1], survival = p_pm(months[-1], theta, lambda))
  fail_rate <- tibble(stratum = "All",
                      duration = fail_rate_control$duration,
                      fail_rate = fail_rate_control$rate,
                      hr = c(1, 0.7, rep(.5, 7)),
                      # 0.6% dropout rate per month
                      dropout_rate = -log(.994))

  expect_no_error(
    pw_info(
    enroll_rate = tibble(stratum = "All", duration = 22, rate = 1),
    fail_rate = fail_rate,
    ratio = 2)
  )
})