Allow passing one test per cutting to sim_gs_n()

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.3.2.9
+Version: 0.3.2.10
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yilong", "Zhang", email = "[email protected]", role =  c("aut")),

R/sim_gs_n.R

@@ -22,9 +22,13 @@
 #' arguments will change as we add additional features.
 #'
 #' @inheritParams sim_fixed_n
-#' @param test A test function such as [wlr()],
-#'   [maxcombo()], or [rmst()]. The simulated data set is
-#'   passed as the first positional argument to the test function provided.
+#' @param test A test function such as [wlr()], [maxcombo()], or [rmst()]. The
+#'   simulated data set is passed as the first positional argument to the test
+#'   function provided. Alternatively a list of functions created by
+#'   [create_cutting_test()]. The list form is experimental and currently
+#'   limited. It only accepts one test per cutting (in the future multiple tests
+#'   may be accepted), and all the tests must consistently return the same exact
+#'   results (again this may be more flexible in the future).
 #' @param cutting A list of cutting functions created by [create_cutting()],
 #'   see examples.
 #' @param seed Random seed.
@@ -268,6 +272,17 @@ sim_gs_n <- function(
     cut_date <- rep(-100, n_analysis)
     ans_1sim <- NULL
 
+    # Organize tests for each cutting
+    if (is.function(test)) {
+      test_single <- test
+      test <- vector(mode = "list", length = n_analysis)
+      test[] <- list(test_single)
+    }
+    if (length(test) != length(cutting)) {
+      stop("If you want to run different tests at each cutting, the list of
+           tests must be the same length as the list of cuttings")
+    }
+
     for (i_analysis in seq_len(n_analysis)) {
       # Get cut date
       cut_date[i_analysis] <- cutting[[i_analysis]](data = simu_data)
@@ -276,7 +291,7 @@ sim_gs_n <- function(
       simu_data_cut <- simu_data |> cut_data_by_date(cut_date[i_analysis])
 
       # Test
-      ans_1sim_new <- test(simu_data_cut, ...)
+      ans_1sim_new <- test[[i_analysis]](simu_data_cut, ...)
       ans_1sim_new$analysis <- i_analysis
       ans_1sim_new$cut_date <- cut_date[i_analysis]
       ans_1sim_new$sim_id <- sim_id

tests/testthat/test-unvalidated-sim_gs_n.R

@@ -231,3 +231,52 @@ test_that("Test 7: MaxCombo (WLR-FH(0,0) + WLR-FH(0, 0.5))", {
   )
   expect_equal(observed, expected)
 })
+
+test_that("sim_gs_n() accepts different tests per cutting", {
+  wlr_cut1 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0))
+  wlr_cut2 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0.5))
+  wlr_cut3 <- create_cutting_test(wlr, weight = fh(rho = 0.5, gamma = 0))
+
+  observed <- sim_gs_n(
+    n_sim = 3,
+    sample_size = 400,
+    enroll_rate = test_enroll_rate(),
+    fail_rate = test_fail_rate(),
+    test = list(wlr_cut1, wlr_cut2, wlr_cut3),
+    cutting = test_cutting(),
+    seed = 2024
+  )
+  expected <- data.frame(
+    rho = rep(c(0, 0, 0.5), 3),
+    gamma = rep(c(0, 0.5, 0), 3),
+    z = c(
+      -3.7486049782713247, -4.778107819550277, -4.189693884801371,
+      -3.4771440155825752, -3.945081123231263, -3.438138809871842,
+      -3.075862925191481, -3.640458610667732, -3.9489173860678495
+    ),
+    analysis = rep(1:3, 3),
+    cut_date = c(24, 32, 45, 24, 32, 46.219327415802894, 24, 32, 50.86585486314699),
+    sim_id = rep(1:3, each = 3L),
+    n = rep(400L, 9L),
+    event = c(229, 295, 355, 241, 290, 350, 226, 282, 350)
+  )
+  expect_equal(observed, expected)
+})
+
+test_that("sim_gs_n() requires a test for each cutting", {
+  wlr_cut1 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0))
+  wlr_cut2 <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0.5))
+
+  expect_error(
+    sim_gs_n(
+      n_sim = 3,
+      sample_size = 400,
+      enroll_rate = test_enroll_rate(),
+      fail_rate = test_fail_rate(),
+      test = list(wlr_cut1, wlr_cut2),
+      cutting = test_cutting(),
+      seed = 2024
+    ),
+    "If you want to run different tests at each cutting"
+  )
+})