Merge pull request #579 from Merck/578-the-sample-size-from-pw_info-is-not-correct-when-control-median-change-but-hr-unchanged

Sample size from `pw_info` is not correct when control median change but HR remain unchanged

Author: LittleBeannie

R/pw_info.R

@@ -179,12 +179,15 @@ pw_info <- function(
     event = sum(event),
     info0 = sum(info0),
     info = sum(info)
-  ), by = .(time, stratum, hr)]
+  ), by = .(time, stratum, t, hr)]
 
   # -------------------------------------- #
   #    output the results                  #
   # -------------------------------------- #
-  ans <- merge(tbl_event, tbl_n, by = c("time", "t", "stratum"))
+  # merge 2 tables tbl_n and tbl_event, where they share the same time, t, stratum
+  ans <- tbl_event[tbl_n, on = c("time", "stratum", "t")]
+  ans[, t.1 := NULL]
+
   # filter out the rows with 0 events and unneeded columns
   ans <- ans[!almost_equal(event, 0L), .(time, stratum, t, hr, n, event, info, info0)]
 

tests/testthat/test-developer-pw_info.R

@@ -111,4 +111,17 @@ test_that("When there are many pieces of HRs", {
     fail_rate = fail_rate,
     ratio = 2)
   )
-})
+})
+
+test_that("When control median changes but HR remain unchanged", {
+  x <- pw_info(
+    enroll_rate = define_enroll_rate(duration = 12, rate = 20),
+    fail_rate = define_fail_rate(duration = c(9, Inf),
+                                 fail_rate = log(2) / c(10, 20),
+                                 hr = c(0.72, 0.72),
+                                 dropout_rate = 0.001),
+    total_duration = 50,
+    ratio = 1)
+
+  expect_equal(sum(x$n),  20 * 12)
+})

tests/testthat/test-independent-ahr.R

@@ -71,3 +71,16 @@ test_that("AHR results are consistent with simulation results for single stratum
   expect_true(all.equal(simulation_ahr3$AHR, actual$ahr, tolerance = 5e-3))
   expect_true(all.equal(simulation_ahr3$Events, actual$event, tolerance = 7e-3))
 })
+
+test_that("The sample size returned from the ahr() function is correct", {
+  x <- ahr(
+    enroll_rate = define_enroll_rate(duration = 24, rate = 10),
+    fail_rate = define_fail_rate(duration = c(4, 2, 38),
+                                 fail_rate = rep(log(2)/14, 3),
+                                 hr = c(0.7, 0.7, 0.7),
+                                 dropout_rate = - log(1 - 0.15)/12),
+    total_duration = c(seq(1, 48, 1)))
+
+  expect_equal(x |> dplyr::filter(time <= 24) |> dplyr::pull(n), 1:24*10)
+  expect_equal(x |> dplyr::filter(time > 24) |> dplyr::pull(n) |> unique(), 24*10)
+})

tests/testthat/test-independent-gs_power_ahr.R

@@ -19,28 +19,14 @@ x <- gsDesign::gsSurv(
   T = NULL,
   minfup = NULL,
   ratio = 1
-)
+) |> gsDesign::toInteger()
 
-# Update x with gsDesign() to get integer event counts
-x <- gsDesign::gsDesign(
-  k = x$k,
-  test.type = 1,
-  alpha = x$alpha,
-  beta = x$beta,
-  sfu = x$upper$sf,
-  sfupar = x$upper$param,
-  n.I = ceiling(x$n.I),
-  maxn.IPlan = ceiling(x$n.I[x$k]),
-  delta = x$delta,
-  delta1 = x$delta1,
-  delta0 = x$delta0
-)
 y <- gsDesign::gsBoundSummary(
   x,
   ratio = 1,
   digits = 4,
   ddigits = 2,
-  tdigits = 1,
+  tdigits = 4,
   timename = "Month",
   logdelta = TRUE
 )
@@ -54,16 +40,16 @@ test_that("under same number of events, compare the power", {
 
   out <- gs_power_ahr(
     enroll_rate = define_enroll_rate(
-      duration = c(2, 2, 2, 6),
-      rate = c(6, 12, 18, 24)
+      duration = x$R,
+      rate = x$gamma |> as.vector()
     ),
     fail_rate = define_fail_rate(
-      duration = 1,
-      fail_rate = log(2) / 9,
-      hr = 0.65,
-      dropout_rate = 0.001
+      duration = Inf,
+      fail_rate = x$lambdaC |> as.vector(),
+      dropout_rate = x$etaE |> as.vector(),
+      hr = x$hr
     ),
-    ratio = 1,
+    ratio = x$ratio,
     # Set number of events the same as the design x above from gsDesign()
     event = x$n.I,
     analysis_time = NULL,
@@ -84,20 +70,20 @@ test_that("under same power setting, compare the number of events", {
 
   out <- gs_power_ahr(
     enroll_rate = define_enroll_rate(
-      duration = c(2, 2, 2, 6),
-      rate = c(6, 12, 18, 24)
+      duration = x$R,
+      rate = x$gamma |> as.vector()
     ),
     fail_rate = define_fail_rate(
-      duration = 1,
-      fail_rate = log(2) / 9,
-      dropout_rate = 0.001,
-      hr = 0.65
+      duration = Inf,
+      fail_rate = x$lambdaC |> as.vector(),
+      dropout_rate = x$etaE |> as.vector(),
+      hr = x$hr
     ),
-    ratio = 1,
+    ratio = x$ratio,
     event = NULL,
     # Adjust the times s.t. power ~= 0.801 and information fraction ~= 0.7
     # (same as the design x above from gsDesign())
-    analysis_time = c(21, 34.9),
+    analysis_time = sub("^Month: ", "", y$Analysis[startsWith(y$Analysis, "Month: ")]) |> as.numeric(),
     binding = FALSE,
     upper = gs_spending_bound,
     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025, param = NULL, timing = NULL, theta = 0),
@@ -108,5 +94,5 @@ test_that("under same power setting, compare the number of events", {
   )
 
   # In case test fails, check whether caused by small tolerance
-  expect_equal(out$analysis$event[1:2], x$n.I, tolerance = 0.02)
+  expect_equal(out$analysis$event[1:2], x$n.I, tolerance = 0.002)
 })