diff --git a/R/utils-process.R b/R/utils-process.R index 8dd83f2..303c286 100644 --- a/R/utils-process.R +++ b/R/utils-process.R @@ -107,7 +107,8 @@ get_boundaries <- function( total_spend = possible_weight*alpha), test_lower = FALSE, ratio = dplyr::filter(enroll_rate, .data$treatments == test)$ratio[1]/ - dplyr::filter(enroll_rate, .data$treatments == control)$ratio[1] + dplyr::filter(enroll_rate, .data$treatments == control)$ratio[1], + info_scale = "h0_info" ) } } diff --git a/tests/testthat/fixtures/local_power_validation_config.R b/tests/testthat/fixtures/local_power_validation_config.R new file mode 100644 index 0000000..96bfd85 --- /dev/null +++ b/tests/testthat/fixtures/local_power_validation_config.R @@ -0,0 +1,65 @@ +# local_power_validation_config.R +# +# Minimal single-stratum config for rpact cross-validation of local power. +# +# Design choices: +# - Single stratum "All" — rpact comparison is unconditionally valid +# (no strata weighting needed; rpact handles single-population designs) +# - 1:4 allocation (Trt:Ctrl) — exercises unequal allocation in get_boundaries() +# - HR = 0.55 — strong effect, clearly non-null power values +# - Piecewise exponential control (2 segments: h=0.025 for t<6, h=0.010 for t>=6) +# - H1: binary (MRD) — single analysis, second node for graph (required; appendMCP +# does not support single-hypothesis graphs) +# - H2: OS TTE — asOF spending, 3 analyses +# - Graph: serial H1 -> H2, w = (0.1, 0.9) +# - N=1000 (rate=50/mo x 20mo), 1:4 → 200 Trt + 800 Ctrl +# - Events at ~33%/60%/83% of 240 max: 80/144/200 +# - sims = 10L — minimal, just enough for process_config() to complete +# +# NOT a real study design. Exists solely as a validation fixture for testthat. +# The rpact cross-validation targets H2 (OS TTE) only. + +config <- list( + study_name = "local_power_validation", + alpha = 0.025, + sims = 10L, + + analyses = tibble::tribble( + ~endpoint, ~strata, ~treatments, ~sample_size, ~events, ~power_subsets_any, ~power_subsets_all, + "MRD", "All", c("Trt", "Ctrl"), 1000, NA, list("H1" = 1L), list("H1" = 1L), + "OS", "All", c("Trt", "Ctrl"), NA, 80, list("H2" = 2L), list("H2" = 2L), + "OS", "All", c("Trt", "Ctrl"), NA, 144, list("H2" = 2L), list("H2" = 2L), + "OS", "All", c("Trt", "Ctrl"), NA, 200, list("H2" = 2L), list("H2" = 2L) + ), + + hypotheses = tibble::tribble( + ~type, ~endpoint, ~strata, ~control, ~test, ~analyses_analysed, ~sf, ~sfpar, ~nominal, ~test_method, + "Primary", "MRD", "All", "Ctrl", "Trt", 1, "none", NULL, NULL, "pooled_proportions", + "Primary", "OS", "All", "Ctrl", "Trt", 2:4, "asOF", NULL, NULL, "logrank" + ), + + enroll_rate = tibble::tribble( + ~stratum, ~treatments, ~rate, ~duration, ~ratio, + "All", c("Trt", "Ctrl"), 50, 20, c(1, 4) # 1:4 allocation, N=1000 total + ), + + distribution_tte = tibble::tribble( + ~endpoint, ~stratum, ~treatment, ~duration, ~fail_rate, ~dropout_rate, + "OS", "All", "Ctrl", 6, 0.025, -log(1 - 0.20) / 12, + "OS", "All", "Ctrl", Inf, 0.010, -log(1 - 0.20) / 12, + "OS", "All", "Trt", 6, 0.025 * 0.55, -log(1 - 0.20) / 12, + "OS", "All", "Trt", Inf, 0.010 * 0.55, -log(1 - 0.20) / 12 + ), + + distribution_bin = tibble::tribble( + ~endpoint, ~stratum, ~treatment, ~rate, ~maturity_time, + "MRD", "All", "Ctrl", 0.30, 2, + "MRD", "All", "Trt", 0.50, 2 + ), + + graph = list( + g = rbind(c(0, 1), + c(0, 0)), + w = c(0.1, 0.9) + ) +) diff --git a/tests/testthat/test-local-power-rpact.R b/tests/testthat/test-local-power-rpact.R new file mode 100644 index 0000000..d74c218 --- /dev/null +++ b/tests/testthat/test-local-power-rpact.R @@ -0,0 +1,155 @@ +# test-local-power-rpact.R +# +# Tier 2: rpact cross-validation of local power for TTE hypotheses. +# +# Validates that appendMCP's local power values (Table 5) agree with an +# independent analytical calculation from rpact::getPowerSurvival() using the +# Schoenfeld method. This directly exercises the info_scale = "h0_info" fix +# in get_boundaries() (commit a365a64). +# +# Config: tests/testthat/fixtures/local_power_validation_config.R +# Single stratum, 1:4 allocation (Trt:Ctrl), HR=0.55, piecewise hazard, +# asOF spending. Designed specifically for this validation — not a real study. +# +# H1 = MRD binary — skipped (rpact binary comparison not in scope here) +# H2 = OS TTE — asOF, 3 analyses, 2 weight scenarios (w=0.9, w=1.0) +# +# All inputs to rpact are derived from config and result — no hardcoded numerics +# except TOLERANCE (a design decision, not a config property). +# +# Tolerance: 0.002 (0.2 pp) — consistent with known gsDesign2/rpact rounding +# differences documented in rpact vignette "rpact vs gsDesign" (June 2026). +# Observed max difference: 2e-06. +# +# Skipped on CRAN (requires rpact Suggests dependency). + +library(appendMCP) + +skip_if_not_installed("rpact") +skip_on_cran() + +TOLERANCE <- 0.002 + +# ── Reference implementation (independent of appendMCP) ─────────────────────── +# Computes cumulative local power via rpact::getPowerSurvival() with Schoenfeld +# method. cumsum(rejectPerStage) matches appendMCP's cumulative power column. + +rpact_power_tte <- function(alpha_eff, info_rates, sf, gamma, + pw_starts, lambda2, hr, + max_events, max_subjects, + alloc_ratio = 1, + dropout_rate = 0.03, + dropout_time = 12) { + design <- rpact::getDesignGroupSequential( + sided = 1, + alpha = alpha_eff, + informationRates = info_rates, + typeOfDesign = sf, + gammaA = if (is.na(gamma)) NA_real_ else gamma + ) + res <- rpact::getPowerSurvival( + design = design, + typeOfComputation = "Schoenfeld", + thetaH0 = 1, + directionUpper = FALSE, + hazardRatio = hr, + piecewiseSurvivalTime = pw_starts, + lambda2 = lambda2, + dropoutRate1 = dropout_rate, + dropoutRate2 = dropout_rate, + dropoutTime = dropout_time, + allocationRatioPlanned = alloc_ratio, + maxNumberOfEvents = max_events, + maxNumberOfSubjects = max_subjects + ) + cumsum(as.numeric(res$rejectPerStage)) +} + +# ── Load fixture and run process_config once for the whole file ──────────────── + +e <- new.env() +source(testthat::test_path("fixtures", "local_power_validation_config.R"), local = e) +config <- e$config + +result <- process_config(config) +hyp <- result$hypotheses + +# ── Derive all rpact inputs from config — no hardcoded numerics ─────────────── + +# H2 is OS TTE — index 2 in hypotheses +hyp_idx <- 2L +hyp_config <- config$hypotheses[hyp_idx, ] +h2_rows <- dplyr::filter(hyp, index == hyp_idx, possible_weight > 0) + +# Spending function and parameter +sf <- hyp_config$sf +gamma <- hyp_config$sfpar[[1]] # NULL for asOF +gamma <- if (is.null(gamma)) NA_real_ else as.numeric(gamma) + +# Control arm distribution: piecewise starts and lambda +ctrl_arm <- hyp_config$control +test_arm <- hyp_config$test +dist_ctrl <- config$distribution_tte |> + dplyr::filter(.data$endpoint == hyp_config$endpoint, + .data$treatment == ctrl_arm, + .data$stratum == "All") +dist_trt <- config$distribution_tte |> + dplyr::filter(.data$endpoint == hyp_config$endpoint, + .data$treatment == test_arm, + .data$stratum == "All") + +# pw_starts: cumulative interval starts (rpact convention) +# from durations c(6, Inf) -> finite = c(6) -> starts = c(0, 6) +finite_durs <- dist_ctrl$duration[is.finite(dist_ctrl$duration)] +pw_starts <- c(0, cumsum(finite_durs)) # c(0, 6) +lambda2 <- dist_ctrl$fail_rate # control hazard rates per interval + +# HR: ratio of test/control fail rate (constant across segments) +hr <- dist_trt$fail_rate[1] / dist_ctrl$fail_rate[1] + +# Max events: from the final analysis row for this hypothesis +final_analysis_idx <- max(unlist(hyp_config$analyses_analysed)) +max_events <- as.integer(config$analyses$events[final_analysis_idx]) + +# Max subjects: total enrolled (both arms) +max_subjects <- as.integer( + sum(config$enroll_rate$rate * config$enroll_rate$duration) +) + +# Allocation ratio: Trt/Ctrl +ratio_vec <- config$enroll_rate$ratio[[1]] +trt_pos <- match(test_arm, config$enroll_rate$treatments[[1]]) +ctrl_pos <- match(ctrl_arm, config$enroll_rate$treatments[[1]]) +alloc_ratio <- ratio_vec[trt_pos] / ratio_vec[ctrl_pos] + +# Dropout: annual probability back-converted from monthly rate +dropout_annual <- 1 - exp(-dist_ctrl$dropout_rate[1] * 12) + +# ── Tests: H2 OS across all non-zero weight scenarios ───────────────────────── + +test_that("H2 OS local power matches rpact across all weight scenarios (local_power_validation)", { + expect_gt(nrow(h2_rows), 0L) + + for (i in seq_len(nrow(h2_rows))) { + w <- h2_rows$possible_weight[i] + info_rates <- unlist(h2_rows$information_fractions[[i]]) + amcp <- unlist(h2_rows$power[[i]]) + + ref <- rpact_power_tte( + alpha_eff = config$alpha * w, + info_rates = info_rates, + sf = sf, + gamma = gamma, + pw_starts = pw_starts, + lambda2 = lambda2, + hr = hr, + max_events = max_events, + max_subjects = max_subjects, + alloc_ratio = alloc_ratio, + dropout_rate = dropout_annual + ) + + expect_equal(amcp, ref, tolerance = TOLERANCE, + label = sprintf("H2 OS cumulative power at weight=%.6f", w)) + } +})