tests/testthat/test-generate_progression.R

In SimNPH: Simulate Non-Proportional Hazards

test_that("assumptions_progression outputs correct tibble", {
  capture_output(
    expect_invisible(
      assumptions_progression(),
      label = "assumptions_progression returns invisibly"
    )
  )

  expect_output(
    assumptions_progression(print=TRUE),
    regexp = "^expand\\.grid.*",
    label = "assumptions_progression prints something with expand.grid"
  )

  capture_output(
    test_design <- assumptions_progression()
  )

  expect_true(
    all(hasName(
      test_design,
      c("hazard_ctrl", "hazard_trt", "hazard_after_prog", "prog_rate_ctrl", "prog_rate_trt", "random_withdrawal")
    )),
    label = "output of assumptions_delayed_effect has the right columns"
  )

  expect_true(
    test_design[, c("hazard_ctrl", "hazard_trt", "hazard_after_prog", "prog_rate_ctrl", "prog_rate_trt", "random_withdrawal")] |>
      sapply(is.numeric) |>
      all(),
    label = "columns of output of assumptions_delayed_effect have the right datatype"
  )

})


test_that("test that generate_progression outputs correct tibble", {
  capture_output(
    scenario <- merge(assumptions_progression(), design_fixed_followup(), by=NULL)[2, ]
  )
  one_simulation <- generate_progression(scenario)

  expect_equal(
    nrow(one_simulation),
    scenario$n_trt + scenario$n_ctrl,
    label = "nrow equals treatment + control"
  )

  expect_true(
    all(hasName(
      one_simulation,
      c("t", "trt", "evt", "t_ice", "ice")
    )),
    label = "simulated dataset has the right columns"
  )

  expect_equal(
    sapply(one_simulation[, c("t", "trt", "evt", "t_ice", "ice")], class),
    c(t="numeric", trt="integer", evt="logical", t_ice="numeric", ice="logical"),
    label = "columns of simulated dataset have the right datatypes"
  )

})


test_that("true summary statistics progression works", {
  capture_output(
    design <- merge(assumptions_progression(), design_fixed_followup(), by=NULL)
  )

  design_2 <- design
  design_2$followup <- NULL

  summaries_os     <- true_summary_statistics_progression(design, what="os", cutoff=m2d(24), milestones=m2d(c(6, 12)))
  summaries_pfs    <- true_summary_statistics_progression(design, what="pfs", cutoff=m2d(24), milestones=m2d(c(6, 12)))
  summaries_os_2   <- true_summary_statistics_progression(design, what="os", fixed_objects = list(t_max=10000))
  summaries_pfs_2  <- true_summary_statistics_progression(design, what="pfs", fixed_objects = list(t_max=10000))
  summaries_os_3   <- true_summary_statistics_progression(design_2, what="os", cutoff=c("a"=m2d(24)), milestones=m2d(c("first"=6, "second"=12)))
  summaries_pfs_3  <- true_summary_statistics_progression(design_2, what="pfs", cutoff=c("a"=m2d(24)), milestones=m2d(c("first"=6, "second"=12)))

  expect_error(true_summary_statistics_progression(design, what="something else"))

  expect_named(
    summaries_pfs,
    c(
      names(design),
      "median_survival_trt", "median_survival_ctrl", "rmst_trt_730.5",
      "rmst_ctrl_730.5", "gAHR_730.5", "AHR_730.5", "AHRoc_730.5", "AHRoc_robust_730.5",
      "milestone_survival_trt_182.625", "milestone_survival_ctrl_182.625",
      "milestone_survival_trt_365.25", "milestone_survival_ctrl_365.25"
    )
  )

  expect_named(
    summaries_os,
    c(
      names(design),
      "median_survival_trt", "median_survival_ctrl", "rmst_trt_730.5",
      "rmst_ctrl_730.5", "gAHR_730.5", "AHR_730.5", "AHRoc_730.5", "AHRoc_robust_730.5",
      "milestone_survival_trt_182.625", "milestone_survival_ctrl_182.625",
      "milestone_survival_trt_365.25", "milestone_survival_ctrl_365.25"
    )
  )

  expect_named(summaries_pfs_2, c(names(design), "median_survival_trt", "median_survival_ctrl"))
  expect_named(summaries_os_2 , c(names(design), "median_survival_trt", "median_survival_ctrl"))

  expect_named(
    summaries_pfs_3,
    c(
      names(design_2),
      "median_survival_trt", "median_survival_ctrl", "rmst_trt_a",
      "rmst_ctrl_a", "gAHR_a", "AHR_a", "AHRoc_a", "AHRoc_robust_a",
      "milestone_survival_trt_first", "milestone_survival_ctrl_first",
      "milestone_survival_trt_second", "milestone_survival_ctrl_second"
      )
  )

  expect_named(
    summaries_os_3,
    c(
      names(design_2),
      "median_survival_trt", "median_survival_ctrl", "rmst_trt_a",
      "rmst_ctrl_a", "gAHR_a", "AHR_a", "AHRoc_a", "AHRoc_robust_a",
      "milestone_survival_trt_first", "milestone_survival_ctrl_first",
      "milestone_survival_trt_second", "milestone_survival_ctrl_second"
    )
  )
})

test_that("censoring rate from censoring proportion for disease progression works", {
  design <- expand.grid(
    hazard_ctrl         = 0.001518187, # hazard under control (med. survi. 15m)
    hazard_trt          = 0.001265156, # hazard under treatment (med. surv. 18m)
    hazard_after_prog   = 0.007590934, # hazard after progression (med. surv. 3m)
    prog_rate_ctrl      = 0.001897734, # hazard rate for disease progression under control (med. time to progression 12m)
    prog_rate_trt       = c(0.001897734, 0.001423300, 0.001265156), # hazard rate for disease progression unter treatment (med. time to progression 12m, 16m, 18m)
    censoring_prop      = 0.1,         # rate of random withdrawal
    followup            = 100,         # follow up time
    n_trt               = 50,          # patients in treatment arm
    n_ctrl              = 50           # patients in control arm
  )

  design_2 <- design
  design_2$censoring_prop <- 0

  res  <- cen_rate_from_cen_prop_progression(design)
  res2 <- cen_rate_from_cen_prop_progression(design_2)

  expect(all(!is.na(res$random_withdrawal)), "some values for random_withdrawal are missing")
  expect_equal(res2$random_withdrawal, c(0,0,0))
})

test_that("progression rate from progression prop works", {
  capture_output(
    my_design <- merge(
      assumptions_progression(),
      design_fixed_followup(),
      by=NULL
    )
  )
  my_design$prog_rate_ctrl <- NULL
  my_design$prog_rate_trt <- NULL
  my_design$prog_prop_trt <- 0.2
  my_design$prog_prop_ctrl <- 0.3

  res  <- progression_rate_from_progression_prop(my_design)

  expect_named(res, c(names(my_design), c("prog_rate_trt", "prog_rate_ctrl")))
  expect_equal(order(res$prog_rate_trt), order(res$prog_prop_trt))
  expect_equal(order(res$prog_rate_ctrl), order(res$prog_prop_ctrl))
})

test_that("hazard_before_progression_from_PH_effect_size works", {

  capture_output(
    my_design <- merge(
      assumptions_progression(),
      design_group_sequential(),
      by=NULL
    )
  )

  design_2 <- my_design
  design_2$effect_size_ph <- 0.9
  design_2$final_event <- NULL

  design_3 <- my_design
  design_3$final_events <- NULL

  design_4 <- my_design[1, ]
  design_4$hazard_trt <- 6e-5
  design_4$prog_rate_trt <- 0

  # to hide progressbar in test output
  withr::with_options(
    list(
      cli.default_handler = function(...) { },
      usethis.quiet = TRUE
    ),
    {
      res_1 <- hazard_before_progression_from_PH_effect_size(my_design[1, ], target_power_ph=0)
      res_2 <- hazard_before_progression_from_PH_effect_size(design_2, final_events=300)
      res_3 <- hazard_before_progression_from_PH_effect_size(design_4, final_events=300, target_power_ph=0.9)
    }
  )

  expect_equal(res_1$hazard_ctrl, res_1$hazard_trt)

  expect_error(hazard_before_progression_from_PH_effect_size(design_3))
  expect_error(hazard_before_progression_from_PH_effect_size(my_design))
})