## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  dpi = 192,
  fig.retina = 2
)

## ----setup--------------------------------------------------------------------
library(graphicalMCP)

## ----spending-comparison------------------------------------------------------
# Compare spending at information fractions (1/3, 2/3, 1) for alpha = 0.025
t_values <- c(1/3, 2/3, 1)
spending_comparison <- data.frame(
  `Info Fraction` = t_values,
  `O'Brien-Fleming` = spending_of(0.025, t_values),
  Pocock = spending_pocock(0.025, t_values),
  `HSD (gamma=-4)` = spending_hsd(0.025, t_values, -4),
  Linear = spending_linear(0.025, t_values),
  check.names = FALSE
)
knitr::kable(spending_comparison, digits = 6,
             caption = "Cumulative alpha spent at each analysis (alpha = 0.025)")

## ----boundaries-example-------------------------------------------------------
# Compute boundaries for OBF spending at alpha = 0.025 with 3 equally spaced analyses
bounds <- graphicalMCP:::gs_boundaries(0.025, c(1/3, 2/3, 1), spending_of)

boundary_table <- data.frame(
  Analysis = 1:3,
  `Info Fraction` = c(1/3, 2/3, 1),
  `Cumulative Spending` = spending_of(0.025, c(1/3, 2/3, 1)),
  `Z Boundary` = bounds$bounds_z,
  `Nominal p Boundary` = bounds$bounds_nominal,
  check.names = FALSE
)
knitr::kable(boundary_table, digits = 6,
             caption = "OBF group sequential boundaries (alpha = 0.025)")

## ----rep-seq-p-example--------------------------------------------------------
# A hypothesis tested at three analyses with OBF spending
p_h1 <- c(0.05, 0.02, 0.01)
info <- c(1/3, 2/3, 1)

# Repeated p-value at analysis 3 (considers only the boundary at analysis 3)
rep_p_3 <- repeated_p(p = p_h1, info_frac = info, spending_fn = spending_of)
cat("Repeated p-value at analysis 3:", rep_p_3, "\n")

# Sequential p-value at analysis 3 (considers boundaries at all three analyses)
seq_p_3 <- sequential_p(p = p_h1, info_frac = info, spending_fn = spending_of)
cat("Sequential p-value at analysis 3:", seq_p_3, "\n")

# The sequential p-value is the minimum of repeated p-values across analyses
rep_p_1 <- repeated_p(p = p_h1[1], info_frac = info[1], spending_fn = spending_of)
rep_p_2 <- repeated_p(p = p_h1[1:2], info_frac = info[1:2], spending_fn = spending_of)
cat("Repeated p-values:", rep_p_1, rep_p_2, rep_p_3, "\n")
cat("min(rep_p_1, rep_p_2, rep_p_3) =", min(rep_p_1, rep_p_2, rep_p_3), "\n")

## ----graph-setup--------------------------------------------------------------
hypotheses <- c(0.5, 0.5, 0, 0)
transitions <- rbind(
  c(0, 0.5, 0.5, 0), # H1 -> H2 (1/2), H3 (1/2)
  c(0.5, 0, 0, 0.5), # H2 -> H1 (1/2), H4 (1/2)
  c(0, 1, 0, 0),     # H3 -> H2 (full propagation)
  c(1, 0, 0, 0)      # H4 -> H1 (full propagation)
)
g <- graph_create(hypotheses, transitions)

## ----graph-plot, eval = requireNamespace("igraph", quietly = TRUE)------------
plot(g, vertex.size = 40)

## ----p-values-----------------------------------------------------------------
# P-values from Table 1 of Maurer and Bretz (2013)
# Only analyses 1 and 2 are conducted (trial stops after analysis 2)
p <- rbind(
  H1 = c(0.0062, 0.0002),
  H2 = c(0.017,  0.0035),
  H3 = c(0.009,  0.002),
  H4 = c(0.13,   0.06)
)

p_display <- as.data.frame(p)
colnames(p_display) <- paste("Analysis", 1:2)
knitr::kable(
  p_display,
  caption = "Observed nominal p-values"
)

## ----repeated-p-matrix--------------------------------------------------------
info_frac <- c(1/3, 2/3)
rep_p_matrix <- matrix(NA, nrow = 4, ncol = 2,
                       dimnames = list(rownames(p), c("Analysis 1", "Analysis 2")))

for (j in 1:4) {
  for (k in 1:2) {
    rep_p_matrix[j, k] <- repeated_p(
      p = p[j, 1:k],
      info_frac = info_frac[1:k],
      spending_fn = spending_of
    )
  }
}

knitr::kable(rep_p_matrix, digits = 4,
             caption = "Repeated p-values at each analysis")

## ----run-gsd-no-lb------------------------------------------------------------
result <- graph_test_shortcut_gsd(
  graph = g,
  p = p,
  alpha = 0.025,
  info_frac = info_frac,
  spending_fn = spending_of,
  look_back = FALSE,
  test_values = TRUE
)
print(result)

## ----test-values-tables-------------------------------------------------------
format_test_values <- function(tv) {
  tv$Boundary <- formatC(tv$Boundary, format = "f", digits = 6)
  tv
}
knitr::kable(format_test_values(result$test_values[[1]]), digits = 6,
             caption = "Analysis 1: nominal boundaries and rejection decisions")
knitr::kable(format_test_values(result$test_values[[2]]), digits = 6,
             caption = "Analysis 2: nominal boundaries and rejection decisions")

## ----key-inequality-----------------------------------------------------------
b_half <- gs_boundaries(0.0125, c(1/3, 2/3, 1), spending_of)
b_full <- gs_boundaries(0.025, c(1/3, 2/3, 1), spending_of)
cat(sprintf(
  "Boundary at alpha = 0.0125:     %.6f\n0.5 * Boundary at alpha = 0.025: %.6f\n",
  b_half$bounds_nominal[1],
  0.5 * b_full$bounds_nominal[1]
))

## ----paper-comparison, include=FALSE------------------------------------------
paper_repeated_p <- data.frame(
  Hypothesis = c("H1", "H2", "H3", "H4"),
  `pr_1 (paper)` = c(0.1141, 0.1683, 0.1316, 0.382),
  `pr_1 (ours)` = round(result$outputs$sequential_p[, 1], 4),
  `pr_2 (paper)` = c(0.0024, 0.0172, 0.0117, 0.1285),
  `pr_2 (ours)` = round(result$outputs$sequential_p[, 2], 4),
  check.names = FALSE
)
knitr::kable(paper_repeated_p, digits = 4,
             caption = "Comparison of sequential p-values with paper Table 2")

## ----nominal-comparison, include=FALSE----------------------------------------
paper_table1 <- data.frame(
  Hypothesis = c("H1", "H2", "H3", "H4"),
  `alpha*_1 (paper)` = c(0.00002, 0.00002, 0, 0),
  `alpha*_1 (ours)` = round(result$test_values[[1]]$Boundary, 5),
  `alpha*_2 (paper)` = c(0.0022, "0.004 (updated)", "0.0022 (updated)",
                         "0.006 (updated)"),
  `alpha*_2 (ours)` = round(result$test_values[[2]]$Boundary, 4),
  check.names = FALSE
)
knitr::kable(paper_table1,
             caption = "Comparison of nominal boundaries with paper Table 1")

## ----boundary-table-----------------------------------------------------------
result_verbose <- graph_test_shortcut_gsd(
  graph = g,
  p = p,
  alpha = 0.025,
  info_frac = info_frac,
  spending_fn = spending_of,
  verbose = TRUE
)

# Display boundary tables for each hypothesis
for (h in names(result_verbose$boundary_table)) {
  cat(h, "\n")
  print(result_verbose$boundary_table[[h]])
  cat("\n")
}

## ----oncology-graph-----------------------------------------------------------
alpha_onc <- 0.025
alpha_allocation <- c(0.01, 0.01, 0.004, 0, 0.0005, 0.0005)
hypotheses_onc <- alpha_allocation / alpha_onc

hyp_names_onc <- c(
  "H1_OS_S", "H2_OS_A", "H3_PFS_S", "H4_PFS_A", "H5_ORR_S", "H6_ORR_A"
)
names(hypotheses_onc) <- hyp_names_onc

transitions_onc <- rbind(
  c(0, 1, 0, 0, 0, 0),       # H1_OS_S  -> H2_OS_A
  c(0, 0, 0.5, 0.5, 0, 0),   # H2_OS_A  -> H3_PFS_S (1/2), H4_PFS_A (1/2)
  c(0, 0, 0, 1, 0, 0),       # H3_PFS_S -> H4_PFS_A
  c(0, 0, 0, 0, 0.5, 0.5),   # H4_PFS_A -> H5_ORR_S (1/2), H6_ORR_A (1/2)
  c(0, 0, 0, 0, 0, 1),       # H5_ORR_S -> H6_ORR_A
  c(0.5, 0.5, 0, 0, 0, 0)    # H6_ORR_A -> H1_OS_S (1/2), H2_OS_A (1/2)
)

g_onc <- graph_create(hypotheses_onc, transitions_onc)

## ----oncology-graph-plot, eval = requireNamespace("igraph", quietly = TRUE), fig.height=5.5, fig.width=6, out.width="100%"----
onc_layout <- rbind(
  c(0, 3),     # H1_OS_S
  c(2, 3),     # H2_OS_A
  c(0, 1.8),   # H3_PFS_S
  c(3, 1.8),   # H4_PFS_A
  c(0, 0.5),   # H5_ORR_S
  c(2, 0.5)    # H6_ORR_A
)
# Edge label positions: NA = auto, explicit coords to move specific labels
# Edge order: 1=H6->H1, 2=H1->H2, 3=H6->H2, 4=H2->H3, 5=H2->H4,
#             6=H3->H4, 7=H4->H5, 8=H4->H6, 9=H5->H6
label_x <- rep(NA, 9)
label_y <- rep(NA, 9)
label_x[1] <- 0.4;  label_y[1] <- 2.5    # H6->H1: toward arrow (H1)
label_x[3] <- 2.0;  label_y[3] <- 2.375  # H6->H2: on the edge, toward arrow
label_x[4] <- 1.5;  label_y[4] <- 2.7    # H2->H3: toward tail (H2)
label_x[6] <- 0.75; label_y[6] <- 1.8    # H3->H4: toward tail (H3)
label_x[7] <- 0.9;  label_y[7] <- 0.89   # H4->H5: toward arrow (H5)
label_x[8] <- 2.5;  label_y[8] <- 1.15   # H4->H6: on the edge, midway

plot(g_onc, layout = onc_layout, vertex.size = 60, asp = 1,
     vertex.label.cex = 0.7,
     rescale = FALSE,
     xlim = c(-0.6, 3.6),
     ylim = c(-0.1, 3.6),
     edge.label.x = label_x,
     edge.label.y = label_y)

## ----oncology-p-values--------------------------------------------------------
p_onc <- rbind(
  H1_OS_S  = c(0.03,    0.0001, 0.000001),
  H2_OS_A  = c(0.2,     0.15,   0.1),
  H3_PFS_S = c(0.2,     0.001,  NA),
  H4_PFS_A = c(0.3,     0.2,    NA),
  H5_ORR_S = c(0.00001, NA,     NA),
  H6_ORR_A = c(0.1,     NA,     NA)
)

# Event-driven information fractions (events / max events per endpoint)
info_frac_onc <- rbind(
  H1_OS_S  = c(185 / 295, 245 / 295, 1),
  H2_OS_A  = c(529 / 800, 700 / 800, 1),
  H3_PFS_S = c(265 / 310, 1,         NA),
  H4_PFS_A = c(675 / 750, 1,         NA),
  H5_ORR_S = c(1,         NA,        NA),
  H6_ORR_A = c(1,         NA,        NA)
)

knitr::kable(
  data.frame(
    Hypothesis = rownames(p_onc),
    `No. of Analyses` = rowSums(!is.na(p_onc)),
    `Info Frac` = apply(info_frac_onc, 1, function(x) {
      paste(round(x[!is.na(x)], 3), collapse = ", ")
    }),
    check.names = FALSE
  ),
  row.names = FALSE,
  caption = "Number of analyses and information fractions per hypothesis"
)

## ----oncology-p-table---------------------------------------------------------
p_display <- p_onc
p_display[] <- ifelse(
  is.na(p_display), "—",
  formatC(as.numeric(p_display), format = "f", digits = 6)
)
knitr::kable(
  as.data.frame(p_display),
  col.names = paste("Analysis", 1:3),
  caption = "Observed nominal p-values (— indicates no data at that analysis)"
)

## ----oncology-run-lb----------------------------------------------------------
result_onc_lb <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc,
  alpha = alpha_onc,
  info_frac = info_frac_onc,
  spending_fn = spending_of,
  look_back = TRUE,
  test_values = TRUE
)
print(result_onc_lb)

## ----oncology-seq-p-----------------------------------------------------------
seq_p_display <- result_onc_lb$outputs$sequential_p
seq_p_display[] <- ifelse(
  is.na(seq_p_display), NA,
  formatC(as.numeric(seq_p_display), format = "f", digits = 6)
)
knitr::kable(
  as.data.frame(seq_p_display),
  caption = "Sequential p-values (NA = hypothesis not tested at that analysis)"
)

## ----oncology-results-lb------------------------------------------------------
# Extract the p-value and boundary at the decision point for each hypothesis.
# For rejected hypotheses, this is the analysis where rejection occurred.
# For non-rejected hypotheses, this is the last analysis where it was tested.
tv_all <- do.call(rbind, result_onc_lb$test_values)
decision_p <- numeric(length(hyp_names_onc))
decision_bound <- numeric(length(hyp_names_onc))
for (i in seq_along(hyp_names_onc)) {
  h <- hyp_names_onc[i]
  rows <- tv_all[tv_all$Hypothesis == h, ]
  if (nrow(rows) == 0) next
  # Use the last row for this hypothesis (final decision point)
  decision_p[i] <- rows$p[nrow(rows)]
  decision_bound[i] <- rows$Boundary[nrow(rows)]
}

# For non-rejected hypotheses, find the last analysis where they were tested
last_tested <- rowSums(!is.na(p_onc))

onc_summary_lb <- data.frame(
  Hypothesis = hyp_names_onc,
  `p` = formatC(decision_p, format = "f", digits = 6),
  Boundary = formatC(decision_bound, format = "f", digits = 6),
  Rejected = result_onc_lb$outputs$rejected,
  Tested.at = result_onc_lb$outputs$decision_at,
  First.Rej.at = ifelse(
    is.na(result_onc_lb$outputs$first_rejected_at), "—",
    as.character(result_onc_lb$outputs$first_rejected_at)
  ),
  Last.Rej.at = ifelse(
    is.na(result_onc_lb$outputs$last_rejected_at), "—",
    as.character(result_onc_lb$outputs$last_rejected_at)
  ),
  check.names = FALSE
)
knitr::kable(onc_summary_lb, row.names = FALSE,
             caption = "Oncology case study (look_back = TRUE): rejection decisions")

## ----per-hyp-look-back--------------------------------------------------------
look_back_onc <- c(
  FALSE,  # H1_OS_S:  no look_back
  FALSE,  # H2_OS_A:  no look_back
  FALSE,  # H3_PFS_S: no look_back
  FALSE,  # H4_PFS_A: no look_back
  TRUE,   # H5_ORR_S: look_back
  TRUE    # H6_ORR_A: look_back
)

result_onc_mixed <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc,
  alpha = alpha_onc,
  info_frac = info_frac_onc,
  spending_fn = spending_of,
  look_back = look_back_onc
)
print(result_onc_mixed)

## ----per-hyp-look-back-compare------------------------------------------------
mixed_comparison <- data.frame(
  Hypothesis = hyp_names_onc,
  `Rejected (all LB)` = result_onc_lb$outputs$rejected,
  `Adj. P (all LB)` = round(result_onc_lb$outputs$adjusted_p, 6),
  `Rejected (mixed)` = result_onc_mixed$outputs$rejected,
  `Adj. P (mixed)` = round(result_onc_mixed$outputs$adjusted_p, 6),
  check.names = FALSE
)
knitr::kable(mixed_comparison, row.names = FALSE,
             caption = "Effect of per-hypothesis look_back on rejection decisions")

## ----oncology-look-back-diff--------------------------------------------------
p_onc_lb <- p_onc
p_onc_lb["H2_OS_A", ] <- c(0.003, 0.005, 0.1)
p_onc_lb["H4_PFS_A", ] <- c(0.0001, 0.02, NA)
p_onc_lb["H5_ORR_S", ] <- c(0.0008, NA, NA)

# look_back = FALSE: H4's repeated p-value at analysis 2 is too large
result_onc_no_lb <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc_lb,
  alpha = alpha_onc,
  info_frac = info_frac_onc,
  spending_fn = spending_of,
  look_back = FALSE,
  test_values = TRUE
)

# look_back = TRUE: H4 benefits from its strong analysis-1 evidence
result_onc_yes_lb <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc_lb,
  alpha = alpha_onc,
  info_frac = info_frac_onc,
  spending_fn = spending_of,
  look_back = TRUE,
  test_values = TRUE
)

## ----oncology-look-back-diff-no-----------------------------------------------
print(result_onc_no_lb)

## ----oncology-look-back-diff-yes----------------------------------------------
print(result_onc_yes_lb)

## ----oncology-look-back-diff-compare------------------------------------------
lb_diff_table <- data.frame(
  Hypothesis = hyp_names_onc,
  `Rejected (no LB)` = result_onc_no_lb$outputs$rejected,
  `Rejected (LB)` = result_onc_yes_lb$outputs$rejected,
  `First.Rej.at (LB)` = ifelse(
    is.na(result_onc_yes_lb$outputs$first_rejected_at), "--",
    as.character(result_onc_yes_lb$outputs$first_rejected_at)),
  `Last.Rej.at (LB)` = ifelse(
    is.na(result_onc_yes_lb$outputs$last_rejected_at), "--",
    as.character(result_onc_yes_lb$outputs$last_rejected_at)),
  check.names = FALSE
)
knitr::kable(lb_diff_table, row.names = FALSE,
             caption = "Effect of look_back on oncology trial rejection decisions")

## ----spending-time-setup------------------------------------------------------
# Spending time = subgroup event fractions (same as H1_OS_S)
# info_frac ensures NA positions match those in info_frac_onc
spending_h2 <- spending_with_time(
  spending_of,
  spending_time = c(185 / 295, 245 / 295, 1),
  info_frac = info_frac_onc["H2_OS_A", ]
)

# Similarly, H4 (PFS, all subjects) uses subgroup PFS event fractions
spending_h4 <- spending_with_time(
  spending_of,
  spending_time = c(265 / 310, 1, NA),
  info_frac = info_frac_onc["H4_PFS_A", ]
)

# Build per-hypothesis spending function list
spending_fn_onc <- list(
  spending_of,   # H1_OS_S:  standard (info_frac = spending time)
  spending_h2,   # H2_OS_A:  spending time = subgroup OS events
  spending_of,   # H3_PFS_S: standard
  spending_h4,   # H4_PFS_A: spending time = subgroup PFS events
  spending_of,   # H5_ORR_S: standard (single analysis)
  spending_of    # H6_ORR_A: standard (single analysis)
)

## ----spending-time-run--------------------------------------------------------
result_onc_st <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc,
  alpha = alpha_onc,
  info_frac = info_frac_onc,
  spending_fn = spending_fn_onc,
  look_back = TRUE
)
print(result_onc_st)

## ----spending-time-compare----------------------------------------------------
st_comparison <- data.frame(
  Hypothesis = hyp_names_onc,
  `Rejected (info fraction)` = result_onc_lb$outputs$rejected,
  `Adj. P (info fraction)` = round(result_onc_lb$outputs$adjusted_p, 6),
  `Rejected (spending time)` = result_onc_st$outputs$rejected,
  `Adj. P (spending time)` = round(result_onc_st$outputs$adjusted_p, 6),
  check.names = FALSE
)
knitr::kable(st_comparison, row.names = FALSE,
             caption = "Effect of spending time on rejection decisions")

## ----monitoring-setup---------------------------------------------------------
# Planned info fractions (used for boundaries at analyses 1 and 2)
planned_if_h1 <- c(185 / 295, 245 / 295, 1)

# Actual info fractions (more events than planned at final analysis)
actual_if_h1 <- c(185 / 310, 245 / 310, 1)

cat("Planned:", round(planned_if_h1, 4), "\n")
cat("Actual: ", round(actual_if_h1, 4), "\n")

## ----monitoring-spending------------------------------------------------------
# Spending function using planned info fractions for spending,
# with info_frac for NA structure validation
spending_h1_monitor <- spending_with_time(
  spending_of,
  spending_time = planned_if_h1,
  info_frac = actual_if_h1
)

## ----monitoring-comparison----------------------------------------------------
alpha_h1 <- 0.01  # H1's allocated alpha

# Scenario 1: Planned (original design)
bounds_planned <- gs_boundaries(alpha_h1, planned_if_h1, spending_of)

# Scenario 2: Naive update (both use actual)
bounds_naive <- gs_boundaries(alpha_h1, actual_if_h1, spending_of)

# Scenario 3: Correct monitoring (spending=planned, correlation=actual)
bounds_monitor <- gs_boundaries(alpha_h1, actual_if_h1, spending_h1_monitor)

monitor_table <- data.frame(
  Analysis = 1:3,
  Planned.IF = round(planned_if_h1, 4),
  Actual.IF = round(actual_if_h1, 4),
  Boundary.Planned = bounds_planned$bounds_nominal,
  Boundary.Naive = bounds_naive$bounds_nominal,
  Boundary.Monitor = bounds_monitor$bounds_nominal
)
knitr::kable(monitor_table, digits = 6,
             caption = paste("Boundaries under three scenarios",
                             "(H1 with alpha = 0.01)"))

## ----monitoring-full----------------------------------------------------------
# Actual info fractions for all hypotheses
# (only OS hypotheses affected; PFS and ORR are complete)
actual_if_onc <- info_frac_onc
actual_if_onc["H1_OS_S", ] <- c(185 / 310, 245 / 310, 1)
actual_if_onc["H2_OS_A", ] <- c(529 / 830, 700 / 830, 1)

# Spending functions using planned info fractions for OS hypotheses
spending_fn_monitor <- list(
  spending_with_time(spending_of,
    spending_time = info_frac_onc["H1_OS_S", ],
    info_frac = actual_if_onc["H1_OS_S", ]),
  spending_with_time(spending_of,
    spending_time = info_frac_onc["H2_OS_A", ],
    info_frac = actual_if_onc["H2_OS_A", ]),
  spending_of,   # H3: PFS complete, no change
  spending_of,   # H4: PFS complete, no change
  spending_of,   # H5: ORR complete
  spending_of    # H6: ORR complete
)

result_monitor <- graph_test_shortcut_gsd(
  graph = g_onc,
  p = p_onc,
  alpha = alpha_onc,
  info_frac = actual_if_onc,
  spending_fn = spending_fn_monitor,
  look_back = TRUE
)
print(result_monitor)

## ----different-spending-------------------------------------------------------
result2 <- graph_test_shortcut_gsd(
  graph = g,
  p = p,
  alpha = 0.025,
  info_frac = c(1/3, 2/3),
  spending_fn = list(
    spending_of,      # H1: O'Brien-Fleming
    spending_of,      # H2: O'Brien-Fleming
    spending_pocock,  # H3: Pocock (more aggressive)
    spending_pocock   # H4: Pocock (more aggressive)
  ),
  test_values = TRUE
)
print(result2)

## ----gsdesign-wrapper---------------------------------------------------------
if (requireNamespace("gsDesign", quietly = TRUE)) {
  # Wrapper for gsDesign's Lan-DeMets O'Brien-Fleming
  gsdesign_of <- function(alpha, info_frac) {
    gsDesign::sfLDOF(alpha, info_frac)$spend
  }

  # Wrapper for gsDesign's Hwang-Shih-DeCani with gamma = -2
  gsdesign_hsd <- function(alpha, info_frac) {
    gsDesign::sfHSD(alpha, info_frac, param = -2)$spend
  }

  result_gsdesign <- graph_test_shortcut_gsd(
    graph = g,
    p = p,
    alpha = 0.025,
    info_frac = c(1/3, 2/3),
    spending_fn = list(
      gsdesign_of,   # H1: gsDesign O'Brien-Fleming
      gsdesign_of,   # H2: gsDesign O'Brien-Fleming
      gsdesign_hsd,  # H3: gsDesign HSD(gamma=-2)
      gsdesign_hsd   # H4: gsDesign HSD(gamma=-2)
    )
  )
  print(result_gsdesign)
}

## ----rpact-snippet------------------------------------------------------------
rpact::setLogLevel("DISABLED")
repP <- function(pVals){
  cum_n <- seq_along(pVals) * 2
  design <- rpact::getDesignGroupSequential(typeOfDesign = "asOF", kMax = 3)
  data <- rpact::getDataset(
    cumMeans = c(qnorm(1 - pVals) / sqrt(cum_n)),
    cumStDevs = rep(1, length(pVals)), 
    cumN = cum_n
  )
  stage_res <- rpact::getStageResults(design, data, normalApproximation = TRUE)
  rpact::getRepeatedPValues(stage_res)
}  

repP(c(0.0062, 0.0002))
repP(c(0.0170, 0.0035))
repP(c(0.0090, 0.0020))
repP(c(0.1300, 0.0600))

## ----user-defined-spending----------------------------------------------------
# Piecewise spending: OBF for the first 'threshold' of alpha,
# Pocock for the remainder
spending_piecewise <- function(alpha, info_frac, threshold = 0.0125) {
  spending_of(pmin(alpha, threshold), info_frac) +
    spending_pocock(pmax(alpha - threshold, 0), info_frac)
}

# At alpha = 0.025: first 0.0125 is OBF, second 0.0125 is Pocock
t <- c(1/3, 2/3, 1)
comparison <- data.frame(
  `Info Fraction` = t,
  `OBF only` = spending_of(0.025, t),
  `Pocock only` = spending_pocock(0.025, t),
  Piecewise = spending_piecewise(0.025, t),
  check.names = FALSE
)
knitr::kable(comparison, digits = 6,
             caption = "Piecewise spending: OBF for first half, Pocock for second half")

## ----user-defined-spending-half-----------------------------------------------
# At alpha = 0.0125: entirely OBF (below threshold)
all.equal(
  spending_piecewise(0.0125, t),
  spending_of(0.0125, t)
)

## ----user-defined-spending-gsd------------------------------------------------
result_piecewise <- graph_test_shortcut_gsd(
  graph = g,
  p = p,
  alpha = 0.025,
  info_frac = c(1/3, 2/3),
  spending_fn = spending_piecewise
)
print(result_piecewise)