last.rej.at and updated spending functions

Author: xidongdxi

R/graph_test_shortcut_gsd.R

@@ -104,6 +104,11 @@
 #'       hypotheses, this is `NA`. When `look_back = TRUE`, this may be
 #'       earlier than `decision_at` if a hypothesis crossed its boundary at
 #'       a prior analysis but only became testable at a later analysis,
+#'     * `last_rejected_at` - Integer vector indicating the latest analysis
+#'       at which each hypothesis's boundary was crossed. For non-rejected
+#'       hypotheses, this is `NA`. Comparing `first_rejected_at` and
+#'       `last_rejected_at` shows whether the rejection is supported by
+#'       data at multiple analyses or only at a single analysis,
 #'     * `rejection_sequence` - Character vector giving the order in which
 #'       hypotheses were rejected across all analyses,
 #'     * `graph` - Updated graph after removing all rejected hypotheses.
@@ -333,6 +338,7 @@ graph_test_shortcut_gsd <- function(graph,
         rejected = result$rejected,
         decision_at = result$decision_at,
         first_rejected_at = result$first_rejected_at,
+        last_rejected_at = result$last_rejected_at,
         rejection_sequence = result$rejection_sequence,
         graph = if (any(result$rejected)) {
           graph_update(graph, result$rejected)$updated_graph
@@ -467,6 +473,7 @@ gsd_test <- function(graph, p, alpha, info_frac, spending_fn, look_back,
 
   # Process analyses sequentially
   rejected <- structure(rep(FALSE, num_hyps), names = hyp_names)
+  last_rejected_at <- structure(rep(NA_integer_, num_hyps), names = hyp_names)
   decision_at <- structure(rep(NA_integer_, num_hyps), names = hyp_names)
   first_rejected_at <- structure(rep(NA_integer_, num_hyps), names = hyp_names)
   adjusted_p <- structure(rep(NA_real_, num_hyps), names = hyp_names)
@@ -542,13 +549,19 @@ gsd_test <- function(graph, p, alpha, info_frac, spending_fn, look_back,
           shortcut_k$details$results[[rej_idx]]$hypotheses[hyp_name]
         allocated_alpha <- w_at_rejection * alpha
 
-        # Look back: earliest analysis where sequential p <= allocated alpha
+        # Look back: earliest and latest analysis where boundary is crossed.
+        # Check repeated p-values (not sequential) at each analysis against
+        # the allocated alpha — a repeated p <= allocated alpha means the
+        # boundary at that specific analysis is crossed.
         j <- which(hyp_names == hyp_name)
-        earliest <- which(seq_p_matrix[j, 1:k] <= allocated_alpha)[1]
+        crossed <- which(rep_p_matrix[j, 1:k] <= allocated_alpha)
         first_rejected_at[hyp_name] <-
-          if (!is.na(earliest)) earliest else k
+          if (length(crossed) > 0) crossed[1] else k
+        last_rejected_at[hyp_name] <-
+          if (length(crossed) > 0) crossed[length(crossed)] else k
       } else {
         first_rejected_at[hyp_name] <- k
+        last_rejected_at[hyp_name] <- k
       }
     }
 
@@ -627,6 +640,7 @@ gsd_test <- function(graph, p, alpha, info_frac, spending_fn, look_back,
     rejected = rejected,
     decision_at = decision_at,
     first_rejected_at = first_rejected_at,
+    last_rejected_at = last_rejected_at,
     rejection_sequence = rejection_sequence,
     test_values = tv_details
   )

R/print.graph_report.R

@@ -121,7 +121,7 @@ print.graph_report <- function(x, ..., precision = 4, indent = 2, rows = 10) {
 
   df_summary <- data.frame(
     Hypothesis = formatC(hyp_names, width = hyp_width),
-    `Adj. P-value` = adjusted_p,
+    Adj.p = adjusted_p,
     Reject = x$outputs$rejected,
     check.names = FALSE
   )

R/print.gsd_graph_report.R

@@ -135,17 +135,24 @@ print.gsd_graph_report <- function(x, ..., precision = 6, indent = 2) {
     as.character(x$outputs$first_rejected_at)
   )
 
+  last_rej_display <- ifelse(
+    is.na(x$outputs$last_rejected_at),
+    "--",
+    as.character(x$outputs$last_rejected_at)
+  )
+
   df_summary <- data.frame(
     Hypothesis = formatC(hyp_names, width = hyp_width),
     Adj.P = adj_p_format,
     Reject = x$outputs$rejected,
-    Decision.at = as.character(decision_at),
+    Tested.at = as.character(decision_at),
     First.Rej.at = first_rej_display,
+    Last.Rej.at = last_rej_display,
     Look.back = look_back,
     check.names = FALSE
   )
   names(df_summary)[[1]] <- formatC("Hypothesis", width = hyp_width)
-  names(df_summary)[[2]] <- "Adj.P-value*"
+  names(df_summary)[[2]] <- "Adj.p*"
 
   print(df_summary, row.names = FALSE)
 

R/spending_functions.R

@@ -87,6 +87,21 @@
 #' spending_pocock(0.025, c(1/3, 2/3, 1))
 #' spending_hsd(0.025, c(1/3, 2/3, 1), gamma = -4)
 #' spending_linear(0.025, c(1/3, 2/3, 1))
+#'
+#' # User-defined spending function: piecewise combination.
+#' # Use O'Brien-Fleming for the first half of alpha (conservative at
+#' # early analyses), and Pocock for the second half (more aggressive).
+#' # This can be useful when a hypothesis starts with a small weight
+#' # (OBF spending) and later receives additional weight via graph
+#' # propagation (Pocock spending for the increment).
+#' spending_piecewise <- function(alpha, info_frac, threshold = 0.0125) {
+#'   spending_of(pmin(alpha, threshold), info_frac) +
+#'     spending_pocock(pmax(alpha - threshold, 0), info_frac)
+#' }
+#' spending_piecewise(0.025, c(1/3, 2/3, 1))
+#' # Compare: alpha = 0.0125 uses only OBF
+#' spending_piecewise(0.0125, c(1/3, 2/3, 1))
+#' spending_of(0.0125, c(1/3, 2/3, 1))
 spending_of <- function(alpha, info_frac) {
   stopifnot(
     "info_frac must be non-negative" = all(info_frac >= 0),
@@ -303,7 +318,10 @@ spending_with_time <- function(spending_fn, spending_time, info_frac = NULL) {
 #'
 #' @param alpha A numeric scalar of the total significance level.
 #' @param info_frac A numeric vector of information fractions at each analysis.
-#'   Must be non-negative, with at most one value \eqn{\geq 1}.
+#'   Must be non-negative, with at most one value \eqn{\geq 1}. The last
+#'   value must be \eqn{\geq 1} (i.e., the final analysis must be included),
+#'   because the Wang-Tsiatis constant \eqn{C} is calibrated over the full
+#'   set of analyses.
 #' @param delta A numeric scalar for the shape parameter \eqn{\Delta}.
 #'   The default is `0.5` (Pocock). Use `0` for O'Brien-Fleming.
 #' @param maxpts An integer scalar for the maximum number of function values
@@ -350,9 +368,12 @@ spending_with_time <- function(spending_fn, spending_time, info_frac = NULL) {
 #' }
 spending_wt <- function(alpha, info_frac, delta = 0.5,
                         maxpts = 25000, abseps = 1e-6) {
+
   stopifnot(
     "info_frac must be non-negative" = all(info_frac >= 0),
     "At most one info_frac value can be >= 1" = sum(info_frac >= 1) <= 1,
+    "The last info_frac value must be >= 1 for spending_wt" =
+      length(info_frac) > 0 && info_frac[length(info_frac)] >= 1,
     "delta must be a numeric scalar" = is.numeric(delta) && length(delta) == 1
   )
 

_pkgdown.yml

@@ -45,6 +45,7 @@ reference:
   - repeated_p
   - sequential_p
   - spending_of
+  - spending_wt
   - spending_with_time
   - gs_boundaries
   - gs_corr