Skip to contents

Adjusted sequential p-values

Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson

Source: vignettes/adj-seq-p.Rmd
adj-seq-p.Rmd

Example overview

In a 2-arm controlled clinical trial example with one primary endpoint, there are 3 patient populations defined by the status of two biomarkers A and B:

  • biomarker A positive,
  • biomarker B positive,
  • overall population.

The 3 primary elementary hypotheses are:

  • H1H_1: the experimental treatment is superior to the control in the biomarker A positive population;
  • H2H_2: the experimental treatment is superior to the control in the biomarker B positive population;
  • H3H_3: the experimental treatment is superior to the control in the overall population.

Assume an interim analysis and a final analysis are planned for the study and the number of events are listed as

event_tbl <- tribble(
  ~population, ~analysis, ~event,
  "A positive", 1, 100,
  "B positive", 1, 110,
  "AB positive", 1, 80,
  "overall", 1, 225,
  "A positive", 2, 200,
  "B positive", 2, 220,
  "AB positive", 2, 160,
  "overall", 2, 450,
)

The observed p-values are

obs_tbl <- tribble(
  ~hypothesis, ~analysis, ~obs_p,
  "H1", 1, 0.02,
  "H2", 1, 0.01,
  "H3", 1, 0.012,
  "H1", 2, 0.015,
  "H2", 2, 0.012,
  "H3", 2, 0.010
) %>%
  mutate(obs_Z = -qnorm(obs_p))

obs_tbl %>%
  gt() %>%
  tab_header(title = "Nominal p-values")
Nominal p-values
hypothesis analysis obs_p obs_Z
H1 1 0.020 2.053749
H2 1 0.010 2.326348
H3 1 0.012 2.257129
H1 2 0.015 2.170090
H2 2 0.012 2.257129
H3 2 0.010 2.326348 
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p

The information fraction of H1,H2,H3H_1, H_2, H_3 at IA is

IF_IA <- c(
  ((event_tbl %>% filter(analysis == 1, population == "A positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
    ((event_tbl %>% filter(analysis == 2, population == "A positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
  ((event_tbl %>% filter(analysis == 1, population == "B positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
    ((event_tbl %>% filter(analysis == 2, population == "B positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event),
  ((event_tbl %>% filter(analysis == 1, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 1, population == "overall"))$event) /
    ((event_tbl %>% filter(analysis == 2, population == "AB positive"))$event + (event_tbl %>% filter(analysis == 2, population == "overall"))$event)
)

IF_IA
## [1] 0.5 0.5 0.5

We assign the initial weights of H1,H2,H3H_1, H_2, H_3 as(w1(I),w2(I),w3(I))=(0.3,0.3,0.4).\left(w_1(I), w_2(I), w_3(I) \right) = (0.3, 0.3, 0.4). And its multiplicity strategy is visualized in below. If H1H_1 is rejected, then 3/73/7 local significance level α1\alpha_1 will be propagated to H2H_2, and 4/74/7 will go to H3H_3. If H3H_3 is rejected, then half of α3\alpha_3 goes to H1H_1, and half goes to H2H_2.

# Transition matrix in Figure A1
m <- matrix(c(
  0, 3 / 7, 4 / 7,
  3 / 7, 0, 4 / 7,
  0.5, 0.5, 0
), nrow = 3, byrow = TRUE)
# Initial weights
w <- c(0.3, 0.3, 0.4)
name_hypotheses <- c("H1: Biomarker A positive", "H2: Biomarker B positive", "H3: Overall Population")

hplot <- gMCPLite::hGraph(
  3,
  alphaHypotheses = w, m = m,
  nameHypotheses = name_hypotheses, trhw = .2, trhh = .1,
  digits = 5, trdigits = 3, size = 5, halfWid = 1, halfHgt = 0.5,
  offset = 0.2, trprop = 0.4,
  fill = as.factor(c(2, 3, 1)),
  palette = c("#BDBDBD", "#E0E0E0", "#EEEEEE"),
  wchar = "w"
)
hplot

The correlation of the 6 statistisc (2 analysis ×\times 3 hypothesis) are

# Event count of intersection of paired hypotheses - Table 2
# H1, H2: Hypotheses intersected.
# (1, 1) represents counts for hypothesis 1
# (1, 2) for counts for the intersection of hypotheses 1 and 2
event <- tribble(
  ~H1, ~H2, ~Analysis, ~Event,
  1, 1, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
  2, 2, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
  3, 3, 1, event_tbl %>% filter(analysis == 1, population == "overall") %>% select(event) %>% as.numeric(),
  1, 2, 1, event_tbl %>% filter(analysis == 1, population == "AB positive") %>% select(event) %>% as.numeric(),
  1, 3, 1, event_tbl %>% filter(analysis == 1, population == "A positive") %>% select(event) %>% as.numeric(),
  2, 3, 1, event_tbl %>% filter(analysis == 1, population == "B positive") %>% select(event) %>% as.numeric(),
  1, 1, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
  2, 2, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric(),
  3, 3, 2, event_tbl %>% filter(analysis == 2, population == "overall") %>% select(event) %>% as.numeric(),
  1, 2, 2, event_tbl %>% filter(analysis == 2, population == "AB positive") %>% select(event) %>% as.numeric(),
  1, 3, 2, event_tbl %>% filter(analysis == 2, population == "A positive") %>% select(event) %>% as.numeric(),
  2, 3, 2, event_tbl %>% filter(analysis == 2, population == "B positive") %>% select(event) %>% as.numeric()
)
event
## # A tibble: 12 × 4
##       H1    H2 Analysis Event
##    <dbl> <dbl>    <dbl> <dbl>
##  1     1     1        1   100
##  2     2     2        1   110
##  3     3     3        1   225
##  4     1     2        1    80
##  5     1     3        1   100
##  6     2     3        1   110
##  7     1     1        2   200
##  8     2     2        2   220
##  9     3     3        2   450
## 10     1     2        2   160
## 11     1     3        2   200
## 12     2     3        2   220
# Generate correlation from events
gs_corr <- wpgsd::generate_corr(event)
gs_corr %>% round(2)
##      H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
## [1,]  1.00  0.76  0.67  0.71  0.54  0.47
## [2,]  0.76  1.00  0.70  0.54  0.71  0.49
## [3,]  0.67  0.70  1.00  0.47  0.49  0.71
## [4,]  0.71  0.54  0.47  1.00  0.76  0.67
## [5,]  0.54  0.71  0.49  0.76  1.00  0.70
## [6,]  0.47  0.49  0.71  0.67  0.70  1.00

Sequential p-value

IA 

seq_p_IA_H123 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H1, H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H12 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H1, H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H13 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H1, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H23 <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H1 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H1",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H2 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H3 <- calc_seq_p(
  test_analysis = 1,
  test_hypothesis = "H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ),
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)
seq_p_IA_H123_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H1, H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

seq_p_IA_H12_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H1, H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_IA_H13_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H1, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

seq_p_IA_H23_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

seq_p_IA_H1_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H1",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

seq_p_IA_H2_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

seq_p_IA_H3_B <- calc_seq_p(
  test_analysis = 1, # stage of interest
  test_hypothesis = "H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.3)
)

FA 

seq_p_FA_H123 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.15)
)

seq_p_FA_H12 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.15)
)

seq_p_FA_H13 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.15)
)

seq_p_FA_H23 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.15)
)

seq_p_FA_H1 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H2 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H3 <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 2,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = gsDesign::sfHSD,
  spending_fun_par = -4,
  info_frac = c(min(IF_IA), 1),
  interval = c(1e-4, 0.2)
)
seq_p_FA_H123_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H12_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H13_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H23_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H2, H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H1_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H1",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H2_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H2",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

seq_p_FA_H3_B <- calc_seq_p(
  test_analysis = 2, # stage of interest
  test_hypothesis = "H3",
  p_obs = tibble(
    analysis = 1:2,
    H1 = c(p_obs_IA[1], p_obs_FA[1]),
    H2 = c(p_obs_IA[2], p_obs_FA[2]),
    H3 = c(p_obs_IA[3], p_obs_FA[3])
  ), # observed p-value
  alpha_spending_type = 0,
  n_analysis = 2,
  initial_weight = w,
  transition_mat = m,
  z_corr = gs_corr,
  spending_fun = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
  spending_fun_par = list(-4, -4, -4),
  info_frac = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[2], 1)),
  interval = c(1e-4, 0.2)
)

Adjusted-Sequential p-value

IA 

adj_seq_IA_H1 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H13, seq_p_IA_H1)
adj_seq_IA_H2 <- max(seq_p_IA_H123, seq_p_IA_H12, seq_p_IA_H23, seq_p_IA_H2)
adj_seq_IA_H3 <- max(seq_p_IA_H123, seq_p_IA_H13, seq_p_IA_H23, seq_p_IA_H3)

cat("The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is", adj_seq_IA_H1, adj_seq_IA_H2, adj_seq_IA_H3, "\n")
## The adjusted-sequential p-value of H1, H2, H3 in IA via WPGSD is 0.1942576 0.1942576 0.1942576
adj_seq_IA_H1_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H13_B, seq_p_IA_H1_B)
adj_seq_IA_H2_B <- max(seq_p_IA_H123_B, seq_p_IA_H12_B, seq_p_IA_H23_B, seq_p_IA_H2_B)
adj_seq_IA_H3_B <- max(seq_p_IA_H123_B, seq_p_IA_H13_B, seq_p_IA_H23_B, seq_p_IA_H3_B)

cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_IA_H1_B, adj_seq_IA_H2_B, adj_seq_IA_H3_B, "\n")
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.2516717 0.2516717 0.2516717

FA

WPGSD 

adj_seq_FA_H1 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H13, seq_p_FA_H1)
adj_seq_FA_H2 <- max(seq_p_FA_H123, seq_p_FA_H12, seq_p_FA_H23, seq_p_FA_H2)
adj_seq_FA_H3 <- max(seq_p_FA_H123, seq_p_FA_H13, seq_p_FA_H23, seq_p_FA_H3)

cat("The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is", adj_seq_FA_H1, adj_seq_FA_H2, adj_seq_FA_H3, "\n")
## The adjusted-sequential p-value of H1, H2, H3 in FA via WPGSD is 0.02096985 0.02096985 0.02067307
adj_seq_FA_H1_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H13_B, seq_p_FA_H1_B)
adj_seq_FA_H2_B <- max(seq_p_FA_H123_B, seq_p_FA_H12_B, seq_p_FA_H23_B, seq_p_FA_H2_B)
adj_seq_FA_H3_B <- max(seq_p_FA_H123_B, seq_p_FA_H13_B, seq_p_FA_H23_B, seq_p_FA_H3_B)

cat("The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is", adj_seq_FA_H1_B, adj_seq_FA_H2_B, adj_seq_FA_H3_B, "\n")
## The adjusted-sequential p-value of H1, H2, H3 in FA via weighted Bonferroni is 0.0265823 0.0265823 0.0265823

Summary 

ans <- tribble(
  ~Analysis, ~Hypothesis, ~`Sequential p-values of WPGSD`, ~`Sequential p-values of Weighted Bonferroni`, ~`Adjusted-sequential p-values of WPGSD`, ~`Adjusted-sequential p-values of Weighted Bonferroni`,
  "IA", "H123", seq_p_IA_H123, seq_p_IA_H123_B, NA, NA,
  "IA", "H12", seq_p_IA_H12, seq_p_IA_H12_B, NA, NA,
  "IA", "H13", seq_p_IA_H13, seq_p_IA_H13_B, NA, NA,
  "IA", "H23", seq_p_IA_H23, seq_p_IA_H23_B, NA, NA,
  "IA", "H1", seq_p_IA_H1, seq_p_IA_H1_B, adj_seq_IA_H1, adj_seq_IA_H1_B,
  "IA", "H2", seq_p_IA_H2, seq_p_IA_H2_B, adj_seq_IA_H2, adj_seq_IA_H2_B,
  "IA", "H3", seq_p_IA_H3, seq_p_IA_H3_B, adj_seq_IA_H3, adj_seq_IA_H3_B,
  "FA", "H123", seq_p_FA_H123, seq_p_FA_H123_B, NA, NA,
  "FA", "H12", seq_p_FA_H12, seq_p_FA_H12_B, NA, NA,
  "FA", "H13", seq_p_FA_H13, seq_p_FA_H13_B, NA, NA,
  "FA", "H23", seq_p_FA_H23, seq_p_FA_H23_B, NA, NA,
  "FA", "H1", seq_p_FA_H1, seq_p_FA_H1_B, adj_seq_FA_H1, adj_seq_FA_H1_B,
  "FA", "H2", seq_p_FA_H2, seq_p_FA_H2_B, adj_seq_FA_H2, adj_seq_FA_H2_B,
  "FA", "H3", seq_p_FA_H3, seq_p_FA_H3_B, adj_seq_FA_H3, adj_seq_FA_H3_B
)

ans %>%
  select(
    Analysis, Hypothesis,
    `Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`,
    `Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`
  ) %>%
  gt() %>%
  tab_spanner(
    label = "Weighted Bonferroni",
    columns = c(`Sequential p-values of Weighted Bonferroni`, `Adjusted-sequential p-values of Weighted Bonferroni`)
  ) %>%
  tab_spanner(
    label = "WPGSD",
    columns = c(`Sequential p-values of WPGSD`, `Adjusted-sequential p-values of WPGSD`)
  ) %>%
  tab_style_body(
    columns = where(is.numeric),
    style = cell_fill(color = "pink"),
    fn = function(x) x <= 0.025
  ) %>%
  fmt_number(columns = 3:6, decimals = 4) %>%
  tab_header(
    title = "(Adjusted-) sequential p-values",
    subtitle = "Multiple populations"
  ) # %>% as_latex()
(Adjusted-) sequential p-values
Multiple populations
Analysis Hypothesis Weighted Bonferroni WPGSD
Sequential p-values of Weighted Bonferroni Adjusted-sequential p-values of Weighted Bonferroni Sequential p-values of WPGSD Adjusted-sequential p-values of WPGSD
IA H123 0.2517 NA 0.1943 NA
IA H12 0.1678 NA 0.1400 NA
IA H13 0.1762 NA 0.1553 NA
IA H23 0.1762 NA 0.1529 NA
IA H1 0.1678 0.2517 0.1678 0.1943
IA H2 0.0839 0.2517 0.0839 0.1943
IA H3 0.1007 0.2517 0.1007 0.1943
FA H123 0.0266 NA 0.0207 NA
FA H12 0.0255 NA 0.0210 NA
FA H13 0.0186 NA 0.0165 NA
FA H23 0.0186 NA 0.0162 NA
FA H1 0.0159 0.0266 0.0159 0.0210
FA H2 0.0127 0.0266 0.0127 0.0210
FA H3 0.0106 0.0266 0.0106 0.0207