Merge pull request #282 from jdblischak/test-summary

Add regression tests for summary.simtrial_gs_wlr()

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.4.1.10
+Version: 0.4.1.11
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
     person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role =  c("ctb","cre")),

R/summary.R

@@ -25,7 +25,7 @@
 #' @param ... Additional parameters (not used).
 #'
 #' @rdname summary
-#' @return A gt table
+#' @return A data frame
 #' @export
 #'
 #' @examples
@@ -81,7 +81,8 @@
 #'   weight = fh(rho = 0, gamma = 0.5))
 #'
 #' # Summarize simulations
-#' simulation |> summary(bound = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF)$upper$bound)
+#' bound <- gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF)$upper$bound
+#' simulation |> summary(bound = bound)
 #'
 #' # Summarize simulation and compare with the planned design
 #' simulation |> summary(design = design)
@@ -102,7 +103,7 @@ summary.simtrial_gs_wlr <- function(object,
 
     ans2 <- object |>
       dplyr::left_join(data.frame(analysis = 1:n_analysis, upper_bound = bound)) |>
-      dplyr::mutate(cross_upper = -z >= upper_bound) |>
+      dplyr::mutate(cross_upper = z >= upper_bound) |>
       dplyr::filter(cross_upper == TRUE) |>
       dplyr::group_by(sim_id) |>
       dplyr::filter(dplyr::row_number() == 1) |>
@@ -213,6 +214,7 @@ summary.simtrial_gs_wlr <- function(object,
     attr(ans, "design_type") <- design_type
   }
 
+  ans <- as.data.frame(ans)
   class(ans) <- c("simtrial_gs_wlr", class(ans))
   attr(ans, "method") <- attributes(object)$method
 

tests/testthat/test-unvalidated-summary.R

@@ -0,0 +1,183 @@
+test_that("summary.simtrial_gs_wlr() returns consistent results for one-sided design", {
+  # Test code adapted from example in ?summary.summary.simtrial_gs_wlr
+
+  # Parameters for enrollment
+  enroll_rampup_duration <- 4 # Duration for enrollment ramp up
+  enroll_duration <- 16 # Total enrollment duration
+  enroll_rate <- gsDesign2::define_enroll_rate(
+    duration = c(
+      enroll_rampup_duration, enroll_duration - enroll_rampup_duration),
+    rate = c(10, 30))
+
+  # Parameters for treatment effect
+  delay_effect_duration <- 3 # Delay treatment effect in months
+  median_ctrl <- 9 # Survival median of the control arm
+  median_exp <- c(9, 14) # Survival median of the experimental arm
+  dropout_rate <- 0.001
+  fail_rate <- gsDesign2::define_fail_rate(
+    duration = c(delay_effect_duration, 100),
+    fail_rate = log(2) / median_ctrl,
+    hr = median_ctrl / median_exp,
+    dropout_rate = dropout_rate)
+
+  # Other related parameters
+  alpha <- 0.025 # Type I error
+  beta <- 0.1 # Type II error
+  ratio <- 1 # Randomization ratio (experimental:control)
+
+  # Build a one-sided group sequential design
+  design <- gsDesign2::gs_design_ahr(
+    enroll_rate = enroll_rate, fail_rate = fail_rate,
+    ratio = ratio, alpha = alpha, beta = beta,
+    analysis_time = c(12, 24, 36),
+    upper = gsDesign2::gs_spending_bound,
+    upar = list(sf = gsDesign::sfLDOF, total_spend = alpha),
+    lower = gsDesign2::gs_b,
+    lpar = rep(-Inf, 3))
+
+  # Define cuttings of 2 IAs and 1 FA
+  ia1_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[1]))
+  ia2_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[2]))
+  fa_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[3]))
+
+  # Run simulations
+  set.seed(1)
+  simulation <- sim_gs_n(
+    n_sim = 3,
+    sample_size = ceiling(design$analysis$n[3]),
+    enroll_rate = design$enroll_rate,
+    fail_rate = design$fail_rate,
+    test = wlr,
+    cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut),
+    weight = fh(rho = 0, gamma = 0.5))
+
+  # Summarize simulations
+  observed <- simulation |>
+    summary(bound = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF)$upper$bound)
+  expected <- data.frame(
+    analysis = c(1, 2, 3),
+    sim_n = c(369.3333333333333, 505, 505),
+    sim_event = c(97, 305, 405),
+    sim_time = c(12.877359569828519, 24.990283397668506, 37.20491262038222),
+    sim_upper_prob = c(NA, 1, NA)
+  ) |>
+    structure(
+      class = c("simtrial_gs_wlr", "data.frame"),
+      compare_with_design = "no",
+      method = "FH(rho=0, gamma=0.5)"
+    )
+  expect_equal(observed, expected)
+
+  # Summarize simulation and compare with the planned design
+  observed <- simulation |> summary(design = design)
+  expected <- data.frame(
+    analysis = c(1, 2, 3),
+    asy_upper_prob = c(0.00014865936645545522, 0.5723215057363614, 0.9000000002116888),
+    sim_upper_prob = rep(NA_real_, 3L),
+    sim_event = c(97, 305, 405),
+    sim_n = c(369.3333333333333, 505, 505),
+    sim_time = c(12.877359569828519, 24.990283397668506, 37.20491262038222),
+    asy_time = c(12, 24, 36),
+    asy_n = c(353.04671034431556, 504.3524433490222, 504.3524433490222),
+    asy_event = c(96.77457617908364, 304.00996193840484, 404.14196474655887)
+  ) |>
+    structure(
+      class = c("simtrial_gs_wlr", "data.frame"),
+      compare_with_design = "yes",
+      design_type = "one-sided",
+      method = "FH(rho=0, gamma=0.5)"
+    )
+  expect_equal(observed, expected)
+})
+
+test_that("summary.simtrial_gs_wlr() returns consistent results for two-sided design", {
+  # Parameters for enrollment
+  enroll_rampup_duration <- 4 # Duration for enrollment ramp up
+  enroll_duration <- 16 # Total enrollment duration
+  enroll_rate <- gsDesign2::define_enroll_rate(
+    duration = c(
+      enroll_rampup_duration, enroll_duration - enroll_rampup_duration),
+    rate = c(10, 30))
+
+  # Parameters for treatment effect
+  delay_effect_duration <- 3 # Delay treatment effect in months
+  median_ctrl <- 9 # Survival median of the control arm
+  median_exp <- c(9, 14) # Survival median of the experimental arm
+  dropout_rate <- 0.001
+  fail_rate <- gsDesign2::define_fail_rate(
+    duration = c(delay_effect_duration, 100),
+    fail_rate = log(2) / median_ctrl,
+    hr = median_ctrl / median_exp,
+    dropout_rate = dropout_rate)
+
+  # Other related parameters
+  alpha <- 0.025 # Type I error
+  beta <- 0.1 # Type II error
+  ratio <- 1 # Randomization ratio (experimental:control)
+
+  # Build a two-sided group sequential design
+  design <- gsDesign2::gs_design_ahr(
+    enroll_rate = enroll_rate, fail_rate = fail_rate,
+    ratio = ratio, alpha = alpha, beta = beta,
+    analysis_time = c(12, 24, 36),
+    upper = gsDesign2::gs_spending_bound,
+    upar = list(sf = gsDesign::sfLDOF, total_spend = alpha),
+    lower = gsDesign2::gs_spending_bound,
+    lpar = list(sf = gsDesign::sfLDOF, total_spend = beta))
+
+  # Define cuttings of 2 IAs and 1 FA
+  ia1_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[1]))
+  ia2_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[2]))
+  fa_cut <- create_cut(target_event_overall = ceiling(design$analysis$event[3]))
+
+  # Run simulations
+  set.seed(1)
+  simulation <- sim_gs_n(
+    n_sim = 3,
+    sample_size = ceiling(design$analysis$n[3]),
+    enroll_rate = design$enroll_rate,
+    fail_rate = design$fail_rate,
+    test = wlr,
+    cut = list(ia1 = ia1_cut, ia2 = ia2_cut, fa = fa_cut),
+    weight = fh(rho = 0, gamma = 0.5))
+
+  # Summarize simulations
+  observed <- simulation |>
+    summary(bound = gsDesign::gsDesign(k = 3, test.type = 1, sfu = gsDesign::sfLDOF)$upper$bound)
+  expected <- data.frame(
+    analysis = c(1, 2, 3),
+    sim_n = c(366.6666666666667, 535, 535),
+    sim_event = c(103, 323, 429),
+    sim_time = c(12.363838412468121, 24.374413483785986, 36.116791896100885),
+    sim_upper_prob = c(NA, 0.6666666666666666, 1)
+  ) |>
+    structure(
+      compare_with_design = "no",
+      class = c("simtrial_gs_wlr", "data.frame"),
+      method = "FH(rho=0, gamma=0.5)"
+    )
+  expect_equal(observed, expected)
+
+  # Summarize simulation and compare with the planned design
+  observed <- simulation |> summary(design = design)
+  expected <- data.frame(
+    analysis = c(1, 2, 3),
+    asy_upper_prob = c(0.00016250401737420353, 0.6011019363189855, 0.9000000001924918),
+    asy_lower_prob = c(0.0007883883873094952, 0.05707064419933058, 0.10004018006137042),
+    sim_upper_prob = rep(NA_real_, 3L),
+    sim_lower_prob = c(NA, 1, NA),
+    sim_event = c(103, 323, 429),
+    sim_n = c(366.6666666666667, 535, 535),
+    sim_time = c(12.363838412468121, 24.374413483785986, 36.116791896100885),
+    asy_time = c(12, 24, 36),
+    asy_n = c(374.08958620608826, 534.4136945801262, 534.4136945801262),
+    asy_event = c(102.54269505243633, 322.13006815203613, 428.2303047466704)
+  ) |>
+    structure(
+      compare_with_design = "yes",
+      design_type = "two-sided",
+      class = c("simtrial_gs_wlr", "data.frame"),
+      method = "FH(rho=0, gamma=0.5)"
+    )
+  expect_equal(observed, expected)
+})