diff --git a/tests/testthat/test-developer-gs_design_ahr.R b/tests/testthat/test-developer-gs_design_ahr.R index 2f2b1d82..ddebeb48 100644 --- a/tests/testthat/test-developer-gs_design_ahr.R +++ b/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)) +}) diff --git a/tests/testthat/test-developer-summary.R b/tests/testthat/test-developer-summary.R index b1697e91..26c168f8 100644 --- a/tests/testthat/test-developer-summary.R +++ b/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)) +})