Add developer tests when outputting spending time in gs_design_ahr and summary

tests/testthat/test-developer-gs_design_ahr.R

@@ -141,3 +141,99 @@ test_that("Pocock lower spending under H1 (NPH)", {
   expect_equal(x1$bound$z[x1$bound$bound == "lower"], x2$bounds$Z[x2$bounds$Bound == "Lower"])
   expect_equal(x1$bound$probability[x1$bound$bound == "lower"], x2$bounds$Probability[x2$bounds$Bound == "Lower"])
 })
+
+test_that("Spending time when both efficacy and futility bound are fixed", {
+
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = 1:3/3, analysis_time = 36,
+                     upper = gs_b,
+                     upar = gsDesign::gsDesign(k = 3, test.type = 1, n.I = 1:3/3,
+                                               sfu = gsDesign::sfLDOF, sfupar = NULL, alpha = 0.025)$upper$bound,
+                     lower = gs_b,
+                     lpar = rep(-Inf, 3))
+
+  expect_false("spending_time" %in% names(x$bound))
+})
+
+test_that("Pre-specificed spending time", {
+
+  # one-sided design
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = NULL, analysis_time = c(12, 24, 36),
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, timing = c(12, 24, 36) / 36, total_spend = 0.025),
+                     lower = gs_b,
+                     lpar = rep(-Inf, 3))
+
+  expect_equal(x$bound$spending_time, c(12, 24, 36) / 36)
+
+  # two-sided design
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = NULL, analysis_time = c(12, 24, 36),
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, timing = c(12, 24, 36) / 36, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfLDOF, timing = c(15, 24, 36) / 36, total_spend = 0.1))
+
+  expect_equal((x$bound |> filter(bound == "upper"))$spending_time, c(12, 24, 36) / 36)
+  expect_equal((x$bound |> filter(bound == "lower"))$spending_time, c(15, 24, 36) / 36)
+})
+
+test_that("Spending time when the analyses are driven by information fraction", {
+  # one-sided design
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = 1:3/3, analysis_time = 36,
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_b,
+                     lpar = rep(-Inf, 3))
+
+  expect_equal(x$bound$spending_time, 1:3/3)
+
+  # two-sided design with futility bound spending under H1
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = 1:3/3, analysis_time = 36,
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 3),
+                     h1_spending = TRUE)
+
+  expect_equal((x$bound |> filter(bound == "upper"))$spending_time, 1:3/3)
+  expect_equal((x$bound |> filter(bound == "lower"))$spending_time, x$analysis$info / max(x$analysis$info))
+
+  # two-sided design with futility bound spending under H0
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = 1:3/3, analysis_time = 36,
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 3),
+                     h1_spending = FALSE)
+
+  expect_equal((x$bound |> filter(bound == "upper"))$spending_time, 1:3/3)
+  expect_equal((x$bound |> filter(bound == "lower"))$spending_time, x$analysis$info0 / max(x$analysis$info0))
+})
+
+test_that("Spending time when some analyses are skipped", {
+
+  # two-sided design with futility bound spending under H1
+  x <- gs_design_ahr(alpha = 0.025,
+                     beta = 0.1,
+                     info_frac = 1:3/3, analysis_time = 36,
+                     upper = gs_spending_bound,
+                     upar = list(sf = gsDesign::sfLDOF, total_spend = 0.025),
+                     lower = gs_spending_bound,
+                     lpar = list(sf = gsDesign::sfHSD, total_spend = 0.1, param = 3),
+                     h1_spending = TRUE,
+                     test_lower = c(FALSE, TRUE, TRUE))
+
+  expect_equal((x$bound |> filter(bound == "upper"))$spending_time, 1:3/3)
+  expect_equal((x$bound |> filter(bound == "lower"))$spending_time, x$analysis$info[2:3] / max(x$analysis$info))
+})

tests/testthat/test-developer-summary.R

@@ -287,3 +287,12 @@ test_that("summary.gs_design() accepts a named vector for col_decimals", {
     "'col_decimals' must be a named vector if 'col_vars' is not provided"
   )
 })
+
+# Output of spending time
+test_that("summary.gs_design() outputs spending time correctly", {
+  x <- gs_design_ahr(info_frac = 1:3/3) |> summary(display_spending_time = TRUE)
+  expect_true("Spending time" %in% names(x))
+
+  x <- gs_design_ahr(info_frac = 1:3/3) |> summary(display_spending_time = FALSE)
+  expect_false("Spending time" %in% names(x))
+})