Adjusted Sequential p-values
+ + + +
+
+Introduction
+This vignette demonstrates the calculation of adjusted sequential +p-values for multiple populations in a group sequential trial design. +We’ll show a streamlined approach using helper functions to reduce code +repetition while maintaining technical accuracy. The methods implemented +in this vignette are based on the work by Zhao et +al. (2025). The end result is a adjusted p-value at both interim +and final analysis for each hypothesis tested. In all cases, this +adjusted p-value can be compared to the family-wise error rate (FWER) +for the trial simplifying interpretation by adjusting for multiplicity +created by testing multiple hypotheses at group sequential analyses.
+ +
+
+Example Overview
+In a 2-arm controlled clinical trial with one primary endpoint, there +are 3 null hypotheses based on populations defined defined by biomarker +status. In each case the null hypothesis assumes no difference in the +distribution of the time until a primary endpoint is reached between the +treatment and control groups:
+-
+
- H1: Biomarker A positive population
+
+ - H2: Biomarker B positive population +
- H3: Overall population +
+
+
+Multiplicity Strategy
+We will use a graphical approach to visualize the multiplicity +strategy.
+# Transition matrix and initial weights
+m <- matrix(c(
+ 0, 3/7, 4/7,
+ 3/7, 0, 4/7,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+
+# Visualize strategy
+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
+
+
+
+
+Study Setup
+We assume 2 analyses: an interim analysis (IA) and a final analysis +(FA). For the multiplicity adjustments, we need the number of events in +the treatment and control groups combined that are available for testing +each hypothesis at both analyses for each population and the +intersection of populations. In the following AB positive means positive +for both biomarker A and biomarker B.
+# Create event data systematically
+create_event_data <- function() {
+ populations <- rep(c("A positive", "B positive", "AB positive", "overall"), 2)
+ analyses <- rep(c(1, 2), each = 4)
+ events <- c(100, 110, 80, 225, 200, 220, 160, 450) # IA, then FA
+
+ tibble(
+ population = populations,
+ analysis = analyses,
+ event = events
+ )
+}
+
+event_tbl <- create_event_data()
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Event Count by Population and Analysis")
+
+
+
+
+
+| Event Count by Population and Analysis | +||
| 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 |
We assume the following unadjusted p-values at each analysis for each +hypothesis.
+# Observed p-values
+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_pWe now have all the information we need to perform testing and +adjusting p-values.
+
+
+
+Information Fractions
+Next we calculate information fractions at interim and final +analyses. The final event count at each analysis is assumed to be the +planned count for each population.
+# Helper function to extract events
+get_events <- function(analysis_num, population_name) {
+ event_tbl %>%
+ filter(analysis == analysis_num, population == population_name) %>%
+ pull(event)
+}
+
+# Extract event counts
+events_IA <- event_tbl %>% filter(analysis == 1)
+events_FA <- event_tbl %>% filter(analysis == 2)
+
+a_pos_IA <- get_events(1, "A positive")
+b_pos_IA <- get_events(1, "B positive")
+ab_pos_IA <- get_events(1, "AB positive")
+overall_IA <- get_events(1, "overall")
+
+a_pos_FA <- get_events(2, "A positive")
+b_pos_FA <- get_events(2, "B positive")
+ab_pos_FA <- get_events(2, "AB positive")
+overall_FA <- get_events(2, "overall")
+
+# Calculate information fractions
+IF_IA <- c(
+ (a_pos_IA + overall_IA) / (a_pos_FA + overall_FA), # H1
+ (b_pos_IA + overall_IA) / (b_pos_FA + overall_FA), # H2
+ (ab_pos_IA + overall_IA) / (ab_pos_FA + overall_FA) # H3
+)
+
+tibble(
+ Hypothesis = c("H1", "H2", "H3"),
+ Information_Fraction = IF_IA
+) %>%
+ gt() %>%
+ tab_header(title = "Information Fractions at Interim Analysis") %>%
+ fmt_number(columns = 2, decimals = 3)
+
+
+
+
+
+| Information Fractions at Interim Analysis | +|
| Hypothesis | +Information_Fraction | +
|---|---|
| H1 | +0.500 |
| H2 | +0.500 |
| H3 | +0.500 |
+
+
+
+
+Correlation Matrix
+Now we can create a correlation matrix for all tests performed based +on the methods of Anderson et al. (2022) +(or Chen et al. (2021)).
+# Create correlation matrix using event intersections
+event_intersections <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ # Analysis 1 - Interim
+ 1, 1, 1, a_pos_IA,
+ 2, 2, 1, b_pos_IA,
+ 3, 3, 1, overall_IA,
+ 1, 2, 1, ab_pos_IA,
+ 1, 3, 1, a_pos_IA,
+ 2, 3, 1, b_pos_IA,
+ # Analysis 2 - Final
+ 1, 1, 2, a_pos_FA,
+ 2, 2, 2, b_pos_FA,
+ 3, 3, 2, overall_FA,
+ 1, 2, 2, ab_pos_FA,
+ 1, 3, 2, a_pos_FA,
+ 2, 3, 2, b_pos_FA
+)
+
+# Generate correlation from events
+correlation_matrix <- generate_corr(event_intersections)
+
+correlation_matrix %>%
+ round(3) %>%
+ knitr::kable(caption = "Correlation Matrix (6x6)")| H1_A1 | +H2_A1 | +H3_A1 | +H1_A2 | +H2_A2 | +H3_A2 | +
|---|---|---|---|---|---|
| 1.000 | +0.763 | +0.667 | +0.707 | +0.539 | +0.471 | +
| 0.763 | +1.000 | +0.699 | +0.539 | +0.707 | +0.494 | +
| 0.667 | +0.699 | +1.000 | +0.471 | +0.494 | +0.707 | +
| 0.707 | +0.539 | +0.471 | +1.000 | +0.763 | +0.667 | +
| 0.539 | +0.707 | +0.494 | +0.763 | +1.000 | +0.699 | +
| 0.471 | +0.494 | +0.707 | +0.667 | +0.699 | +1.000 | +
+
+
+Sequential P-value Calculations
+# Helper function for systematic calculations
+calculate_seq_p_systematic <- function(test_analysis, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) {
+
+ combinations <- c("H1, H2, H3", "H1, H2", "H1, H3", "H2, H3", "H1", "H2", "H3")
+
+ results <- map_dfr(combinations, ~ {
+ seq_p <- calc_seq_p(
+ test_analysis = test_analysis,
+ test_hypothesis = .x,
+ 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 = correlation_matrix,
+ spending_fun = gsDesign::sfHSD,
+ spending_fun_par = -4,
+ info_frac = c(min(IF_IA), 1),
+ interval = c(1e-4, 0.2)
+ )
+
+ tibble(
+ combination = .x,
+ sequential_p = seq_p
+ )
+ })
+
+ return(results)
+}
+
+# Calculate for both interim and final analyses
+ia_results <- calculate_seq_p_systematic(1, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) %>%
+ mutate(analysis = "Interim")
+
+fa_results <- calculate_seq_p_systematic(2, p_obs_IA, p_obs_FA, w, m, correlation_matrix, IF_IA) %>%
+ mutate(analysis = "Final")
+
+
+Results Summary
+# Combined results table
+combined_results <- bind_rows(ia_results, fa_results)
+
+combined_results %>%
+ gt() %>%
+ tab_header(title = "Sequential p-values - Comprehensive Results") %>%
+ fmt_number(columns = "sequential_p", decimals = 4) %>%
+ tab_style(
+ style = cell_fill(color = "lightblue"),
+ locations = cells_body(rows = analysis == "Interim")
+ ) %>%
+ tab_style(
+ style = cell_fill(color = "lightgreen"),
+ locations = cells_body(rows = analysis == "Final")
+ )
+
+
+
+
+
+| Sequential p-values - Comprehensive Results | +||
| combination | +sequential_p | +analysis | +
|---|---|---|
| H1, H2, H3 | +0.1943 | +Interim |
| H1, H2 | +0.1400 | +Interim |
| H1, H3 | +0.1553 | +Interim |
| H2, H3 | +0.1529 | +Interim |
| H1 | +0.1678 | +Interim |
| H2 | +0.0839 | +Interim |
| H3 | +0.1007 | +Interim |
| H1, H2, H3 | +0.0206 | +Final |
| H1, H2 | +0.0210 | +Final |
| H1, H3 | +0.0165 | +Final |
| H2, H3 | +0.0162 | +Final |
| H1 | +0.0159 | +Final |
| H2 | +0.0127 | +Final |
| H3 | +0.0106 | +Final |
+
+
+Adjusted Sequential P-values
+# Calculate adjusted sequential p-values (max over relevant combinations)
+calculate_adjusted <- function(results_df) {
+ h1_adj <- max(
+ results_df$sequential_p[results_df$combination == "H1, H2, H3"],
+ results_df$sequential_p[results_df$combination == "H1, H2"],
+ results_df$sequential_p[results_df$combination == "H1, H3"],
+ results_df$sequential_p[results_df$combination == "H1"]
+ )
+
+ h2_adj <- max(
+ results_df$sequential_p[results_df$combination == "H1, H2, H3"],
+ results_df$sequential_p[results_df$combination == "H1, H2"],
+ results_df$sequential_p[results_df$combination == "H2, H3"],
+ results_df$sequential_p[results_df$combination == "H2"]
+ )
+
+ h3_adj <- max(
+ results_df$sequential_p[results_df$combination == "H1, H2, H3"],
+ results_df$sequential_p[results_df$combination == "H1, H3"],
+ results_df$sequential_p[results_df$combination == "H2, H3"],
+ results_df$sequential_p[results_df$combination == "H3"]
+ )
+
+ tibble(
+ hypothesis = c("H1", "H2", "H3"),
+ adjusted_sequential_p = c(h1_adj, h2_adj, h3_adj)
+ )
+}
+
+# Calculate for both analyses
+ia_adjusted <- calculate_adjusted(ia_results) %>% mutate(analysis = "Interim")
+fa_adjusted <- calculate_adjusted(fa_results) %>% mutate(analysis = "Final")
+
+adjusted_results <- bind_rows(ia_adjusted, fa_adjusted)
+
+adjusted_results %>%
+ gt() %>%
+ tab_header(title = "Adjusted Sequential p-values") %>%
+ fmt_number(columns = "adjusted_sequential_p", decimals = 4) %>%
+ tab_style(
+ style = cell_fill(color = "pink"),
+ locations = cells_body(rows = adjusted_sequential_p <= 0.025)
+ )
+
+
+
+
+
+| Adjusted Sequential p-values | +||
| hypothesis | +adjusted_sequential_p | +analysis | +
|---|---|---|
| H1 | +0.1943 | +Interim |
| H2 | +0.1943 | +Interim |
| H3 | +0.1943 | +Interim |
| H1 | +0.0210 | +Final |
| H2 | +0.0210 | +Final |
| H3 | +0.0206 | +Final |
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/vignettes/corr_calculation.Rmd b/vignettes/corr_calculation.Rmd
index df67ae9..74ecebb 100644
--- a/vignettes/corr_calculation.Rmd
+++ b/vignettes/corr_calculation.Rmd
@@ -1,6 +1,6 @@
---
-title: "Correlated test statistics"
-author: "Chenguang Zhang, Yujie Zhao"
+title: "Correlated test statistics for "
+author: "Chenguang Zhang, Yujie Zhao and Keaven Anderson"
output:
rmarkdown::html_document:
toc: true
@@ -16,34 +16,44 @@ vignette: >
bibliography: wpgsd.bib
---
-The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure
+in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design.
+Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations,
+or due to common observations in the control arm.
# Methodologies to calculate correlations
-Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
+Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m},$ and there are $K$ analyses.
+Let $k=1,2,...K$ be the index for the interim analyses and final analyses.
+For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix.
-Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
-$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$.
+Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$.
+Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$.
+Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$.
+The key for the parametric tests is to utilize the correlation among the test statistics.
+The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
+$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}\times n_{i'k'}}}$$.
# Examples
-We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be:
+We borrow an Example 1 from @anderson2022unified here.
+Assume a two-arm controlled clinical trial with one primary endpoint and three patient populations defined by the status of two biomarkers, A and B:
-In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B:
+* Biomarker A positive (population 1),
+* Biomarker B positive (population 2),
+* Overall population (population 3).
-* Biomarker A positive, the population 1,
-* Biomarker B positive, the population 2,
-* Overall population.
+The 3 primary elementary null hypotheses are:
-The 3 primary elementary hypotheses are:
-
-* **H1**: the experimental treatment is superior to the control in the population 1
-* **H2**: the experimental treatment is superior to the control in the population 2
-* **H3**: the experimental treatment is superior to the control in the overall population
+* **H1**: the experimental treatment is no different than control in population 1
+* **H2**: the experimental treatment is no different than control in population 2
+* **H3**: the experimental treatment is no different than control in the overall population
-Assume an interim analysis and a final analysis are planned for the study. The number of events are listed as
+Assume an interim analysis and a final analysis are planned for the study.
+The number of events observed at each analysis in each population as well as the
+intersections of populations 1 and 2 to are assumed to be
```{r,message=FALSE}
library(dplyr)
library(tibble)
@@ -52,7 +62,7 @@ library(gt)
```{r}
event_tb <- tribble(
- ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ ~Population, ~"Number of Event at IA", ~"Number of Event at FA",
"Population 1", 100, 200,
"Population 2", 110, 220,
"Overlap of Population 1 and 2", 80, 160,
@@ -60,93 +70,52 @@ event_tb <- tribble(
)
event_tb %>%
gt() %>%
- tab_header(title = "Number of events at each population")
+ tab_header(title = "Number of events in each population")
```
-## Correlation of different populations within the same analysis
-Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$.
-The correlation matrix will be
-$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$
-The number of events are listed as
-```{r}
-event_tbl <- tribble(
- ~Population, ~"Number of Event in IA",
- "Population 1", 100,
- "Population 2", 110,
- "Overlap in population 1 and 2", 80
-)
-event_tbl %>%
- gt() %>%
- tab_header(title = "Number of events at each population in example 1")
-```
-The the corrleation could be simply calculated as
-$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$
-```{r}
-Corr1 <- 80 / sqrt(100 * 110)
-round(Corr1, 2)
-```
+## Correlation of tests for different populations at the same analysis
-## Correlation of different analyses within the same population
-Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
-The correlation matrix will be
-$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$
-The number of events are listed as
-```{r}
-event_tb2 <- tribble(
- ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
- "Population 1", 100, 200
-)
-event_tb2 %>%
- gt() %>%
- tab_header(title = "Number of events at each analyses in example 2")
-```
-The the corrleation could be simply calculated as
-$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$
-The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1.
-```{r}
-Corr1 <- 100 / sqrt(100 * 200)
-round(Corr1, 2)
-```
+Let's consider the situation at the interim analysis.
+The correlation between tests of H1 and H2 will be
+$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}\times n_{21}}}=\frac{80}{\sqrt{100\times 110}}=0.76.$$
-## Correlation of different analyses and different population
-Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
-The correlation matrix will be
-$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$
-The number of events are listed as
-```{r}
-event_tb3 <- tribble(
- ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
- "Population 1", 100, 200,
- "Population 2", 110, 220,
- "Overlap in population 1 and 2", 80, 160
-)
-event_tb3 %>%
- gt() %>%
- tab_header(title = "Number of events at each population & analyses in example 3")
-```
+The 80 in the numerator is the overlap number of events of population 1 and population 2 at the interim analysis.
-The correlation could be simply calculated as
-$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$
-The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis.
-```{r}
-Corr1 <- 80 / sqrt(100 * 220)
-round(Corr1, 2)
-```
+## Correlation for tests of the same population at different analyses
+
+We consider the correlation between tests for population 1 at the IA and FA.
+The correlation will thus be:
+$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}\times n_{12}}}=100/\sqrt{100\times 200}=0.71.$$
+
+## Correlation of tests at different analyses for different populations
+
+Next we consider the correlation between the tests of population 1 at the interim analysis and population 2 at the final analyses.
+The correlation will be
+$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}\times n_{22}}}=\frac{80}{\sqrt{100\times 220}}=0.54.$$
+The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis;
+i.e., the events in both populations 1 and 2 at the interim analysis.
+
+# Generate the correlation matrix by `s7_generate_corr()`
-# Generate the correlation matrix by `generate_corr()`
-Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function.
+Now we know how to calculate the correlation values under different situations, and the `s7_generate_corr()` function was built based on this logic.
+We can directly calculate the complete correlation matrix for all tests via the function.
-First, we need a event table including the information of the study.
+First, we need an event table including the event counts for testing individual hypotheses and pairwise intersection hypotheses for the study.
-- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2;
-- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis;
-- `Event` is the common events overlap by `H1` and `H2`.
+- `H1, H2` are each the index of a hypothesis. We will have the index for `H1` be $<=$ the index for `H2` to avoid duplication of pairs.
+- `Analysis` indicates which of sequentially indexed analyses, interim and final, is being referred to.
+- `Event` is the common number of events observed for testing both `H1` and `H2` at the specified `Analysis`.
-For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis.
+For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 events for comparing the experimental treatment to control
+at the interim analysis. Thus, when `H1=H2`, we are looking at the number of events used for testing the simple hypothesis specified in `H1=H2`.
-Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160.
+For testing an intersection hypothesis with `H1 != H2` and a given `Analysis` value, we are looking at the number of events that are used in testing both `H1` and `H2`.
+For our example above, if `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping
+cases for comparing the experimental treatment to the control in population 1 and 2 which is 160.
+
+The column names needed for input to `s7_generate_corr()` are `H1`, `H2`, `Analysis`, `Event`.
+We take the event counts from above accordingly.
-To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`.
```{r, message=FALSE}
library(wpgsd)
# The event table
@@ -165,15 +134,33 @@ event <- tibble::tribble(
1, 3, 2, 200,
2, 3, 2, 220
)
+```
-event %>%
- gt() %>%
- tab_header(title = "Number of events at each population & analyses")
+By specifying this as the S7 type `EventTable` we get input checks to ensure no missing values or inconsistencies.
+
+```{r}
+event <- as_event_table(event)
+event
```
-Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow.
+For human readability of the data table:
+
+```{r}
+event@data
+```
+
+Now we input the above event table to the function of `generate_corr_s7()`,
+and get the correlation matrix as follow.
+
+```{r}
+corr_mat <- generate_corr_s7(event)
+corr_mat
+```
+
+For human readability, we can format the correlation matrix as a table.
+
```{r}
-generate_corr(event)
+corr_mat@matrix
```
# References
diff --git a/vignettes/dunnett_dose.Rmd b/vignettes/dunnett_dose.Rmd
new file mode 100644
index 0000000..f2d0efd
--- /dev/null
+++ b/vignettes/dunnett_dose.Rmd
@@ -0,0 +1,589 @@
+---
+title: "Dunnett-type dose-finding with group sequential design"
+author: "Keaven Anderson"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_depth: 3
+ toc_float: true
+ code_folding: hide
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+bibliography: wpgsd.bib
+vignette: >
+ %\VignetteIndexEntry{Dunnett-type dose-finding with group sequential design}
+ %\VignetteEncoding{UTF-8}
+ %\VignetteEngine{knitr::rmarkdown}
+editor_options:
+ markdown:
+ wrap: 72
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+```
+
+```{r, message=FALSE, warning=FALSE}
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(dplyr)
+library(tibble)
+library(gt)
+```
+
+# Background
+
+A common clinical trial design compares multiple experimental dose
+groups against a shared control arm. This is known as a Dunnett-type
+design (@dunnett1955multiple). When combined with a group sequential
+design allowing interim analyses, the correlation between test
+statistics for different dose-versus-control comparisons arises
+naturally from the shared control arm.
+
+The weighted parametric group sequential design (WPGSD) approach
+(@anderson2022unified) exploits these known correlations to produce
+tighter efficacy bounds compared to the Bonferroni approach. This
+vignette demonstrates the WPGSD methodology for a trial with 2
+experimental dose groups versus a common control, using overall survival
+(OS) as the primary endpoint, with a group sequential design having two
+interim analyses and a final analysis ($K = 3$). Using $K > 2$ analyses
+exercises the full generality of the correlation computation formula.
+
+# Trial Setup
+
+## Hypotheses
+
+We consider 2 hypotheses, each comparing an experimental dose group to
+the common control:
+
+- $H_1$: Dose 1 vs. Control
+- $H_2$: Dose 2 vs. Control
+
+## Multiplicity Strategy
+
+We use equal initial weights ($w_i = 1/2$ for each hypothesis) and
+full transitions ($m_{12} = m_{21} = 1$). This symmetric strategy
+reflects no prior preference between doses.
+
+```{r, out.width="90%"}
+# Transition matrix: full transition between 2 hypotheses
+m <- matrix(c(0, 1, 1, 0), nrow = 2, byrow = TRUE)
+
+# Initial weights: equal allocation
+w <- c(1 / 2, 1 / 2)
+
+# Multiplicity graph
+cbPalette <- c("#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Dose 1 vs Control",
+ "H2: Dose 2 vs Control"
+)
+
+hplot <- hGraph(2,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ trhw = .2, trhh = .1,
+ digits = 4, trdigits = 4, size = 5, halfWid = 1.2,
+ halfHgt = 0.5, offset = 0.2, trprop = 0.35,
+ fill = as.factor(1:2),
+ palette = cbPalette,
+ wchar = "w"
+)
+hplot
+```
+
+## Event Counts
+
+We assume approximately balanced event counts across treatment arms
+with three analyses: two interim analyses (IA1 at ~30% information,
+IA2 at ~60% information) and a final analysis (FA). For OS, events
+are deaths observed in each dose-versus-control comparison.
+
+| Treatment Arm | Events at IA1 | Events at IA2 | Events at FA |
+|:-------------:|:-------------:|:-------------:|:------------:|
+| Dose 1 | 20 | 40 | 65 |
+| Dose 2 | 22 | 44 | 70 |
+| Control | 21 | 42 | 67 |
+
+Table: Number of events at each analysis for each treatment arm.
+IA1: first interim (~30% information). IA2: second interim (~60%
+information). FA: final analysis.
+
+The diagonal entries of the event table represent total events for each
+hypothesis (experimental arm + control), while off-diagonal entries
+represent events shared between two comparisons (control arm events
+only).
+
+```{r}
+# Event counts per arm
+# IA1: Dose 1=20, Dose 2=22, Control=21
+# IA2: Dose 1=40, Dose 2=44, Control=42
+# FA: Dose 1=65, Dose 2=70, Control=67
+
+# Event table: diagonal = experimental + control; off-diagonal = control only
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ # IA1 diagonal (total events per hypothesis = dose + control)
+ 1, 1, 1, 41, # Dose 1 (20) + Control (21)
+ 2, 2, 1, 43, # Dose 2 (22) + Control (21)
+ # IA1 off-diagonal (shared events = control only)
+ 1, 2, 1, 21,
+ # IA2 diagonal
+ 1, 1, 2, 82, # Dose 1 (40) + Control (42)
+ 2, 2, 2, 86, # Dose 2 (44) + Control (42)
+ # IA2 off-diagonal
+ 1, 2, 2, 42,
+ # FA diagonal
+ 1, 1, 3, 132, # Dose 1 (65) + Control (67)
+ 2, 2, 3, 137, # Dose 2 (70) + Control (67)
+ # FA off-diagonal
+ 1, 2, 3, 67
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count Table")
+```
+
+# Correlation Structure
+
+## Computing Correlations
+
+The correlation between test statistics follows the formula
+(@anderson2022unified):
+
+$$\text{Corr}(Z_{ik}, Z_{i'k'}) = \frac{n_{i \wedge i', k \wedge k'}}{\sqrt{n_{ik} \cdot n_{i'k'}}}$$
+
+where $n_{i \wedge i', k \wedge k'}$ denotes the number of events
+included in both $Z_{ik}$ and $Z_{i'k'}$.
+
+For the Dunnett-type design, the shared events between two different
+dose-versus-control comparisons at the same analysis are the control
+arm events. For example, at the first interim analysis:
+
+$$\text{Corr}(Z_{1,1}, Z_{2,1}) = \frac{n_{\text{control, IA1}}}{\sqrt{n_{1,1} \cdot n_{2,1}}} = \frac{21}{\sqrt{41 \cdot 43}} \approx 0.500$$
+
+With three analyses, the correlation matrix is $6 \times 6$ (2
+hypotheses $\times$ 3 analyses). This exercises the general
+correlation formula for all four cases:
+
+1. **Same hypothesis, same analysis**: $\text{Corr} = 1$
+2. **Same hypothesis, different analyses** ($k < k'$):
+ $\text{Corr}(Z_{i,k}, Z_{i,k'}) = \sqrt{n_{ik}/n_{ik'}}$
+3. **Different hypotheses, same analysis**:
+ $\text{Corr}(Z_{i,k}, Z_{i',k}) = n_{\text{control},k}/\sqrt{n_{ik} \cdot n_{i'k}}$
+4. **Different hypotheses, different analyses** ($k < k'$):
+ $\text{Corr}(Z_{i,k}, Z_{i',k'}) = n_{\text{control},k}/\sqrt{n_{ik} \cdot n_{i'k'}}$
+
+```{r}
+# Generate correlation matrix
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 3) %>%
+ tab_header(title = "Correlation Matrix (6 x 6)")
+```
+
+## Verification of Correlation Entries
+
+We manually verify key entries of the correlation matrix to confirm
+correctness for the 2-hypothesis, 3-analysis scenario.
+
+```{r}
+# --- Verification of key correlation entries ---
+
+# Case 1: Same hypothesis, same analysis -> should be 1.0
+cat("Corr(Z_1,1, Z_1,1) =", corr[1, 1], " (expected: 1.0)\n")
+
+# Case 2: Different hypotheses, same analysis (IA1)
+# Corr(Z_1,1, Z_2,1) = n_control_IA1 / sqrt(n_H1_IA1 * n_H2_IA1) = 21 / sqrt(41 * 43)
+expected_12_ia1 <- 21 / sqrt(41 * 43)
+cat(
+ "Corr(Z_1,1, Z_2,1) =", round(corr[1, 2], 6),
+ " (expected:", round(expected_12_ia1, 6), ")\n"
+)
+
+# Case 3: Different hypotheses, same analysis (FA)
+# Corr(Z_1,3, Z_2,3) = n_control_FA / sqrt(n_H1_FA * n_H2_FA) = 67 / sqrt(132 * 137)
+expected_12_fa <- 67 / sqrt(132 * 137)
+cat(
+ "Corr(Z_1,3, Z_2,3) =", round(corr[5, 6], 6),
+ " (expected:", round(expected_12_fa, 6), ")\n"
+)
+
+# Case 4: Same hypothesis, different analyses (IA1 vs IA2)
+# Corr(Z_1,1, Z_1,2) = sqrt(n_H1_IA1 / n_H1_IA2) = sqrt(41 / 82)
+expected_11_ia1_ia2 <- sqrt(41 / 82)
+cat(
+ "Corr(Z_1,1, Z_1,2) =", round(corr[1, 3], 6),
+ " (expected:", round(expected_11_ia1_ia2, 6), ")\n"
+)
+
+# Case 5: Same hypothesis, different analyses (IA1 vs FA)
+# Corr(Z_1,1, Z_1,3) = sqrt(n_H1_IA1 / n_H1_FA) = sqrt(41 / 132)
+expected_11_ia1_fa <- sqrt(41 / 132)
+cat(
+ "Corr(Z_1,1, Z_1,3) =", round(corr[1, 5], 6),
+ " (expected:", round(expected_11_ia1_fa, 6), ")\n"
+)
+
+# Case 6: Same hypothesis, different analyses (IA2 vs FA)
+# Corr(Z_1,2, Z_1,3) = sqrt(n_H1_IA2 / n_H1_FA) = sqrt(82 / 132)
+expected_11_ia2_fa <- sqrt(82 / 132)
+cat(
+ "Corr(Z_1,2, Z_1,3) =", round(corr[3, 5], 6),
+ " (expected:", round(expected_11_ia2_fa, 6), ")\n"
+)
+
+# Case 7: Different hypotheses, different analyses (IA1 vs IA2)
+# Corr(Z_1,1, Z_2,2) = n_control_IA1 / sqrt(n_H1_IA1 * n_H2_IA2) = 21 / sqrt(41 * 86)
+expected_12_ia1_ia2 <- 21 / sqrt(41 * 86)
+cat(
+ "Corr(Z_1,1, Z_2,2) =", round(corr[1, 4], 6),
+ " (expected:", round(expected_12_ia1_ia2, 6), ")\n"
+)
+
+# Case 8: Different hypotheses, different analyses (IA2 vs FA)
+# Corr(Z_1,2, Z_2,3) = n_control_IA2 / sqrt(n_H1_IA2 * n_H2_FA) = 42 / sqrt(82 * 137)
+expected_12_ia2_fa <- 42 / sqrt(82 * 137)
+cat(
+ "Corr(Z_1,2, Z_2,3) =", round(corr[3, 6], 6),
+ " (expected:", round(expected_12_ia2_fa, 6), ")\n"
+)
+
+# Case 9: Different hypotheses, different analyses (IA1 vs FA)
+# Corr(Z_2,1, Z_1,3) = n_control_IA1 / sqrt(n_H2_IA1 * n_H1_FA) = 21 / sqrt(43 * 132)
+expected_21_ia1_fa <- 21 / sqrt(43 * 132)
+cat(
+ "Corr(Z_2,1, Z_1,3) =", round(corr[2, 5], 6),
+ " (expected:", round(expected_21_ia1_fa, 6), ")\n"
+)
+```
+
+```{r}
+# Verify matrix is positive definite
+eigenvalues <- eigen(corr)$values
+cat("Eigenvalues:", round(eigenvalues, 6), "\n")
+cat("All positive:", all(eigenvalues > 0), "\n")
+```
+
+The correlation matrix for this 2-hypothesis, 3-analysis Dunnett
+scenario has the following structure:
+
+- **Same analysis, different hypotheses**: Correlation $\approx 0.50$,
+ driven by the shared control arm. With balanced arms, this
+ approaches $n_C / (n_C + n_E) \approx 0.5$ when $n_C \approx n_E$.
+- **Same hypothesis, adjacent analyses**: Correlation
+ $\approx 0.71$ (IA1 vs IA2) and $\approx 0.79$ (IA2 vs FA),
+ following $\sqrt{n_{ik}/n_{ik'}}$.
+- **Same hypothesis, non-adjacent analyses**: Correlation
+ $\approx 0.56$ (IA1 vs FA), demonstrating the general formula for
+ $K > 2$ analyses.
+- **Different hypotheses, different analyses**: Correlation
+ $\approx 0.35$ (IA1 vs IA2) and $\approx 0.40$ (IA2 vs FA),
+ combining both sources of correlation.
+
+# Futility Bounds
+
+We use `gsDesign` to compute common non-binding futility bounds at the
+interim analyses. These bounds apply equally to both dose arms. The
+futility bounds are based on a beta-spending approach using a
+Hwang-Shih-DeCani spending function.
+
+```{r}
+# Group sequential design with non-binding futility
+# Average information fraction across hypotheses at each analysis
+IF_avg <- c(
+ mean(c(41 / 132, 43 / 137)),
+ mean(c(82 / 132, 86 / 137)),
+ 1
+)
+
+gs_design <- gsDesign(
+ k = 3,
+ test.type = 4, # Non-binding futility
+ alpha = 0.025 / 2, # Per-hypothesis alpha (Bonferroni for single hypothesis)
+ beta = 0.1,
+ timing = IF_avg[1:2],
+ sfu = sfLDOF, # Lan-DeMets O'Brien-Fleming for efficacy
+ sfl = sfHSD, # HSD for futility
+ sflpar = -2
+)
+
+# Futility bounds (on p-value scale)
+futility_z <- gs_design$lower$bound
+futility_p <- pnorm(futility_z)
+
+cat("Information fractions:", round(IF_avg, 3), "\n")
+cat("Futility Z-bounds:", round(futility_z, 4), "\n")
+cat("Futility p-value bounds:", round(futility_p, 4), "\n")
+```
+
+```{r}
+# Display the gsDesign summary
+tibble(
+ Analysis = c("IA1", "IA2", "FA"),
+ `Information Fraction` = round(IF_avg, 3),
+ `Futility Z-bound` = round(gs_design$lower$bound, 4),
+ `Futility p-value` = round(pnorm(gs_design$lower$bound), 4)
+) %>%
+ gt() %>%
+ tab_header(title = "Non-binding Futility Bounds (Common Across Both Doses)")
+```
+
+The futility bound is applied as a common bar: at each interim
+analysis, any dose arm with a one-sided p-value exceeding the futility
+threshold may be dropped for futility. This is a non-binding bound,
+meaning it does not affect the Type I error control of the efficacy
+bounds.
+
+# Efficacy Bounds
+
+## Information Fractions
+
+Each hypothesis has its own information fraction based on the ratio of
+events at each analysis to the final analysis.
+
+```{r}
+# Information fractions for each hypothesis
+IF_H1 <- c(41 / 132, 82 / 132, 1)
+IF_H2 <- c(43 / 137, 86 / 137, 1)
+
+tibble(
+ Hypothesis = c("H1", "H2"),
+ `IF at IA1` = round(c(IF_H1[1], IF_H2[1]), 3),
+ `IF at IA2` = round(c(IF_H1[2], IF_H2[2]), 3),
+ `IF at FA` = 1
+) %>%
+ gt() %>%
+ tab_header(title = "Information Fractions")
+```
+
+## Bonferroni Bounds
+
+We first compute Bonferroni bounds (Type 0) as a reference, using
+Lan-DeMets O'Brien-Fleming spending for each hypothesis.
+
+```{r}
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 3, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF),
+ sfparm = list(0, 0),
+ t = list(IF_H1, IF_H2)
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:4, decimals = 6) %>%
+ tab_header(title = "Bonferroni Bounds (Type 0)")
+```
+
+## WPGSD Bounds
+
+We compute WPGSD bounds using $\alpha$-spending approach 2 (Type 3,
+separate spending per hypothesis), which applies an inflation factor
+$\xi$ to the Bonferroni nominal boundaries.
+
+```{r}
+set.seed(1234)
+
+# WPGSD bounds with separate alpha spending (Type 3)
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 3, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF),
+ sfparm = list(0, 0),
+ t = list(IF_H1, IF_H2)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:4, decimals = 6) %>%
+ tab_header(title = "WPGSD Bounds (Type 3, Separate Spending)")
+```
+
+## Comparison: Bonferroni vs. WPGSD
+
+```{r, echo=FALSE}
+# Combine bounds for comparison
+bounds_compare <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds_compare %>%
+ gt() %>%
+ fmt_number(columns = where(is.numeric), decimals = 6) %>%
+ tab_header(title = "Bonferroni vs. WPGSD Bounds")
+```
+
+The WPGSD bounds are less conservative than the Bonferroni bounds
+because they account for the positive correlation induced by the shared
+control arm. With 2 dose groups sharing a common control, the
+correlations within the same analysis are substantial (~0.50), and the
+WPGSD approach provides a meaningful improvement.
+
+# Combined Efficacy and Futility Summary
+
+```{r}
+# Extract elementary hypothesis bounds at each analysis for both methods
+elementary_hyps <- c("H1", "H2")
+
+# Get WPGSD bounds for elementary hypotheses
+wpgsd_elem <- bound_WPGSD %>%
+ filter(Hypotheses %in% elementary_hyps)
+
+bonf_elem <- bound_Bonf %>%
+ filter(Hypotheses %in% elementary_hyps)
+
+# Summary table
+summary_tbl <- tibble(
+ Hypothesis = rep(elementary_hyps, each = 3),
+ Analysis = rep(c("IA1", "IA2", "FA"), 2),
+ `Bonferroni p-bound` = NA_real_,
+ `WPGSD p-bound` = NA_real_,
+ `Futility p-bound` = NA_real_
+)
+
+for (i in seq_along(elementary_hyps)) {
+ h <- elementary_hyps[i]
+ bonf_row <- bonf_elem %>% filter(Hypotheses == h)
+ wpgsd_row <- wpgsd_elem %>% filter(Hypotheses == h)
+
+ for (k in 1:3) {
+ row_idx <- (i - 1) * 3 + k
+ summary_tbl$`Bonferroni p-bound`[row_idx] <- as.numeric(bonf_row[bonf_row$Analysis == k, h])
+ summary_tbl$`WPGSD p-bound`[row_idx] <- as.numeric(wpgsd_row[wpgsd_row$Analysis == k, h])
+ if (k <= 2) {
+ summary_tbl$`Futility p-bound`[row_idx] <- futility_p[k]
+ } else {
+ summary_tbl$`Futility p-bound`[row_idx] <- NA
+ }
+ }
+}
+
+summary_tbl %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 6) %>%
+ sub_missing(missing_text = "-") %>%
+ tab_header(
+ title = "Combined Efficacy and Futility Bounds",
+ subtitle = "Futility applied as common non-binding bars at interim analyses"
+ )
+```
+
+# Closed Testing
+
+We demonstrate the closed testing procedure with hypothetical observed
+p-values. Suppose at IA1 we see a strong signal for Dose 2 but not
+Dose 1. At IA2 both doses show improvement. At the final analysis,
+Dose 2 confirms strong efficacy.
+
+```{r}
+# Observed p-values (hypothetical)
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2,
+ 1, 0.20, 0.004,
+ 2, 0.05, 0.002,
+ 3, 0.02, 0.001
+)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:3, decimals = 6, drop_trailing_zeros = TRUE) %>%
+ tab_header(title = "Observed Nominal p-Values")
+```
+
+```{r}
+# Apply closed testing procedure
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results (WPGSD)")
+```
+
+```{r}
+# Compare with Bonferroni closed testing
+test_result_bonf <- closed_test(bound_Bonf, p_obs)
+
+test_result_bonf %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results (Bonferroni)")
+```
+
+## Futility Assessment
+
+At each interim analysis, we also check each dose against the common
+futility bar:
+
+```{r}
+# Futility assessment at IA1 and IA2
+futility_check <- tibble(
+ Hypothesis = rep(c("H1", "H2"), 2),
+ Analysis = rep(c("IA1", "IA2"), each = 2),
+ `Observed p` = c(0.20, 0.004, 0.05, 0.002),
+ `Futility bound` = rep(futility_p[1:2], each = 2),
+ `Drop for futility?` = ifelse(
+ c(0.20, 0.004, 0.05, 0.002) > rep(futility_p[1:2], each = 2),
+ "Yes", "No"
+ )
+)
+
+futility_check %>%
+ gt() %>%
+ fmt_number(columns = 3:4, decimals = 4) %>%
+ tab_header(
+ title = "Futility Assessment at Interim Analyses",
+ subtitle = "Common non-binding futility threshold at each interim"
+ )
+```
+
+# Discussion
+
+This vignette demonstrates the WPGSD approach for a Dunnett-type
+dose-finding trial with 2 experimental arms versus a common control
+and 3 analyses (2 interims + final). Key observations:
+
+1. **Correlation structure**: The shared control arm induces positive
+ correlations of approximately 0.50 between test statistics for
+ different dose-versus-control comparisons at the same analysis.
+ This correlation is substantial and directly exploitable by the
+ WPGSD approach.
+
+2. **Three analyses**: Using $K = 3$ analyses demonstrates the full
+ generality of the correlation formula. The within-hypothesis
+ correlations across non-adjacent analyses (e.g., IA1 vs. FA)
+ are correctly computed as $\sqrt{n_{ik}/n_{ik'}}$, and the
+ cross-hypothesis, cross-analysis correlations use the shared
+ events at the earlier analysis.
+
+3. **Bound improvement**: The WPGSD bounds are less conservative than
+ Bonferroni bounds, providing increased nominal significance levels
+ at all three analyses. This gain comes at no cost to FWER control.
+
+4. **Futility**: Common non-binding futility bounds are computed
+ externally via `gsDesign` with $K = 3$ and applied as screening
+ criteria at each interim analysis. Since the futility bounds are
+ non-binding, they do not affect the WPGSD efficacy bounds or FWER
+ control.
+
+5. **Closed testing**: The closed testing procedure is necessary for
+ FWER control. With 2 hypotheses, there are $2^2 - 1 = 3$
+ intersection hypotheses to evaluate, making the procedure
+ straightforward.
+
+# References
diff --git a/vignettes/wpgsd.Rmd b/vignettes/wpgsd.Rmd
index 4771094..6c9e1aa 100644
--- a/vignettes/wpgsd.Rmd
+++ b/vignettes/wpgsd.Rmd
@@ -42,19 +42,28 @@ library(gt)
# Background
-The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation
+structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design.
+Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations,
+or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
# Methods and Examples
## Closed Testing and Parametric Tests
-We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
+We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$.
+The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$.
+Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected.
+Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
## Consonance
-A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
+A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies
+that at least one elementary hypothesis $H_i, i \in I$, is rejected.
+Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original
+closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
-## Group Sequential Design Notations and Assumptions
+## Group Sequential Design Notation and Assumptions
- A set $I$ of hypotheses for $i \in I$.
- $K$ group sequential analyses, $k = 1, \ldots, K$
@@ -65,13 +74,15 @@ A closed procedure is called consonant if the rejection of the complete intersec
## Correlation Structure
- Notation
- * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$.
+ * Events for individual hypothesis $H_i$, $i \in I$ at analysis $k$ denoted by $n_{ik}$.
* Assume the same endpoint for all hypotheses (can be relaxed)
* For binary or continuous outcomes $n_{ik}$ represents sample size
* $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$
- * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$.
+ * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i \in I$, $1 \leq k \leq K$.
- Key result
- $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$
+
+ $$\hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}}$$
+
- Proof builds on standard group sequential theory (@chen2021multiplicity)
## Example 1: Overlapping Populations, Two Analyses
@@ -277,18 +288,18 @@ Table: Weighting strategy of Example 2.
The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed:
-- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
+- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J \subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
-- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$.
+- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J) = f(t_k(J), \alpha(J))$ for $1 \leq k \leq K$ for all intersection hypotheses $J \subseteq I$.
-- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$.
+- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i = 1, 2, \ldots, m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik}, \gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J) \alpha)$.
## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis)
- Assume ($Z_1,Z_2$) bivariate normal with known correlation
- Find $\alpha$-inflation factor $c_J$ such that
- $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$
+ $$ \alpha = P\left[\cup_{i \in J} \{p_i \leq c_J w_{J,i} \alpha\}\right] = P\left[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1 - c_J w_{J,i} \alpha)\}\right]$$
- Basic algorithm code in @bretz2011graphical
@@ -300,7 +311,7 @@ The WPGSD approach uses all known correlations between tests in the study. This
i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$.
- ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$.
+ ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*}(J))$, $i \in J$.
iii Compute type I error rate up to analysis $k$
$$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$
@@ -308,7 +319,7 @@ The WPGSD approach uses all known correlations between tests in the study. This
iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
$$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$
- v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
+ v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J) = 1 - \Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020).
@@ -325,7 +336,7 @@ The WPGSD approach uses all known correlations between tests in the study. This
iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
$$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$
- iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
+ iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J) = \xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020).
@@ -396,7 +407,8 @@ corr %>%
tab_header(title = "Correlation Matrix")
```
-Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type.
+Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses.
+Of note, `generate_bounds()` input `type` specifies boundary type.
- 0 = Bonferroni. Separate alpha spending for each hypotheses.
- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
@@ -421,7 +433,8 @@ bound_Bonf %>%
tab_header(title = "Bonferroni bounds")
```
-Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions.
+Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending.
+Here spending time was defined as minimum of the 3 observed information fractions.
```{r}
set.seed(1234)
@@ -440,7 +453,8 @@ bound_WPGSD %>%
tab_header(title = "WPGSD bounds")
```
-Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
+Below shows the comparison between the Bonferroni and WPGSD bounds.
+Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
```{r, echo=FALSE}
# Combine and back-calculate xi
@@ -581,11 +595,25 @@ bounds %>%
## Power Considerations
-The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development.
+The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage.
+At the design stage, one can take one of the following 2 options:
+
+1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate.
+At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or
+
+ 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the
+ minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure).
+ For example, for $H_2$ of example 1, this is $\min(0.0011, 0.0017, 0.0010, 0.0030) = 0.0010$ for $k = 1$ and
+ $\min(0.0092, 0.0144, 0.0081, 0.0238) = 0.0081$ for $k = 2$.
+ Then the $H_2$ bounds of $0.0010$ ($k = 1$) and $0.0081$ ($k = 2$) can be used to power $H_2$.
+This option is not currently supported in the package.
# Conclusions
-The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds
+The WPGSD approach provides a unification of previous work on parametric testing in group sequential design.
+It enabled more complex scenarios and requires attention to consonance and intersection hypotheses.
+Although detailed closed testing is required, this should not be a deterrent.
+The approach accommodates various spending approaches and provides more relaxed bounds
and improved power compared to the Bonferroni approach.
# References
diff --git a/vignettes/wpgsd.bib b/vignettes/wpgsd.bib
index 0285346..0cd9d7a 100644
--- a/vignettes/wpgsd.bib
+++ b/vignettes/wpgsd.bib
@@ -9,6 +9,17 @@ @article{anderson2022unified
publisher = {Wiley Online Library}
}
+@article{dunnett1955multiple,
+ title = {A multiple comparison procedure for comparing several treatments with a control},
+ author = {Dunnett, Charles W},
+ journal = {Journal of the American Statistical Association},
+ volume = {50},
+ number = {272},
+ pages = {1096--1121},
+ year = {1955},
+ publisher = {Taylor \& Francis}
+}
+
@article{bretz2011graphical,
title = {Graphical approaches for multiple comparison procedures using weighted Bonferroni, Simes, or parametric tests},
author = {Bretz, Frank and Posch, Martin and Glimm, Ekkehard and Klinglmueller, Florian and Maurer, Willi and Rohmeyer, Kornelius},
@@ -50,4 +61,15 @@ @article{xi2017unified
pages = {918--931},
year = {2017},
publisher = {Wiley Online Library}
-}
\ No newline at end of file
+}
+
+@article{zhao2025adjusted,
+ title={Adjusted Inference for Multiple Testing Procedure in Group-Sequential Designs},
+ author={Zhao, Yujie and Liu, Qi and Sun, Linda Z and Anderson, Keaven M},
+ journal={Biometrical Journal},
+ volume={67},
+ number={1},
+ pages={e70020},
+ year={2025},
+ publisher={Wiley Online Library}
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION b/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION
new file mode 100644
index 0000000..f2d0d12
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/DESCRIPTION
@@ -0,0 +1,45 @@
+Package: wpgsd
+Title: Weighted Parametric Group Sequential Design
+Version: 0.1.0
+Authors@R: c(
+ person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = "aut"),
+ person("Zifang", "Guo", email = "zifang.guo@merck.com", role = "aut"),
+ person("Jing", "Zhao", email = "jing_zhaox@merck.com", role = "aut"),
+ person("Linda", "Sun", email = "linda_sun@merck.com", role = "aut"),
+ person("Yi", "Cui", email = "yi.cui@merck.com", role = "aut"),
+ person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role = c("aut", "cre")),
+ person("Larry", "Leon", email = "larry.leon2@merck.com", role = "aut"),
+ person("Merck Sharp & Dohme Corp", role = c("cph"))
+ )
+Description: Adjusted inference for weighted parametric group sequential design.
+ Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022)
+ Interpretation and Conclusions
+The systematic approach demonstrates:
+-
+
- Interim Analysis: Shows proper adjustment for +multiplicity and sequential testing +
- Final Analysis: Provides definitive conclusions +with Type I error control +
- Efficiency: Helper functions reduce code repetition +by ~80% while maintaining accuracy +
- Flexibility: Easy to modify for different +hypothesis combinations or parameters +
The adjusted sequential p-values account for both: - Multiple
+comparisons (across populations)
+- Sequential testing (interim and final analyses)
Results highlighted in pink indicate rejection at α = 0.025 +level.
+
+
+
+Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022.
+“A Unified Framework for Weighted Parametric Group Sequential
+Design.” Biometrical Journal 64 (7): 1219–39.
+
+
+Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021.
+“Multiplicity for a Group Sequential Trial with Biomarker
+Subpopulations.” Contemporary Clinical Trials 101:
+106249.
+
+
+Zhao, Yujie, Qi Liu, Linda Z Sun, and Keaven M Anderson. 2025.
+“Adjusted Inference for Multiple Testing Procedure in
+Group-Sequential Designs.” Biometrical Journal 67 (1):
+e70020.
+
+
+
+
+[](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml)
+[](https://app.codecov.io/gh/Merck/wpgsd?branch=main)
+
+
+Weighted parametric group sequential design (WPGSD) allows one to take advantage
+of the known correlation structure in constructing efficacy bounds to control
+family-wise error rate (FWER) for a group sequential design. Here correlation
+may be due to common observations in nested populations, due to common
+observations in overlapping populations, or due to common observations
+in the control arm.
+
+## Installation
+
+The easiest way to get wpgsd is to install from CRAN:
+
+```r
+install.packages("wpgsd")
+```
+
+Alternatively, to use a new feature or get a bug fix,
+you can install the development version of wpgsd from GitHub:
+
+```r
+# install.packages("remotes")
+remotes::install_github("Merck/wpgsd")
+```
+
+## Current limitations
+
+There are some limitations that are currently being addressed.
+Please use the package with caution in production environments.
+
+- The current implementation may have limitations when handling more
+ complex scenarios beyond what has been demonstrated.
+- The API is subject to potential breaking changes as it is currently
+ being reviewed and refactored.
+- Further validation is needed to ensure the reliability of the package.
+- More documentation is expected in the future releases.
+
+## References
+
+Anderson, K. M., Guo, Z., Zhao, J., & Sun, L. Z. (2022).
+A unified framework for weighted parametric group sequential design.
+_Biometrical Journal_, 64(7), 1219--1239.
+
+BibTeX entry:
+
+```
+@article{anderson2022unified,
+ title = {A unified framework for weighted parametric group sequential design},
+ author = {Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z},
+ journal = {Biometrical Journal},
+ volume = {64},
+ number = {7},
+ pages = {1219--1239},
+ year = {2022},
+ publisher = {Wiley Online Library}
+}
+```
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb
new file mode 100644
index 0000000..c78d6ee
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/partial.rdb differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds
new file mode 100644
index 0000000..5ec4d87
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/build/vignette.rds differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R
new file mode 100644
index 0000000..06fb2b6
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/event_table_integration.R
@@ -0,0 +1,71 @@
+# Example integration of EventTable S7 class with existing wpgsd functions
+# This shows how EventTable can work with generate_corr()
+
+library(wpgsd)
+library(tibble)
+
+# Example 1: Using EventTable with generate_corr()
+# Create event data using the EventTable class
+event_data_raw <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Create EventTable object
+event_table <- EventTable(data = event_data_raw)
+print("Created EventTable:")
+print(event_table)
+
+# Use with generate_corr (currently expects tibble/data.frame)
+# The @data slot extracts the underlying tibble
+correlation_matrix <- generate_corr(event_table@data)
+print("Generated correlation matrix:")
+print(correlation_matrix)
+
+# Example 2: Data validation before processing
+cat("\nExample 2: Data validation\n")
+cat("==========================\n")
+
+# Try to create EventTable with invalid data
+tryCatch({
+ invalid_data <- tibble::tibble(
+ H1 = c(1, 2, -1), # Invalid: negative hypothesis index
+ H2 = c(1, 2, 3),
+ Analysis = c(1, 1, 1),
+ Event = c(100, 200, 150)
+ )
+
+ invalid_table <- EventTable(data = invalid_data)
+}, error = function(e) {
+ cat("Validation caught error:", e$message, "\n")
+})
+
+# Example 3: Subsetting capabilities
+cat("\nExample 3: Subsetting\n")
+cat("=====================\n")
+
+# Get only first analysis
+analysis_1 <- subset_event_table(event_table, analysis = 1)
+cat("Analysis 1 events:\n")
+print(analysis_1@data)
+
+# Get only H1-H2 hypothesis pairs
+h1_h2_events <- subset_event_table(event_table, hypotheses = c(1, 2))
+cat("\nH1-H2 hypothesis events:\n")
+print(h1_h2_events@data)
+
+# Example 4: Summary information
+cat("\nExample 4: Summary\n")
+cat("==================\n")
+summary(event_table)
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R
new file mode 100644
index 0000000..d55ecbf
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/examples/test_event_table.R
@@ -0,0 +1,50 @@
+# Test script for EventTable S7 class
+# This demonstrates how to use the new EventTable class
+
+library(wpgsd)
+library(tibble)
+
+# Create sample event data as used in the package
+event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Create EventTable object
+event_table <- EventTable(data = event_data)
+
+# Print the object
+print(event_table)
+
+# Get summary
+summary(event_table)
+
+# Subset by analysis
+subset_analysis_1 <- subset_event_table(event_table, analysis = 1)
+print("Analysis 1 subset:")
+print(subset_analysis_1)
+
+# Subset by hypotheses
+subset_h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2))
+print("H1-H2 subset:")
+print(subset_h1_h2)
+
+# Convert existing tibble to EventTable
+converted_table <- as_event_table(event_data)
+print("Converted table:")
+print(converted_table)
+
+# Validate data
+validate_event_table_data(event_data)
+print("Data validation passed!")
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION
new file mode 100644
index 0000000..4cf24a4
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/CITATION
@@ -0,0 +1,12 @@
+bibentry(
+ "Article",
+ title = "A unified framework for weighted parametric group sequential design",
+ author = "Keaven M Anderson and Zifang Guo and Jing Zhao and Linda Z Sun",
+ journal = "Biometrical Journal",
+ volume = "64",
+ number = "7",
+ pages = "1219--1239",
+ year = "2022",
+ publisher = "Wiley Online Library",
+ doi = "10.1002/bimj.202100085",
+)
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt
new file mode 100644
index 0000000..6c9d599
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/compute_correlations_prompts.txt
@@ -0,0 +1,76 @@
+Three functions are defined here, one for checking input data (`check_event_data()`) and
+another for computing correlations (`compute_correlations()`) and one (`gen_corr()`) for transforming a data frame where correlations are computed
+to a correlation matrix.
+All three should be exported.
+When users enter the `event` input to `compute_correlations()`, it is advised to call `check_event_data()` first by
+specifying check = TRUE (the default).
+Output will be output either as a data frame or as a correlation matrix, as specified below.
+An exported function `gen_corr()` will do a transformation from the data frame output to a symmetric matrix.
+
+Let M > 1 be the integer number of hypotheses to be tested.
+Assume there are integer K > 1 analyses.
+Let real-valued Z[i, k] be the standardized normal test statistic for
+hypothesis i, 1 <= i <= M, analysis k, 1 <= k <= K.
+We wish to compute and return correlations for all hypothesis tests
+performed across analyses.
+For tests Z[i1, k1], Z[i2, k2], 1 <= i1 <= i2 <= M, 1 <= k1 <= k2 <= K that are
+performed we will provide the count of events (for time-to-event outcomes) or
+sample size (for other outcomes) that are common between the two tests.
+This is input in a data frame called `event`
+with the following columns:
+
+`H1` - hypothesis i1 = H1
+`H2` - hypothesis i2 = H2
+`Analysis` - value in 1,2,...,K
+`Event` - event count for time-to-event endpoints, otherwise sample size which
+is included in the both test Z[H1, Analysis] and Z[H2, Analysis].
+
+Other arguments for `compute_correlations()` are
+
+`check` - logical indicating whether to perform input checks using `check_event_data()` (default is TRUE)
+`return_matrix` - logical indicating whether to return a correlation matrix (default is TRUE)
+
+The function `check_event_data()` will have the argument `event` as specified above.
+Data checks in `check_event_data()` :
+- Check that `event` is a data frame and return an informative error message if not.
+- Check that columns specified above exist and return informative error message, if not.
+- Check that H1 <= H2 for each row and provide informative error message, if not.
+- Check that the combination of H1, H2, Analysis is a unique in the input;
+this should be evaluated and appropriate error message returned if not unique.
+Check that Event is an integer >= 0 for all rows and provide an
+appropriate error message, if not.
+- Check that unique values of Analysis are sequential positive integers with
+minimum value 1 and maximum value > 1; K from above will be the maximum value.
+Return an informative error message if any of these checks fail.
+- Check that unique values of H1 are sequential integers with minimum value 1
+and maximum value > 1; M from above will be the maximum value.
+Same for H2.
+Return an informative error message if any of these checks fail.
+- Check that for k=1,...,K that if there is a row with H1 < H2, then there is also a row with H1 == H2.
+Return an informative error message if not.
+- Check that for any value of Analysis, and H1 = i1 < H2 = i2 specified that there is also a row with H1 = i1, H2 = i1 and another with
+H1 = i2, H2 = i2. Return an informative error message if not.
+
+
+Returned value from `compute_correlations()`.
+The returned value either a data frame (if `return_matrix = FALSE`) or a correlation matrix, otherwise.
+The data frame has the following columns.
+ H1 - hypothesis i1
+ H2 - hypothesis i2 >= i1
+ Analysis1 - k1.
+ Analysis2 - k2 >= k1.
+ Correlation - correlation between Z[i1, k1] and Z[i2, k2].
+
+Correlation is computed as
+Event for i1, i2 and k1 divided by square root of the product of
+Event for H1 = i1, H2 = i1, Analysis = min(k1, k2) times
+Event for H1 = i2, H2 = i2, Analysis = k2.
+
+If `return_ matrix = TRUE` (default) then a symmetric matrix should be returned as follows.
+Columns should be named `H1_A1`, `H1_A2`, ..., `H1_AK`, `H2_A1`, `H2_A2`, ..., `H2_AK`, ..., `HM_A1`, `HM_A2`, ..., `HM_AK` where
+M and K are as computed from `event`.
+Rows should be labeled the same way.
+Diagonal elements are all 1.
+Off-diagonal elements are filled with the computed correlations.
+Only cells included should be where `Event` value was provided for the combination of Analysis, H1 and H2.
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md
new file mode 100644
index 0000000..69bae54
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/aiprompts/s7 prompts.md
@@ -0,0 +1,101 @@
+## Prompt for s7 Class conversion
+
+We want to convert the wpgsd R package to operate with s7 classes throughout.
+Please check for exported functions in the R directory suggest what s7 classes need to be developed.
+
+## Suggested S7 Classes for wpgsd Package Conversion
+
+Based on the exported functions and their data structures, here are the key S7 classes that should be developed:
+
+### 1. **EventTable Class**
+- **Purpose**: Represents event count data structure used in `generate_corr()` and `generate_event_table()`
+- **Key Fields**:
+ - `H1`, `H2`: Hypothesis indices
+ - `Analysis`: Analysis number
+ - `Event`: Event count
+- **Methods**: Validation, printing, subsetting
+
+### 2. **CorrelationMatrix Class**
+- **Purpose**: Represents correlation matrices returned by `generate_corr()`
+- **Key Fields**:
+ - `matrix`: The correlation matrix
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+ - `column_names`: Named columns (e.g., "H1_A1", "H2_A1", etc.)
+- **Methods**: Validation (positive definite), printing, subsetting
+
+### 3. **TransitionMatrix Class**
+- **Purpose**: Represents transition matrices used in graphical procedures
+- **Key Fields**:
+ - `matrix`: The transition matrix
+ - `n_hypotheses`: Number of hypotheses
+- **Methods**: Validation (row sums ≤ 1), printing
+
+### 4. **Bounds Class**
+- **Purpose**: Represents p-value boundaries from `generate_bounds()`
+- **Key Fields**:
+ - `data`: Tibble with Analysis, Hypotheses, H1, H2, etc., xi columns
+ - `type`: Boundary type (0, 1, 2, or 3)
+ - `alpha`: Overall alpha level
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+- **Methods**: Validation, printing, plotting
+
+### 5. **ObservedPValues Class**
+- **Purpose**: Represents observed p-values for `closed_test()`
+- **Key Fields**:
+ - `data`: Tibble with Analysis, H1, H2, etc. columns
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+- **Methods**: Validation, printing
+
+### 6. **ClosedTestResult Class**
+- **Purpose**: Represents results from `closed_test()`
+- **Key Fields**:
+ - `outcome_matrix`: Matrix summarizing testing results
+ - `bounds`: Associated bounds used
+ - `p_obs`: Observed p-values used
+ - `rejected_hypotheses`: List of rejected hypotheses by analysis
+- **Methods**: Validation, printing, summary
+
+### 7. **StudyDesign Class**
+- **Purpose**: High-level class to encapsulate entire study design
+- **Key Fields**:
+ - `initial_weights`: Vector of initial hypothesis weights
+ - `transition_matrix`: TransitionMatrix object
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of planned analyses
+ - `alpha`: Overall alpha level
+ - `spending_functions`: List of spending functions
+- **Methods**: Validation, printing, summary
+
+### 8. **SequentialPValue Class**
+- **Purpose**: Represents sequential p-values from `calc_seq_p()`
+- **Key Fields**:
+ - `value`: The sequential p-value
+ - `test_analysis`: Analysis index
+ - `test_hypothesis`: Hypothesis being tested
+ - `method_type`: Alpha spending type used
+- **Methods**: Validation, printing
+
+## Implementation Benefits
+
+1. **Type Safety**: S7 classes provide strong typing and validation
+2. **Method Dispatch**: Can implement specialized methods for each class
+3. **Consistency**: Standardized data structures across the package
+4. **User Experience**: Better error messages and documentation
+5. **Extensibility**: Easy to add new methods and functionality
+
+## Migration Strategy
+
+1. Start with core data structures (`EventTable`, `CorrelationMatrix`)
+2. Update `generate_corr()` to return `CorrelationMatrix` objects
+3. Update `generate_bounds()` to return `Bounds` objects
+4. Progressively convert other functions
+5. Ensure backward compatibility during transition
+6. Update documentation and vignettes
+
+This S7 class structure would provide a solid foundation for the wpgsd package while maintaining the existing functionality and improving the user experience with better type safety and method dispatch.
+
+Claude Sonnet 4 running under VSCode returned the following:
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R
new file mode 100644
index 0000000..63d7cc2
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.R
@@ -0,0 +1,739 @@
+## ----message = FALSE, warning = FALSE-----------------------------------------
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+
+## -----------------------------------------------------------------------------
+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,
+)
+
+## -----------------------------------------------------------------------------
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+# 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
+
+## -----------------------------------------------------------------------------
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+
+## ----wpgsdSeqIA, message=FALSE------------------------------------------------
+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)
+)
+
+## ----weightedBonferroniSeqIA, message=FALSE-----------------------------------
+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)
+)
+
+## ----wpgsdSeqFA, message=FALSE------------------------------------------------
+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)
+)
+
+## ----weightedBonferroniSeqFA, message=FALSE-----------------------------------
+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)
+)
+
+## ----wpgsdAdjSeqIA------------------------------------------------------------
+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")
+
+## ----weightedBonferroniAdjSeqIA-----------------------------------------------
+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")
+
+## ----wpgsdAdjSeqFA------------------------------------------------------------
+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")
+
+## ----weightedBonferroniAdjSeqFA-----------------------------------------------
+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")
+
+## -----------------------------------------------------------------------------
+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()
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd
new file mode 100644
index 0000000..df94c1c
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.Rmd
@@ -0,0 +1,810 @@
+---
+title: "Adjusted sequential p-values"
+author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+# bibliography: "example.bib"
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Adjusted sequential p-values}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- \item $H_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
+
+```{r}
+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
+
+```{r}
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+The information fraction of $H_1, H_2, H_3$ at IA is
+
+```{r}
+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
+```
+
+We assign the initial weights of $H_1, H_2, H_3$ as$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+# 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)
+```
+
+```{r}
+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
+
+```{r}
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+```
+
+# Sequential p-value
+
+## IA
+
+```{r, wpgsdSeqIA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqIA, message=FALSE}
+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
+
+```{r, wpgsdSeqFA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqFA, message=FALSE}
+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
+
+```{r, wpgsdAdjSeqIA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqIA}
+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")
+```
+
+## FA
+
+### WPGSD
+```{r, wpgsdAdjSeqFA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqFA}
+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")
+```
+
+# Summary
+
+```{r}
+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()
+```
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html
new file mode 100644
index 0000000..0236e45
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/adj-seq-p.html
@@ -0,0 +1,3399 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R
new file mode 100644
index 0000000..9b8c02d
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.R
@@ -0,0 +1,86 @@
+## ----message=FALSE------------------------------------------------------------
+library(dplyr)
+library(tibble)
+library(gt)
+
+## -----------------------------------------------------------------------------
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+
+## -----------------------------------------------------------------------------
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+
+## -----------------------------------------------------------------------------
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+
+## -----------------------------------------------------------------------------
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+
+## ----message=FALSE------------------------------------------------------------
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+
+## -----------------------------------------------------------------------------
+generate_corr(event)
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd
new file mode 100644
index 0000000..df67ae9
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.Rmd
@@ -0,0 +1,180 @@
+---
+title: "Correlated test statistics"
+author: "Chenguang Zhang, Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Correlated test statistics}
+bibliography: wpgsd.bib
+---
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+
+# Methodologies to calculate correlations
+
+Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
+
+We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix.
+
+Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
+$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$.
+
+# Examples
+
+We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be:
+
+In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B:
+
+* Biomarker A positive, the population 1,
+* Biomarker B positive, the population 2,
+* Overall population.
+
+The 3 primary elementary hypotheses are:
+
+* **H1**: the experimental treatment is superior to the control in the population 1
+* **H2**: the experimental treatment is superior to the control in the population 2
+* **H3**: 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. The number of events are listed as
+```{r,message=FALSE}
+library(dplyr)
+library(tibble)
+library(gt)
+```
+
+```{r}
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+```
+
+## Correlation of different populations within the same analysis
+Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$
+The number of events are listed as
+```{r}
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+```
+The the corrleation could be simply calculated as
+$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$
+```{r}
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses within the same population
+Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$
+The number of events are listed as
+```{r}
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+```
+The the corrleation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$
+The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1.
+```{r}
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses and different population
+Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$
+The number of events are listed as
+```{r}
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+```
+
+The correlation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$
+The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis.
+```{r}
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+```
+
+# Generate the correlation matrix by `generate_corr()`
+Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function.
+
+First, we need a event table including the information of the study.
+
+- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2;
+- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis;
+- `Event` is the common events overlap by `H1` and `H2`.
+
+For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis.
+
+Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160.
+
+To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`.
+```{r, message=FALSE}
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+```
+
+Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow.
+```{r}
+generate_corr(event)
+```
+
+# References
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html
new file mode 100644
index 0000000..28c00f5
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/corr_calculation.html
@@ -0,0 +1,4137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Adjusted sequential p-values
+Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson
+ +library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+
+1 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:
+-
+
- \(H_1\): the experimental treatment +is superior to the control in the biomarker A positive population; +
- \(H_2\): the experimental treatment +is superior to the control in the biomarker B positive population; +
- \(H_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_pThe information fraction of \(H_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.5We assign the initial weights of \(H_1, +H_2, H_3\) as\(\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 \(H_1\) is +rejected, then \(3/7\) local +significance level \(\alpha_1\) will be +propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_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
+
+2 Sequential p-value
+
+
+2.1 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)
+)
+
+2.2 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)
+)
+
+3 Adjusted-Sequential +p-value
+
+
+3.1 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.1942751 0.1942751 0.1942751adj_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
+
+3.2 FA
+
+
+3.2.1 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.02097944 0.02097944 0.02063497adj_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
+
+
+
+
+4 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.0206 | +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.0206 |
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R
new file mode 100644
index 0000000..81d0f9a
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.R
@@ -0,0 +1,477 @@
+## ----message = FALSE, warning = FALSE-----------------------------------------
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+
+## -----------------------------------------------------------------------------
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+
+## -----------------------------------------------------------------------------
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+## -----------------------------------------------------------------------------
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+
+## -----------------------------------------------------------------------------
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+
+## -----------------------------------------------------------------------------
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+
+## -----------------------------------------------------------------------------
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+
+## -----------------------------------------------------------------------------
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+
+## -----------------------------------------------------------------------------
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd
new file mode 100644
index 0000000..1eec9cb
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.Rmd
@@ -0,0 +1,599 @@
+---
+title: "Procedure to compute p-value boundaries by weighted Bonferroni"
+author: "Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- $H_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
+
+```{r}
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+```
+
+## Observed p-values
+
+```{r}
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+## Information fraction
+
+```{r}
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+```
+
+The information fraction of $H_1$, $H_2$, $H_3$ at IA is
+
+```{r}
+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
+```
+
+## Initial weight and transition matrix
+
+We assign the initial weights of $H_1$, $H_2$, $H_3$ as
+$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be
+propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected,
+then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+```
+
+```{r}
+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
+```
+
+```{r}
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+```
+
+```{r}
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+```
+
+## Correlations
+
+The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are
+
+```{r}
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+```
+
+# Boundary calculation
+
+## Boundary of $H_1$
+
+For the elementary hypothesis $H_1$, its weight is 1, namely,
+
+```{r}
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+```
+
+## Boundary of $H_2$
+
+For the elementary hypothesis $H_2$, its weight is 1, namely,
+
+```{r}
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_3$
+
+For the elementary hypothesis $H_3$, its weight is 1, namely,
+
+```{r}
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_2$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+```
+
+And the boundary for $H_1$ and $H_2$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+```
+
+And the boundary for $H_1$ and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_2 \cap H_3$
+
+For the interaction hypothesis $H_2 \cap H_3$, its weight is
+
+```{r}
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+```
+
+And the boundary for $H_2$ and $H_3$ are
+
+```{r}
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H1 \cap H_2 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+```
+
+And the boundary for $H_1$, $H_2$, and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+# Summary
+
+With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`.
+
+```{r}
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+```
+
+# Implementation in wpgsd
+
+The above results can be computed in one function call in wpgsd by using
+the `generate_bounds()` function as
+
+```{r}
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+```
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html
new file mode 100644
index 0000000..63b3a07
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/tech-detail-wb.html
@@ -0,0 +1,7117 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Correlated test statistics
+Chenguang Zhang, Yujie Zhao
+ +The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to +take advantage of the known correlation structure in constructing +efficacy bounds to control family-wise error rate (FWER) for a group +sequential design. Here correlation may be due to common observations in +nested populations, due to common observations in overlapping +populations, or due to common observations in the control arm.
+
+
+1 Methodologies to +calculate correlations
+Suppose that in a group sequential trial there are \(m\) elementary null hypotheses \(H_i\), \(i \in +I={1,...,m}\), and there are \(K\) analyses. Let \(k\) be the index for the interim analyses +and final analyses, \(k=1,2,...K\). For +any nonempty set \(J \subseteq I\), we +denote the intersection hypothesis \(H_J=\cap_{j \in J}H_j\). We note that \(H_I\) is the global null hypothesis.
+We assume the plan is for all hypotheses to be tested at each of the +\(k\) planned analyses if the trial +continues to the end for all hypotheses. We further assume that the +distribution of the \(m \times K\) +tests of \(m\) individual hypotheses at +all \(k\) analyses is multivariate +normal with a completely known correlation matrix.
+Let \(Z_{ik}\) be the standardized +normal test statistic for hypothesis \(i \in +I\), analysis \(1 \le k \le K\). +Let \(n_{ik}\) be the number of events +collected cumulatively through stage \(k\) for hypothesis \(i\). Then \(n_{i +\wedge i',k \wedge k'}\) is the number of events included +in both \(Z_{ik}\) and \(i\), \(i' \in +I\), \(1 \le k\), \(k' \le K\). The key of the parametric +tests to utilize the correlation among the test statistics. The +correlation between \(Z_{ik}\) and +\(Z_{i'k'}\) is \[Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge +i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}\].
+
+
+2 Examples
+We borrow an example from a paper by Anderson et al. (Anderson et al. (2022)), demonstrated in Section +2 - Motivating Examples, we use Example 1 as the basis here. The setting +will be:
+In a two-arm controlled clinical trial with one primary endpoint, +there are three patient populations defined by the status of two +biomarkers, A and B:
+-
+
- Biomarker A positive, the population 1, +
- Biomarker B positive, the population 2, +
- Overall population. +
The 3 primary elementary hypotheses are:
+-
+
- H1: the experimental treatment is superior to the +control in the population 1 +
- H2: the experimental treatment is superior to the +control in the population 2 +
- H3: 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. The number of events are listed as
+library(dplyr)
+library(tibble)
+library(gt)event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+
+
+
+
+
+| Number of events at each population | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
| Population 2 | +110 | +220 |
| Overlap of Population 1 and 2 | +80 | +160 |
| Overall Population | +225 | +450 |
+
+2.1 Correlation of +different populations within the same analysis
+Let’s consider a simple situation, we want to compare the population +1 and population 2 in only interim analyses. Then \(k=1\), and to compare \(H_{1}\) and \(H_{2}\), the \(i\) will be \(i=1\) and \(i=2\). The correlation matrix will be \[Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge +1}}{\sqrt{n_{11}*n_{21}}}\] The number of events are listed +as
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+
+
+
+
+
+| Number of events at each population in example 1 | +|
| Population | +Number of Event in IA | +
|---|---|
| Population 1 | +100 |
| Population 2 | +110 |
| Overlap in population 1 and 2 | +80 |
The the corrleation could be simply calculated as \[Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76\]
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)## [1] 0.76
+
+2.2 Correlation of +different analyses within the same population
+Let’s consider another simple situation, we want to compare single +population, for example, the population 1, but in different analyses, +interim and final analyses. Then \(i=1\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge +2}}{\sqrt{n_{11}*n_{12}}}\] The number of events are listed +as
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+
+
+
+
+
+| Number of events at each analyses in example 2 | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
The the corrleation could be simply calculated as \[\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71\] +The 100 in the numerator is the overlap number of events of interim +analysis and final analysis in population 1.
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)## [1] 0.71
+
+2.3 Correlation of +different analyses and different population
+Let’s consider the situation that we want to compare population 1 in +interim analyses and population 2 in final analyses. Then for different +population, \(i=1\) and \(i=2\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 +\wedge 2}}{\sqrt{n_{11}*n_{22}}}\] The number of events are +listed as
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+
+
+
+
+
+| Number of events at each population & analyses in example 3 | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
| Population 2 | +110 | +220 |
| Overlap in population 1 and 2 | +80 | +160 |
The correlation could be simply calculated as \[\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54\] +The 80 in the numerator is the overlap number of events of population 1 +in interim analysis and population 2 in final analysis.
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)## [1] 0.54
+3 Generate the
+correlation matrix by
+
+3 Generate the
+correlation matrix by generate_corr()
+Now we know how to calculate the correlation values under different
+situations, and the generate_corr() function was built
+based on this logic. We can directly calculate the results for each
+cross situation via the function.
First, we need a event table including the information of the +study.
+-
+
H1refers to one hypothesis, selected depending on the +interest, whileH2refers to the other hypothesis, both of +which are listed for multiplicity testing. For example,H1+means the experimental treatment is superior to the control in the +population 1/experimental arm 1;H2means the experimental +treatment is superior to the control in the population 2/experimental +arm 2;
+Analysismeans different analysis stages, for example, +1 means the interim analysis, and 2 means the final analysis;
+Eventis the common events overlap byH1+andH2.
+
For example: H1=1, H2=1,
+Analysis=1, Event=100indicates that in the
+first population, there are 100 cases where the experimental treatment
+is superior to the control in the interim analysis.
Another example: H1=1, H2=2,
+Analysis=2, Event=160 indicates that the
+number of overlapping cases where the experimental treatment is superior
+to the control in population 1 and 2 in the final analysis is 160.
To be noticed, the column names in this function are fixed to be
+H1, H2, Analysis,
+Event.
library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+
+
+
+
+
+| Number of events at each population & analyses | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +100 |
| 2 | +2 | +1 | +110 |
| 3 | +3 | +1 | +225 |
| 1 | +2 | +1 | +80 |
| 1 | +3 | +1 | +100 |
| 2 | +3 | +1 | +110 |
| 1 | +1 | +2 | +200 |
| 2 | +2 | +2 | +220 |
| 3 | +3 | +2 | +450 |
| 1 | +2 | +2 | +160 |
| 1 | +3 | +2 | +200 |
| 2 | +3 | +2 | +220 |
Then we input the above event table to the function of
+generate_corr(), and get the correlation matrix as
+follow.
generate_corr(event)## H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
+## [1,] 1.0000000 0.7627701 0.6666667 0.7071068 0.5393599 0.4714045
+## [2,] 0.7627701 1.0000000 0.6992059 0.5393599 0.7071068 0.4944132
+## [3,] 0.6666667 0.6992059 1.0000000 0.4714045 0.4944132 0.7071068
+## [4,] 0.7071068 0.5393599 0.4714045 1.0000000 0.7627701 0.6666667
+## [5,] 0.5393599 0.7071068 0.4944132 0.7627701 1.0000000 0.6992059
+## [6,] 0.4714045 0.4944132 0.7071068 0.6666667 0.6992059 1.0000000
+
+
+
+
+References
+
+
+
+Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022.
+“A Unified Framework for Weighted Parametric Group Sequential
+Design.” Biometrical Journal 64 (7): 1219–39.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R
new file mode 100644
index 0000000..8aea00b
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.R
@@ -0,0 +1,335 @@
+## ----include = FALSE----------------------------------------------------------
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+
+## ----message=FALSE, warning=FALSE---------------------------------------------
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+
+## ----eval=FALSE, echo=FALSE---------------------------------------------------
+# library(ggplot2)
+# library(ggforce)
+#
+# ellipse_data <- data.frame(
+# id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+# x = c(0, 1, 0.5),
+# y = c(0, 0, 0),
+# a = c(1, 1, 2),
+# b = c(0.5, 0.5, 1)
+# )
+#
+# ragg::agg_png(
+# "vignettes/figures/ex1-pop.png",
+# width = 1920,
+# height = 1920 / 1.618,
+# res = 96,
+# scaling = 2
+# )
+# ggplot() +
+# geom_ellipse(
+# aes(
+# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+# ),
+# data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+# color = NA, alpha = 0.5, show.legend = FALSE
+# ) +
+# geom_ellipse(
+# aes(
+# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+# ),
+# data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+# color = NA, alpha = 0.85, show.legend = FALSE
+# ) +
+# geom_text(aes(
+# x = x, y = y, label = id,
+# hjust = ifelse(id == "H1: Population 1", 1.1,
+# ifelse(id == "H2: Population 2", -0.1, 0.5)
+# ),
+# vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+# ), data = ellipse_data, size = 6) +
+# scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+# coord_fixed() +
+# theme_void()
+# dev.off()
+
+## ----echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"------------------
+knitr::include_graphics("figures/ex1-pop.png")
+
+## ----out.width="80%"----------------------------------------------------------
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+
+## ----out.width="80%", echo = FALSE--------------------------------------------
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+
+## -----------------------------------------------------------------------------
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+## -----------------------------------------------------------------------------
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+
+## -----------------------------------------------------------------------------
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+## -----------------------------------------------------------------------------
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+
+## -----------------------------------------------------------------------------
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+
+## ----echo=FALSE---------------------------------------------------------------
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
+## -----------------------------------------------------------------------------
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+
+## -----------------------------------------------------------------------------
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+
+## -----------------------------------------------------------------------------
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+## -----------------------------------------------------------------------------
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+## -----------------------------------------------------------------------------
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd
new file mode 100644
index 0000000..4771094
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.Rmd
@@ -0,0 +1,591 @@
+---
+title: "Quickstart guide"
+author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_depth: 3
+ toc_float: true
+ code_folding: hide
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+bibliography: wpgsd.bib
+vignette: >
+ %\VignetteIndexEntry{Quickstart guide}
+ %\VignetteEncoding{UTF-8}
+ %\VignetteEngine{knitr::rmarkdown}
+editor_options:
+ markdown:
+ wrap: 72
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+```
+
+```{r, message=FALSE, warning=FALSE}
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+```
+
+# Background
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
+
+# Methods and Examples
+
+## Closed Testing and Parametric Tests
+
+We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
+
+## Consonance
+
+A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
+
+## Group Sequential Design Notations and Assumptions
+
+- A set $I$ of hypotheses for $i \in I$.
+- $K$ group sequential analyses, $k = 1, \ldots, K$
+- Single endpoint
+ * Not required, and can be generalized
+- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$
+
+## Correlation Structure
+
+- Notation
+ * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$.
+ * Assume the same endpoint for all hypotheses (can be relaxed)
+ * For binary or continuous outcomes $n_{ik}$ represents sample size
+ * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$
+ * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$.
+- Key result
+ $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$
+- Proof builds on standard group sequential theory (@chen2021multiplicity)
+
+## Example 1: Overlapping Populations, Two Analyses
+
+Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified.
+
+```{r, eval=FALSE, echo=FALSE}
+library(ggplot2)
+library(ggforce)
+
+ellipse_data <- data.frame(
+ id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+ x = c(0, 1, 0.5),
+ y = c(0, 0, 0),
+ a = c(1, 1, 2),
+ b = c(0.5, 0.5, 1)
+)
+
+ragg::agg_png(
+ "vignettes/figures/ex1-pop.png",
+ width = 1920,
+ height = 1920 / 1.618,
+ res = 96,
+ scaling = 2
+)
+ggplot() +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+ color = NA, alpha = 0.5, show.legend = FALSE
+ ) +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+ color = NA, alpha = 0.85, show.legend = FALSE
+ ) +
+ geom_text(aes(
+ x = x, y = y, label = id,
+ hjust = ifelse(id == "H1: Population 1", 1.1,
+ ifelse(id == "H2: Population 2", -0.1, 0.5)
+ ),
+ vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+ ), data = ellipse_data, size = 6) +
+ scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+ coord_fixed() +
+ theme_void()
+dev.off()
+```
+
+```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"}
+knitr::include_graphics("figures/ex1-pop.png")
+```
+
+The multiplicity strategy is defined as follows.
+
+```{r, out.width="80%"}
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+```
+
+The event count of each hypothesis at each analysis is shown below.
+
+| Population | Number of Events at IA | Number of Events at FA |
+|:---------------------:|:----------------------:|:----------------------:|
+| Population 1 | 100 | 200 |
+| Population 2 | 110 | 220 |
+| Population 1 $\cap$ 2 | 80 | 160 |
+| Overall Population | 225 | 450 |
+
+Table: Number of events at each analysis for each population in Example 1.
+IA: interim analysis. FA: final analysis.
+
+The correlation matrix among test statistics is as follows.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ |
+| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ |
+| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ |
+| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ |
+| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ |
+| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 |
+
+Table: Correlation Matrix of Test Statistics for Example 1.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Example 2: Common Control, Two Analyses
+
+Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified.
+
+```{r, out.width="80%", echo = FALSE}
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+```
+
+| Treatment Arm | Number of Events at IA | Number of Events at FA |
+|:--------------:|:----------------------:|:----------------------:|
+| Experimental 1 | 70 | 135 |
+| Experimental 2 | 75 | 150 |
+| Experimental 3 | 80 | 165 |
+| Control | 85 | 170 |
+
+Table: Number of events at each analysis for each treatment arm in Example 2.
+IA: interim analysis. FA: final analysis.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ |
+| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ |
+| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ |
+| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ |
+| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ |
+| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 |
+
+Table: Correlation Matrix for Example 2.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Hypotheses Set
+
+These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 |
+| $H_1 \cap H_2$ | 0.5 | 0.5 | - |
+| $H_1 \cap H_3$ | 0.3 | - | 0.7 |
+| $H_2 \cap H_3$ | - | 0.3 | 0.7 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 1.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 |
+| $H_1 \cap H_2$ | 1/2 | 1/2 | - |
+| $H_1 \cap H_3$ | 1/2 | - | 1/2 |
+| $H_2 \cap H_3$ | - | 1/2 | 1/2 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 2.
+
+## $\alpha$ Spending: 3 approaches
+
+The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed:
+
+- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
+
+- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$.
+
+- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$.
+
+## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis)
+
+- Assume ($Z_1,Z_2$) bivariate normal with known correlation
+
+- Find $\alpha$-inflation factor $c_J$ such that
+ $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$
+
+- Basic algorithm code in @bretz2011graphical
+
+### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$.
+
+ ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$.
+
+ iii Compute type I error rate up to analysis $k$
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$
+
+ iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$
+
+ v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020).
+
+### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$.
+
+ ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$
+
+ iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$
+
+ iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020).
+
+## Implementation of Example 1 with Overlapping Populations
+
+We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows:
+
+- Analysis: Analysis number (1 for interim, 2 for final).
+- Event: Event counts.
+- H1, H2: Hypotheses intersected.
+ * (1, 1) represents counts for hypothesis 1
+ * (1, 2) for counts for the intersection of hypotheses 1 and 2
+
+```{r}
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+```
+
+Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests.
+
+```{r}
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type.
+
+- 0 = Bonferroni. Separate alpha spending for each hypotheses.
+- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+
+Compute Bonferroni bounds.
+
+```{r}
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+```
+
+Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions.
+
+```{r}
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+```
+
+Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
+
+```{r, echo=FALSE}
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+Closed testing procedure can then be performed using `closed_test()`.
+
+```{r}
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+```
+
+```{r}
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+```
+
+## Implementation of Example 2 with Common Control
+
+Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper.
+
+```{r}
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+```{r}
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+## Power Considerations
+
+The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development.
+
+# Conclusions
+
+The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds
+and improved power compared to the Bonferroni approach.
+
+# References
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html
new file mode 100644
index 0000000..7d0095d
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/doc/wpgsd.html
@@ -0,0 +1,7846 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Procedure to compute p-value boundaries by +weighted Bonferroni
+Yujie Zhao
+ +library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+
+1 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:
+-
+
- \(H_1\): the experimental treatment +is superior to the control in the biomarker A positive population; +
- \(H_2\): the experimental treatment +is superior to the control in the biomarker B positive population; +
- \(H_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
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+
+1.1 Observed +p-values
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ 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.006 | +2.512144 |
| H1 | +2 | +0.015 | +2.170090 |
| H2 | +2 | +0.012 | +2.257129 |
| H3 | +2 | +0.004 | +2.652070 |
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+1.2 Information +fraction
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)The information fraction of \(H_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
+
+1.3 Initial weight and +transition matrix
+We assign the initial weights of \(H_1\), \(H_2\), \(H_3\) as \(\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 +\(H_1\) is rejected, then \(3/7\) local significance level \(\alpha_1\) will be propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weightsname_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
# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+
+
+
+
+
+| Weight of all possible interaction hypothesis | +||
| H1 | +H2 | +H3 | +
|---|---|---|
| 1.0000000 | +NA | +NA |
| NA | +1.0000000 | +NA |
| 0.5000000 | +0.5000000 | +NA |
| NA | +NA | +1.0000000 |
| 0.4285714 | +NA | +0.5714286 |
| NA | +0.4285714 | +0.5714286 |
| 0.3000000 | +0.3000000 | +0.4000000 |
+
+1.4 Correlations
+The correlation of the 6 statistic (2 analyses \(\times\) 3 hypotheses) 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 80
+## 2 2 2 1 88
+## 3 3 3 1 180
+## 4 1 2 1 64
+## 5 1 3 1 80
+## 6 2 3 1 88
+## 7 1 1 2 160
+## 8 2 2 2 176
+## 9 3 3 2 360
+## 10 1 2 2 128
+## 11 1 3 2 160
+## 12 2 3 2 176# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+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
+
+2 Boundary +calculation
+
+
+2.1 Boundary of \(H_1\)
+For the elementary hypothesis \(H_1\), its weight is 1, namely,
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1 | +0.002980073 | +NA | +NA |
| 2 | +H1 | +0.023788266 | +NA | +NA |
+
+2.2 Boundary of \(H_2\)
+For the elementary hypothesis \(H_2\), its weight is 1, namely,
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H2 | +NA | +0.002980073 | +NA |
| 2 | +H2 | +NA | +0.023788266 | +NA |
ans <- rbind(ans, ans_new)
+
+2.3 Boundary of \(H_3\)
+For the elementary hypothesis \(H_3\), its weight is 1, namely,
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H3 | +NA | +NA | +0.002980073 |
| 2 | +H3 | +NA | +NA | +0.023788266 |
ans <- rbind(ans, ans_new)
+
+2.4 Boundary of \(H_1 \cap H_2\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12## [1] 0.5 0.5And the boundary for \(H_1\) and +\(H_2\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H2 | +0.001490037 | +0.001490037 | +NA |
| 2 | +H1, H2 | +0.011782800 | +0.011782800 | +NA |
ans <- rbind(ans, ans_new)
+
+2.5 Boundary of \(H_1 \cap H_3\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13## [1] 0.4285714 0.5714286And the boundary for \(H_1\) and +\(H_3\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H3 | +0.001277174 | +NA | +0.001702899 |
| 2 | +H1, H3 | +0.010079863 | +NA | +0.013489389 |
ans <- rbind(ans, ans_new)
+
+2.6 Boundary of \(H_2 \cap H_3\)
+For the interaction hypothesis \(H_2 \cap +H_3\), its weight is
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23## [1] 0.4285714 0.5714286And the boundary for \(H_2\) and +\(H_3\) are
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H2, H3 | +NA | +0.001277174 | +0.001702899 |
| 2 | +H2, H3 | +NA | +0.010079863 | +0.013489389 |
ans <- rbind(ans, ans_new)
+
+2.7 Boundary of \(H1 \cap H_2 \cap H_3\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123## [1] 0.3 0.3 0.4And the boundary for \(H_1\), \(H_2\), and \(H_3\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 |
ans <- rbind(ans, ans_new)
+
+3 Summary
+With the p-value boundaries, one can get the Z-statistics boundaries
+by qnorm().
ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+
+
+
+
+
+| p-values/Z-statistics boundaries of weighted Bonferroni | +|||||
| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +H1 Z-statistics boundary | +
|---|---|---|---|---|---|
| 1 | +H1 | +0.0029800731 | +NA | +NA | +NA |
| 1 | +H1, H2 | +0.0014900365 | +0.0014900365 | +NA | +NA |
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 | +3.037681 |
| 1 | +H1, H3 | +0.0012771742 | +NA | +0.001702899 | +2.928520 |
| 1 | +H2 | +NA | +0.0029800731 | +NA | +NA |
| 1 | +H2, H3 | +NA | +0.0012771742 | +0.001702899 | +2.928520 |
| 1 | +H3 | +NA | +NA | +0.002980073 | +2.749966 |
| 2 | +H1 | +0.0237882657 | +NA | +NA | +NA |
| 2 | +H1, H2 | +0.0117828003 | +0.0117828003 | +NA | +NA |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 | +2.349480 |
| 2 | +H1, H3 | +0.0100798631 | +NA | +0.013489389 | +2.211825 |
| 2 | +H2 | +NA | +0.0237882657 | +NA | +NA |
| 2 | +H2, H3 | +NA | +0.0100798631 | +0.013489389 | +2.211825 |
| 2 | +H3 | +NA | +NA | +0.023788266 | +1.981131 |
+
+
+
+
+4 Implementation in +wpgsd
+The above results can be computed in one function call in wpgsd by
+using the generate_bounds() function as
generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+
+
+
+
+
+| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0029800731 | +NA | +NA |
| 1 | +H1, H2 | +0.0014900365 | +0.0014900365 | +NA |
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 |
| 1 | +H1, H3 | +0.0012771742 | +NA | +0.001702899 |
| 1 | +H2 | +NA | +0.0029800731 | +NA |
| 1 | +H2, H3 | +NA | +0.0012771742 | +0.001702899 |
| 1 | +H3 | +NA | +NA | +0.002980073 |
| 2 | +H1 | +0.0237882657 | +NA | +NA |
| 2 | +H1, H2 | +0.0117828003 | +0.0117828003 | +NA |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 |
| 2 | +H1, H3 | +0.0100798631 | +NA | +0.013489389 |
| 2 | +H2 | +NA | +0.0237882657 | +NA |
| 2 | +H2, H3 | +NA | +0.0100798631 | +0.013489389 |
| 2 | +H3 | +NA | +NA | +0.023788266 |
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat
new file mode 100644
index 0000000..cb0d0a8
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adsl.sas7bdat differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adtte.sas7bdat b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adtte.sas7bdat
new file mode 100644
index 0000000..4c73e2e
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/inst/extdata/adtte.sas7bdat differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/calc_seq_p.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/calc_seq_p.Rd
new file mode 100644
index 0000000..b5a2dde
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/calc_seq_p.Rd
@@ -0,0 +1,101 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/calc_seq_p.R
+\name{calc_seq_p}
+\alias{calc_seq_p}
+\title{Calculate sequential p-values for interaction/elementary hypothesis}
+\usage{
+calc_seq_p(
+ test_analysis = 2,
+ test_hypothesis = "H1, H2, H3",
+ p_obs = tibble::tibble(analysis = 1:2, H1 = c(0.02, 0.0015), H2 = c(0.01, 0.01), H3 =
+ c(0.01, 0.004)),
+ alpha_spending_type = 2,
+ n_analysis = 2,
+ initial_weight = c(0.3, 0.3, 0.4),
+ transition_mat = matrix(c(0, 0.4285714, 0.5714286, 0.4285714, 0, 0.5714286, 0.5, 0.5,
+ 0), nrow = 3, byrow = TRUE),
+ z_corr = matrix(c(1, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, 0.7627701,
+ 1, 0.6992059, 0.5393599, 0.7071068, 0.4944132, 0.6666667, 0.6992059, 1, 0.4714045,
+ 0.4944132, 0.7071068, 0.7071068, 0.5393599, 0.4714045, 1, 0.7627701, 0.6666667,
+ 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1, 0.6992059, 0.4714045, 0.4944132,
+ 0.7071068, 0.6666667, 0.6992059, 1), nrow = 6, byrow = TRUE),
+ spending_fun = gsDesign::sfHSD,
+ spending_fun_par = -4,
+ info_frac = c(0.5, 1),
+ interval = c(1e-04, 0.2)
+)
+}
+\arguments{
+\item{test_analysis}{The index of the analysis to be tested, such as 1, 2, ...}
+
+\item{test_hypothesis}{A character of the tested interaction/elementary hypothesis,
+such as \code{"H1, H2, H3"}, \verb{H1, H2}, \code{"H1"}.}
+
+\item{p_obs}{Observed p-values up to \code{test_analysis}.}
+
+\item{alpha_spending_type}{Type Boundary type.
+\itemize{
+\item \code{0} - Bonferroni. Separate alpha spending for each hypotheses.
+\item \code{1} - Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+\item \code{2} - Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+\item \code{3} - Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+}}
+
+\item{n_analysis}{Total number of analysis.}
+
+\item{initial_weight}{Initial weight assigned to the elementary hypothesis.}
+
+\item{transition_mat}{Transition matrix.}
+
+\item{z_corr}{Correlation matrix of the Z statistics.}
+
+\item{spending_fun}{Spending function.}
+
+\item{spending_fun_par}{Parameter of the spending function.}
+
+\item{info_frac}{Information fractions.}
+
+\item{interval}{Interval to search the uniroot.}
+}
+\value{
+The sequential p-values of the \code{test_hypothesis} at the \code{test_analysis}.
+}
+\description{
+Calculate sequential p-values for interaction/elementary hypothesis
+}
+\examples{
+\donttest{
+calc_seq_p(
+ test_analysis = 2,
+ test_hypothesis = "H1, H2, H3",
+ p_obs = tibble::tibble(
+ analysis = 1:2,
+ H1 = c(0.02, 0.0015),
+ H2 = c(0.01, 0.01),
+ H3 = c(0.01, 0.004)
+ ),
+ alpha_spending_type = 2,
+ n_analysis = 2,
+ initial_weight = c(0.3, 0.3, 0.4),
+ transition_mat = matrix(c(
+ 0.0000000, 0.4285714, 0.5714286,
+ 0.4285714, 0.0000000, 0.5714286,
+ 0.5000000, 0.5000000, 0.0000000
+ ), nrow = 3, byrow = TRUE),
+ z_corr = matrix(
+ c(
+ 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045,
+ 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132,
+ 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068,
+ 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667,
+ 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059,
+ 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000
+ ),
+ nrow = 6, byrow = TRUE
+ ),
+ spending_fun = gsDesign::sfHSD,
+ spending_fun_par = -4,
+ info_frac = c(0.5, 1),
+ interval = c(1e-4, 0.2)
+)}
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/closed_test.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/closed_test.Rd
new file mode 100644
index 0000000..553315f
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/closed_test.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/closed_test.R
+\name{closed_test}
+\alias{closed_test}
+\title{Perform closed testing procedure}
+\usage{
+closed_test(bounds, p_obs)
+}
+\arguments{
+\item{bounds}{A tibble of nominal p-value boundaries from \code{\link[=generate_bounds]{generate_bounds()}}
+containing columns \code{Analysis}, \code{Hypotheses}, \code{H1}, \code{H2}, etc.}
+
+\item{p_obs}{A tibble of observed p-values containing columns
+\code{Analysis}, \code{H1}, \code{H2}, etc.}
+}
+\value{
+An outcome matrix summarizing the testing results.
+}
+\description{
+Perform closed testing procedure
+}
+\examples{
+p_obs <- dplyr::bind_rows(
+ tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001),
+ tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001)
+)
+bound <- tibble::tribble(
+ ~Analysis, ~Hypotheses, ~H1, ~H2,
+ 1, "H1", 0.02, NA,
+ 1, "H1, H2", 0.0001, 0.00001,
+ 1, "H2", NA, 0.003,
+ 2, "H1", 0.02, NA,
+ 2, "H1, H2", 0.02, 0.00001,
+ 2, "H2", NA, 0.003
+)
+
+closed_test <- closed_test(bound, p_obs)
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.png b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.png
new file mode 100644
index 0000000..cb5e55e
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.png differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.xcf b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.xcf
new file mode 100644
index 0000000..f9a63ed
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/figures/logo.xcf differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd
new file mode 100644
index 0000000..0a922b5
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_astar.Rd
@@ -0,0 +1,78 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/find_astar.R
+\name{find_astar}
+\alias{find_astar}
+\title{Utility function for root-finding to compute crossing probabilities
+with the overall alpha spending approach}
+\usage{
+find_astar(
+ a,
+ alpha_prev = NULL,
+ astar,
+ w,
+ sig,
+ maxpts = 50000,
+ abseps = 1e-05,
+ ...
+)
+}
+\arguments{
+\item{a}{Cumulative overall alpha spending up to current analysis.}
+
+\item{alpha_prev}{alpha boundary at previous interim analyses using
+the WPGSD approach.}
+
+\item{astar}{Total nominal alpha level at current analysis from
+the WPGSD approach.}
+
+\item{w}{Vector of alpha weights at current analysis.}
+
+\item{sig}{Correlation matrix of previous and current analyses test statistics.}
+
+\item{maxpts}{GenzBretz function maximum number of function values as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{...}{Additional arguments.}
+}
+\value{
+Difference. Should be 0 with \code{a} and \code{astar} identified.
+}
+\description{
+Utility function for root-finding to compute crossing probabilities
+with the overall alpha spending approach
+}
+\examples{
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_astar(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ astar = 1,
+ w = c(0.5, 0.5),
+ sig = my_corr[
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1"),
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1")
+ ]
+)
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd
new file mode 100644
index 0000000..0e33534
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/find_xi.Rd
@@ -0,0 +1,75 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/find_xi.R
+\name{find_xi}
+\alias{find_xi}
+\title{Utility function for root-finding to compute inflation factor xi
+with the separate alpha spending approach}
+\usage{
+find_xi(
+ a,
+ alpha_prev = NULL,
+ aprime,
+ xi,
+ sig,
+ maxpts = 50000,
+ abseps = 1e-05,
+ ...
+)
+}
+\arguments{
+\item{a}{Sum of cumulative alpha spending from the Bonferroni approach.}
+
+\item{alpha_prev}{alpha boundary at previous interim analyses using the MTP approach.}
+
+\item{aprime}{Nominal alpha boundary from the Bonferroni approach.}
+
+\item{xi}{Inflation factor.}
+
+\item{sig}{Correlation matrix of previous and current analyses test statistics.}
+
+\item{maxpts}{GenzBretz function maximum number of function values as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{...}{Additional arguments.}
+}
+\value{
+Difference. Should be 0 with \code{xi} identified.
+}
+\description{
+Utility function for root-finding to compute inflation factor xi
+with the separate alpha spending approach
+}
+\examples{
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_xi(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ xi = 1,
+ sig = my_corr[
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1"),
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1")
+ ]
+)
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd
new file mode 100644
index 0000000..53c1660
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_bounds.Rd
@@ -0,0 +1,135 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_bounds.R
+\name{generate_bounds}
+\alias{generate_bounds}
+\title{Compute p-value boundaries of the parametric MTP method with overall
+alpha spending for all hypotheses}
+\usage{
+generate_bounds(
+ type = 1,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ cum_alpha = NULL,
+ maxpts = 50000,
+ abseps = 1e-05,
+ tol = 1e-10,
+ sf = gsDesign::sfHSD,
+ sfparm = -4,
+ t = c(0.5, 1),
+ ...
+)
+}
+\arguments{
+\item{type}{Boundary type.
+\itemize{
+\item \code{0} = Bonferroni. Separate alpha spending for each hypotheses.
+\item \code{1} = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+\item \code{2} = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+\item \code{3} = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+}}
+
+\item{k}{Number of analyses up to the current analysis.}
+
+\item{w}{Initial weights.}
+
+\item{m}{Transition matrix.}
+
+\item{corr}{Correlation matrix of all test statistics up to the
+current analysis. dim = k * length(w).}
+
+\item{alpha}{Overall alpha.}
+
+\item{cum_alpha}{Cumulative alpha spent at each analysis.
+Only required for \code{type = 1}.}
+
+\item{maxpts}{GenzBretz function maximum number of function values
+as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{tol}{Find root tolerance.}
+
+\item{sf}{A list of alpha spending functions to spend alpha for
+each hypotheses.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{sf} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{sfparm}{A list of parameters to be supplied to sfs.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{sfparm} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{t}{A list of information fraction used for alpha spending,
+may be different from the actual information fraction.
+Each component corresponds to a hypothesis.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{t} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{...}{Additional arguments.}
+}
+\value{
+A tibble with \code{k * (2^(n_hypotheses - 1))} rows of
+p-value boundaries. Inflation factor is also provided if \code{type = 3}.
+}
+\description{
+Compute p-value boundaries of the parametric MTP method with overall
+alpha spending for all hypotheses
+}
+\examples{
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+
+# Initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input information fraction
+IF_IA <- c(155 / 305, 160 / 320, 165 / 335)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+
+# Generate bounds
+generate_bounds(
+ type = 3,
+ k = 2,
+ w = w,
+ m = m,
+ corr = gs_corr,
+ alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1))
+)
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd
new file mode 100644
index 0000000..4a139c9
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_corr.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_corr.R
+\name{generate_corr}
+\alias{generate_corr}
+\title{Generate correlation matrix based on event counts}
+\usage{
+generate_corr(event)
+}
+\arguments{
+\item{event}{Event count of each hypothesis at each analysis, including
+event count of the intersection of hypotheses.
+It contains 4 columns: \code{H1}, \code{H2}, \code{Analysis}, \code{Event}.
+\code{H1} needs to be listed as 1, 2, 3, etc. as numbers.}
+}
+\value{
+A correlation matrix.
+}
+\description{
+Generate correlation matrix based on event counts
+}
+\examples{
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd
new file mode 100644
index 0000000..3b355c4
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/generate_event_table.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_event_table.R
+\name{generate_event_table}
+\alias{generate_event_table}
+\title{Generate table of event counts from ADSL and ADTTE datasets}
+\usage{
+generate_event_table(paths, h_select, adsl_name, adtte_name, key_var, cnsr_var)
+}
+\arguments{
+\item{paths}{A vector of paths for analysis datasets.
+Length should be equal to the number of analyses completed.}
+
+\item{h_select}{Selection criterion for each hypothesis.
+Should be a tibble containing 2 columns: \code{Hypothesis} and \code{Crit}.}
+
+\item{adsl_name}{SAS dataset name for subject-level analysis data.
+Usually it is \code{"adsl"}.}
+
+\item{adtte_name}{SAS dataset name for time-to-event analysis data.
+Usually it is \code{"adtte"}.}
+
+\item{key_var}{Key variable to join the \code{adsl} and \code{adtte} datasets.
+For example, \code{"USUBJID"} or \code{"SUBJID"}.}
+
+\item{cnsr_var}{Variable to indicate censoring (\code{1} = censor; \code{0} = event).
+For example, \code{"CNSR"}.}
+}
+\value{
+A list with two components:
+\itemize{
+\item \code{event}: an event count table as input for \code{\link[=generate_bounds]{generate_bounds()}}.
+\item \code{dsets}: analysis datasets of each hypothesis.
+}
+}
+\description{
+Generate table of event counts from ADSL and ADTTE datasets
+}
+\examples{
+library(dplyr)
+
+paths <- system.file("extdata/", package = "wpgsd")
+
+# Selection criteria for each hypothesis
+h_select <- tibble::tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event \%>\%
+ gt::gt() \%>\%
+ gt::tab_header(title = "Event Count - Computed from SAS Datasets Example")
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd
new file mode 100644
index 0000000..f773abf
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/tidyeval.Rd
@@ -0,0 +1,98 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils-tidy-eval.R
+\name{tidyeval}
+\alias{tidyeval}
+\alias{enquo}
+\alias{enquos}
+\alias{.data}
+\alias{:=}
+\alias{as_name}
+\alias{as_label}
+\title{Tidy eval helpers}
+\description{
+This page lists the tidy eval tools reexported in this package from
+rlang. To learn about using tidy eval in scripts and packages at a
+high level, see the \href{https://dplyr.tidyverse.org/articles/programming.html}{dplyr programming vignette}
+and the \href{https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html}{ggplot2 in packages vignette}.
+The \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming section} of \href{https://adv-r.hadley.nz}{Advanced R} may also be useful for a deeper dive.
+\itemize{
+\item The tidy eval operators \verb{\{\{}, \verb{!!}, and \verb{!!!} are syntactic
+constructs which are specially interpreted by tidy eval functions.
+You will mostly need \verb{\{\{}, as \verb{!!} and \verb{!!!} are more advanced
+operators which you should not have to use in simple cases.
+
+The curly-curly operator \verb{\{\{} allows you to tunnel data-variables
+passed from function arguments inside other tidy eval functions.
+\verb{\{\{} is designed for individual arguments. To pass multiple
+arguments contained in dots, use \code{...} in the normal way.
+
+\if{html}{\out{
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Quickstart guide
+Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. +Sun
+ +library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+
+1 Background
+The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to +take advantage of the known correlation structure in constructing +efficacy bounds to control family-wise error rate (FWER) for a group +sequential design. Here correlation may be due to common observations in +nested populations, due to common observations in overlapping +populations, or due to common observations in the control arm. This +document illustrates the use of the R package wpgsd to implement this +approach.
+
+
+2 Methods and +Examples
+
+
+2.1 Closed Testing and +Parametric Tests
+We aim to control the familywise error rate (FWER) at level \(\alpha\). Let \(J +\subseteq I\). The intersection hypothesis \(H_J\) assumes the null hypothesis for all +individual hypotheses \(H_i\) with +\(i \in J\). Closed testing principle +is as follows: if for all sets \(J \subseteq +I\) with \(j \in J\), \(H_J\) can be rejected at level \(\alpha\), then \(H_j\) can be rejected. Weighted parametric +tests can be used for this: Bretz et al. +(2011), Xi et al. (2017) for fixed +designs or Maurer and Bretz (2013) for +group sequential.
+
+
+2.2 Consonance
+A closed procedure is called consonant if the rejection of the +complete intersection null hypothesis \(H_I\) further implies that at least one +elementary hypothesis \(H_i, i \in I\), +is rejected. Consonance is a desirable property leading to short-cut +procedures that give the same rejection decisions as the original closed +procedure but with fewer operations. For WPGSD, consonance does not +always hold and in general the closed-testing procedure is required.
+
+
+2.3 Group Sequential +Design Notations and Assumptions
+-
+
- A set \(I\) of hypotheses for \(i \in I\). +
- \(K\) group sequential analyses, +\(k = 1, \ldots, K\) +
- Single endpoint
+
-
+
- Not required, and can be generalized +
+ - Assume tests \(Z_{ik}\), \(i \in I\), \(1 +\leq k \leq K\) where a large \(Z_{ik}\) is used to reject \(H_i\) +
+
+2.4 Correlation +Structure
+-
+
- Notation
+
-
+
- Events for individual hypothesis \(H_i\),\(i \in +I\) at analysis k denoted by \(n_{ik}\). +
- Assume the same endpoint for all hypotheses (can be relaxed) +
- For binary or continuous outcomes \(n_{ik}\) represents sample size +
- \(Z_{ik}\) is standardized normal +test for treatment effect for individual hypothesis \(H_i\) at analysis \(k\) +
- Denote \(n_{i\wedge i^\prime,k\wedge +k^\prime}\) as the number of observations (or events) included in +both \(Z_{ik}\) and \(Z_{i^\prime k^\prime}\), \(i\in I\), \(1\le +k\le K\). +
+ - Key result \[ \hbox{Corr}(Z_{ik}, +Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime +}}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} \] +
- Proof builds on standard group sequential theory (Chen et al. (2021)) +
+
+
+
+
+
+2.5 Example 1: +Overlapping Populations, Two Analyses
+Following illustrates the first example, which has overlapping +populations (e.g. due to biomarker) and is also example 1 in Anderson et al. (2022).
+
+
+
+
++Ex1: Populations +
+The multiplicity strategy is defined as follows.
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
The event count of each hypothesis at each analysis is shown +below.
+| Population | +Number of Events at IA | +Number of Events at FA | +
|---|---|---|
| Population 1 | +100 | +200 | +
| Population 2 | +110 | +220 | +
| Population 1 \(\cap\) 2 | +80 | +160 | +
| Overall Population | +225 | +450 | +
The correlation matrix among test statistics is as follows.
+| \(i,k\) | +1,1 | +2,1 | +3,1 | +1,2 | +2,2 | +3,2 | +
|---|---|---|---|---|---|---|
| 1,1 | +1 | +\(\frac{80}{\sqrt{100\cdot +110}}\) | +\(\frac{100}{\sqrt{100 +\cdot 225}}\) | +\(\frac{100}{\sqrt{100\cdot +200}}\) | +\(\frac{80}{\sqrt{100\cdot +220}}\) | +\(\frac{100}{\sqrt{100 +\cdot 450}}\) | +
| 2,1 | +0.76 | +1 | +\(\frac{110}{\sqrt{110 +\cdot 225}}\) | +\(\frac{80}{\sqrt{110\cdot +200}}\) | +\(\frac{110}{\sqrt{110\cdot +220}}\) | +\(\frac{110}{\sqrt{110 +\cdot 450}}\) | +
| 3,1 | +0.67 | +0.70 | +1 | +\(\frac{100}{\sqrt{225 +\cdot 200}}\) | +\(\frac{110}{\sqrt{225 +\cdot 220}}\) | +\(\frac{225}{\sqrt{225 +\cdot 450}}\) | +
| 1,2 | +0.71 | +0.54 | +0.47 | +1 | +\(\frac{160}{\sqrt{200 +\cdot 220}}\) | +\(\frac{200}{\sqrt{200 +\cdot 450}}\) | +
| 2,2 | +0.54 | +0.71 | +0.49 | +0.76 | +1 | +\(\frac{220}{\sqrt{220 +\cdot 450}}\) | +
| 3,2 | +0.47 | +0.49 | +0.71 | +0.67 | +0.70 | +1 | +
+
+
+
+
+
+2.6 Example 2: Common +Control, Two Analyses
+Following illustrates the second example in which correlation comes +from common control arm. This is also example 2 in Anderson et al. (2022).
+
| Treatment Arm | +Number of Events at IA | +Number of Events at FA | +
|---|---|---|
| Experimental 1 | +70 | +135 | +
| Experimental 2 | +75 | +150 | +
| Experimental 3 | +80 | +165 | +
| Control | +85 | +170 | +
| \(i,k\) | +1,1 | +2,1 | +3,1 | +1,2 | +2,2 | +3,2 | +
|---|---|---|---|---|---|---|
| 1,1 | +1 | +\(\frac{85}{\sqrt{155\cdot +160}}\) | +\(\frac{85}{\sqrt{155 \cdot +165}}\) | +\(\frac{155}{\sqrt{155\cdot +305}}\) | +\(\frac{85}{\sqrt{155\cdot +320}}\) | +\(\frac{85}{\sqrt{155 \cdot +335}}\) | +
| 2,1 | +0.54 | +1 | +\(\frac{85}{\sqrt{160 \cdot +165}}\) | +\(\frac{85}{\sqrt{160 \cdot +305}}\) | +\(\frac{160}{\sqrt{160\cdot +320}}\) | +\(\frac{85}{\sqrt{160 \cdot +335}}\) | +
| 3,1 | +0.53 | +0.52 | +1 | +\(\frac{85}{\sqrt{165 \cdot +305}}\) | +\(\frac{85}{\sqrt{165\cdot +320}}\) | +\(\frac{165}{\sqrt{165 +\cdot 335}}\) | +
| 1,2 | +0.71 | +0.38 | +0.38 | +1 | +\(\frac{170}{\sqrt{305\cdot +320}}\) | +\(\frac{170}{\sqrt{305 +\cdot 335}}\) | +
| 2,2 | +0.38 | +0.71 | +0.37 | +0.54 | +1 | +\(\frac{170}{\sqrt{320 +\cdot 335}}\) | +
| 3,2 | +0.37 | +0.37 | +0.70 | +0.53 | +0.52 | +1 | +
+
+
+
+
+
+2.7 Hypotheses Set
+These 2 examples each has 7 intersection hypotheses and the +corresponding weighting strategies are illustrated below.
+| \(H_J\) | +\(w_1(J)\) | +\(w_2(J)\) | +\(w_3(J)\) | +
|---|---|---|---|
| \(H_1 \cap H_2 \cap +H_3\) | +0.3 | +0.3 | +0.4 | +
| \(H_1 \cap +H_2\) | +0.5 | +0.5 | +- | +
| \(H_1 \cap +H_3\) | +0.3 | +- | +0.7 | +
| \(H_2 \cap +H_3\) | +- | +0.3 | +0.7 | +
| \(H_1\) | +1 | +- | +- | +
| \(H_2\) | +- | +1 | +- | +
| \(H_3\) | +- | +- | +1 | +
| \(H_J\) | +\(w_1(J)\) | +\(w_2(J)\) | +\(w_3(J)\) | +
|---|---|---|---|
| \(H_1 \cap H_2 \cap +H_3\) | +1/3 | +1/3 | +1/3 | +
| \(H_1 \cap +H_2\) | +1/2 | +1/2 | +- | +
| \(H_1 \cap +H_3\) | +1/2 | +- | +1/2 | +
| \(H_2 \cap +H_3\) | +- | +1/2 | +1/2 | +
| \(H_1\) | +1 | +- | +- | +
| \(H_2\) | +- | +1 | +- | +
| \(H_3\) | +- | +- | +1 | +
+
+2.8 \(\alpha\) Spending: 3 approaches
+The WPGSD approach uses all known correlations between tests in the +study. This relaxes bounds and allows increased power or smaller sample +size. Three spending approaches have been proposed:
+-
+
Fixed spending (Fleming-Harrington-O’Brien (FHO) approach). +Specify \(0 < \alpha_1(J) < \alpha_2(J) +< \ldots < \alpha_K(J) = \alpha(J) \leq \alpha\) for all +\(J\subseteq I\), where \(\alpha(J)\) is the total alpha for +intersection hypothesis \(H_J\) +according to the graphical approach.
+\(\alpha\)-spending approach 1. +We choose a spending function family \(f(t,\alpha)\) and set \(\alpha_k(J)=f(t_k(J),\alpha(J))\) for \(1\le k\le K\) for all intersection +hypotheses \(J\subseteq I\).
+\(\alpha\)-spending approach 2. +For each elementary hypothesis \(i\) +(\(i\) = 1, 2, , \(m\)), specify the \(\alpha\)-spending function family \(f_i(t,\gamma)\) where \(\gamma\) is the \(\alpha\) level for the hypothesis and \(f_i(t_{ik},\gamma)\) determines how much +\(\alpha\) to spend up to analysis +\(k\) for hypothesis \(i\) when level \(\gamma\) is allocated to the hypothesis. +Then \(\alpha_k(J) = \sum_{i \in J} +f_i(t_{ik}, w_i(J)\alpha)\).
+
+
+2.9 Bounds Computation: +Parametric Test, Fixed Design (For Example, Two Populations, One +Analysis)
+-
+
Assume (\(Z_1,Z_2\)) bivariate +normal with known correlation
+Find \(\alpha\)-inflation factor +\(c_J\) such that \[ \alpha = P[\cup_{i \in J} \{p_i \leq +c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq +\Phi^{-1}(1-c_Jw_{J,i}\alpha \}]\]
+Basic algorithm code in Bretz et al. +(2011)
+
+
+2.9.1 +Bounds Computation: WPGSD - Fixed spending and \(\alpha\) spending approach 1
+-
+
Assume for \(j < k\) that +bounds \(c_{ij} (J), i \in J, j < +k\), have already been set and remain unchanged.
+At analysis \(k\), compute the +correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = +1, \ldots, k\).
+i Initialize \(\alpha_{k}^{*}(J) = +\alpha_{k}(J) - \alpha_{k-1}(J)\).
+ii Set \(b_{ik} = \Phi^{-1}(1 - +w_{i}(J)\alpha_{k}^{*} (J))\), \(i\in +J\).
+iii Compute type I error rate up to analysis \(k\) \[ 1 - +Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ +Z_{ij} < c_{ij}(J) \} ). \]
+iv Update \(\alpha_{k}^{*}(J)\) +using root-finding with steps ii - iii until the type I error rate +through analysis \(k\) is controlled at +\(\alpha_{k}(J)\) for \(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} +\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. +\]
+v Set \(c_{ik}(J) = b_{ik}\) from +the previous step. The corresponding nominal \(p\)-value boundary is \(p_{ik}(J)= 1-\Phi(c_{ik}(J)) += w_i(J)\alpha_k^*(J)\).
+Note: interim bound does not depend on future analyses. Solution +only requires root finding for a single \(\alpha_{k}^{*}(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate +normal computation from mvtnorm R package Genz et al. (2020).
+
+
+2.9.2 +Bounds Computation: WPGSD - \(\alpha\) +spending approach 2
+-
+
Assume for \(j < k\) that +bounds \(c_{ij} (J), i \in J, j < +k\), have already been set and remain unchanged.
+At analysis \(k\), compute the +correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = +1, \ldots, k\).
+i Determine what the nominal \(p\)-value boundary would be for each +elementary hypothesis in \(J\) for a +weighted Bonferroni test in a group sequential design as described in +Maurer and Bretz (2013). Let these nominal +\(p\)-value boundaries be \(\alpha^\prime_{ik}(J)\).
+ii Choose an inflation factor \(\xi_{k}(J) +> 1\) and set \[b_{ik} = +\Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).\]
+iii Update \(\xi_k(J)\) until this +type I error rate up to analysis \(k\) +is controlled at \(\alpha_{k}(J)\) for +\(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} +\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = +\alpha_{k}(J).\]
+iv After the appropriate \(\xi_k(J)\) has been derived, the nominal +\(p\)-value boundaries are \(p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)\), +and \(b_{ik}\) is computed as in step +ii, we set \(c_{ik}(J) = +b_{ik}\).
+Note: interim bound does not depend on future analyses. Solution +only requires root finding for a single \(\xi_k(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate +normal computation from the mvtnorm R package Genz et +al. (2020).
+
+
+2.10 Implementation of +Example 1 with Overlapping Populations
+We first define the transition matrix and weights as shown above in +Section 2.5. Next we set up the event count table as follows:
+-
+
- Analysis: Analysis number (1 for interim, 2 for final). +
- Event: Event counts. +
- 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, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+
+
+
+
+| Event Count | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +100 |
| 2 | +2 | +1 | +110 |
| 3 | +3 | +1 | +225 |
| 1 | +2 | +1 | +80 |
| 1 | +3 | +1 | +100 |
| 2 | +3 | +1 | +110 |
| 1 | +1 | +2 | +200 |
| 2 | +2 | +2 | +220 |
| 3 | +3 | +2 | +450 |
| 1 | +2 | +2 | +160 |
| 1 | +3 | +2 | +200 |
| 2 | +3 | +2 | +220 |
# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+
+
+
+
+
+| Event Count - Computed from SAS Datasets Example | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +66 |
| 2 | +2 | +1 | +59 |
| 1 | +2 | +1 | +45 |
Then we compute correlation matrix using the event count table and
+generate_corr(). We see that the correlations not accounted
+for by the Bonferroni approach are substantial and, thus, might expect a
+non-trivial impact on bounds for hypothesis tests.
## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+
+
+
+
+| Correlation Matrix | +|||||
| H1_A1 | +H2_A1 | +H3_A1 | +H1_A2 | +H2_A2 | +H3_A2 | +
|---|---|---|---|---|---|
| 1.00 | +0.76 | +0.67 | +0.71 | +0.54 | +0.47 |
| 0.76 | +1.00 | +0.70 | +0.54 | +0.71 | +0.49 |
| 0.67 | +0.70 | +1.00 | +0.47 | +0.49 | +0.71 |
| 0.71 | +0.54 | +0.47 | +1.00 | +0.76 | +0.67 |
| 0.54 | +0.71 | +0.49 | +0.76 | +1.00 | +0.70 |
| 0.47 | +0.49 | +0.71 | +0.67 | +0.70 | +1.00 |
Bonferroni and WPGSD bounds can then be computed via
+generate_bounds(). In this example, we useHSD(-4) as \(\alpha\)-spending for all hypotheses. Of
+note, generate_bounds() input type specifies boundary
+type.
-
+
- 0 = Bonferroni. Separate alpha spending for each hypotheses. +
- 1 = Fixed alpha spending for all hypotheses. Method 3a in the +manuscript. +
- 2 = Overall alpha spending for all hypotheses. Method 3b in the +manuscript. +
- 3 = Separate alpha spending for each hypotheses. Method 3c in the +manuscript. +
Compute Bonferroni bounds.
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+
+
+
+
+
+| Bonferroni bounds | +||||
| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0030 | +NA | +NA |
| 1 | +H1, H2 | +0.0015 | +0.0015 | +NA |
| 1 | +H1, H2, H3 | +0.0009 | +0.0009 | +0.0012 |
| 1 | +H1, H3 | +0.0013 | +NA | +0.0016 |
| 1 | +H2 | +NA | +0.0030 | +NA |
| 1 | +H2, H3 | +NA | +0.0013 | +0.0016 |
| 1 | +H3 | +NA | +NA | +0.0030 |
| 2 | +H1 | +0.0238 | +NA | +NA |
| 2 | +H1, H2 | +0.0118 | +0.0118 | +NA |
| 2 | +H1, H2, H3 | +0.0070 | +0.0070 | +0.0094 |
| 2 | +H1, H3 | +0.0106 | +NA | +0.0130 |
| 2 | +H2 | +NA | +0.0238 | +NA |
| 2 | +H2, H3 | +NA | +0.0106 | +0.0130 |
| 2 | +H3 | +NA | +NA | +0.0238 |
Compute WPGSD Bounds using \(\alpha\)-spending approach 1 with HSD(-4) +spending. Here spending time was defined as minimum of the 3 observed +information fractions.
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+
+
+
+
+
+| WPGSD bounds | +||||
| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0030 | +NA | +NA |
| 1 | +H1, H2 | +0.0017 | +0.0017 | +NA |
| 1 | +H1, H2, H3 | +0.0011 | +0.0011 | +0.0014 |
| 1 | +H1, H3 | +0.0014 | +NA | +0.0018 |
| 1 | +H2 | +NA | +0.0030 | +NA |
| 1 | +H2, H3 | +NA | +0.0015 | +0.0018 |
| 1 | +H3 | +NA | +NA | +0.0030 |
| 2 | +H1 | +0.0238 | +NA | +NA |
| 2 | +H1, H2 | +0.0144 | +0.0144 | +NA |
| 2 | +H1, H2, H3 | +0.0092 | +0.0092 | +0.0123 |
| 2 | +H1, H3 | +0.0122 | +NA | +0.0149 |
| 2 | +H2 | +NA | +0.0238 | +NA |
| 2 | +H2, H3 | +NA | +0.0124 | +0.0152 |
| 2 | +H3 | +NA | +NA | +0.0238 |
Below shows the comparison between the Bonferroni and WPGSD bounds. +Nominal level at final analysis by using the WPGSD method increased by +up to 1.3× over those obtained via the Bonferroni approach.
+
+
+
+
+
+
+| Bonferroni and WPGSD Bounds | +||||||||
| Analysis | +Hypotheses | +H1.B | +H2.B | +H3.B | +H1.W | +H2.W | +H3.W | +xi | +
|---|---|---|---|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0009 | +0.0009 | +0.0012 | +0.0011 | +0.0011 | +0.0014 | +1.1770 |
| 1 | +H1, H2 | +0.0015 | +0.0015 | +NA | +0.0017 | +0.0017 | +NA | +1.1363 |
| 1 | +H1, H3 | +0.0013 | +NA | +0.0016 | +0.0014 | +NA | +0.0018 | +1.0810 |
| 1 | +H2, H3 | +NA | +0.0013 | +0.0016 | +NA | +0.0015 | +0.0018 | +1.0962 |
| 1 | +H1 | +0.0030 | +NA | +NA | +0.0030 | +NA | +NA | +1.0000 |
| 1 | +H2 | +NA | +0.0030 | +NA | +NA | +0.0030 | +NA | +1.0000 |
| 1 | +H3 | +NA | +NA | +0.0030 | +NA | +NA | +0.0030 | +1.0000 |
| 2 | +H1, H2, H3 | +0.0070 | +0.0070 | +0.0094 | +0.0092 | +0.0092 | +0.0123 | +1.3092 |
| 2 | +H1, H2 | +0.0118 | +0.0118 | +NA | +0.0144 | +0.0144 | +NA | +1.2250 |
| 2 | +H1, H3 | +0.0106 | +NA | +0.0130 | +0.0122 | +NA | +0.0149 | +1.1532 |
| 2 | +H2, H3 | +NA | +0.0106 | +0.0130 | +NA | +0.0124 | +0.0152 | +1.1735 |
| 2 | +H1 | +0.0238 | +NA | +NA | +0.0238 | +NA | +NA | +1.0000 |
| 2 | +H2 | +NA | +0.0238 | +NA | +NA | +0.0238 | +NA | +1.0000 |
| 2 | +H3 | +NA | +NA | +0.0238 | +NA | +NA | +0.0238 | +1.0000 |
Closed testing procedure can then be performed using
+closed_test().
## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+
+
+
+
+
+| Observed Nominal p-Values | +|||
| Analysis | +H1 | +H2 | +H3 | +
|---|---|---|---|
| 1 | +0.01 | +0.0004 | +0.03 |
| 2 | +0.05 | +0.002 | +0.015 |
test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+
+
+
+
+
+| Closed Testing Results | +|||
| H1 | +H2 | +H3 | +Analysis | +
|---|---|---|---|
| Fail | +Success | +Fail | +Analysis 1 |
| Fail | +Success | +Fail | +Analysis 2 |
+
+2.11 Implementation of +Example 2 with Common Control
+Similarly, codes below reproduce the result of Example 2 of Anderson et al. (2022), which uses spending +method 3c specified in the paper.
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+
+
+
+
+| Event Count | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +155 |
| 2 | +2 | +1 | +160 |
| 3 | +3 | +1 | +165 |
| 1 | +2 | +1 | +85 |
| 1 | +3 | +1 | +85 |
| 2 | +3 | +1 | +85 |
| 1 | +1 | +2 | +305 |
| 2 | +2 | +2 | +320 |
| 3 | +3 | +2 | +335 |
| 1 | +2 | +2 | +170 |
| 1 | +3 | +2 | +170 |
| 2 | +3 | +2 | +170 |
# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+
+
+
+
+| Correlation Matrix | +|||||
| H1_A1 | +H2_A1 | +H3_A1 | +H1_A2 | +H2_A2 | +H3_A2 | +
|---|---|---|---|---|---|
| 1.00 | +0.54 | +0.53 | +0.71 | +0.38 | +0.37 |
| 0.54 | +1.00 | +0.52 | +0.38 | +0.71 | +0.37 |
| 0.53 | +0.52 | +1.00 | +0.38 | +0.37 | +0.70 |
| 0.71 | +0.38 | +0.38 | +1.00 | +0.54 | +0.53 |
| 0.38 | +0.71 | +0.37 | +0.54 | +1.00 | +0.52 |
| 0.37 | +0.37 | +0.70 | +0.53 | +0.52 | +1.00 |
# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
+
+
+
+
+| Bonferroni and WPGSD Bounds | +||||||||
| Analysis | +Hypotheses | +H1.B | +H2.B | +H3.B | +H1.W | +H2.W | +H3.W | +xi | +
|---|---|---|---|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +1.0421 |
| 1 | +H1, H2 | +0.0005 | +0.0004 | +NA | +0.0005 | +0.0004 | +NA | +1.0266 |
| 1 | +H1, H3 | +0.0005 | +NA | +0.0004 | +0.0005 | +NA | +0.0004 | +1.0247 |
| 1 | +H2, H3 | +NA | +0.0004 | +0.0004 | +NA | +0.0004 | +0.0004 | +1.0230 |
| 1 | +H1 | +0.0017 | +NA | +NA | +0.0017 | +NA | +NA | +1.0000 |
| 1 | +H2 | +NA | +0.0015 | +NA | +NA | +0.0015 | +NA | +1.0000 |
| 1 | +H3 | +NA | +NA | +0.0014 | +NA | +NA | +0.0014 | +1.0000 |
| 2 | +H1, H2, H3 | +0.0083 | +0.0083 | +0.0083 | +0.0095 | +0.0095 | +0.0095 | +1.1493 |
| 2 | +H1, H2 | +0.0123 | +0.0124 | +NA | +0.0135 | +0.0135 | +NA | +1.0942 |
| 2 | +H1, H3 | +0.0123 | +NA | +0.0124 | +0.0135 | +NA | +0.0135 | +1.0898 |
| 2 | +H2, H3 | +NA | +0.0124 | +0.0124 | +NA | +0.0134 | +0.0134 | +1.0855 |
| 2 | +H1 | +0.0245 | +NA | +NA | +0.0245 | +NA | +NA | +1.0000 |
| 2 | +H2 | +NA | +0.0245 | +NA | +NA | +0.0245 | +NA | +1.0000 |
| 2 | +H3 | +NA | +NA | +0.0245 | +NA | +NA | +0.0245 | +1.0000 |
+
+2.12 Power +Considerations
+The above illustrates the use of the WPGSD approach to compute bounds +at the analysis stage. At the design stage, one can take one of the +following 2 options: 1) The trial can be first designed as if the +testing would be done with a weighted Bonferroni with conservative +sample size estimate. At the analysis stage, the correlation can be +taken into consideration with the WPGSD approach for bound calculation; +or 2) To adjust the sample size downward using the WPGSD approach at the +design stage, one can power the study by taking the minimum \(p\)-value bound for a given individual +hypothesis from the WPGSD table (with assumed correlation structure). +For example, for \(H_2\) of example 1, +this is \(\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010\) +for \(k=1\) and \(\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081\) +for \(k=2\). Then the \(H_2\) bounds of 0.0010 (\(k=1\)) and 0.0081 (\(k=2\)) can be used to power \(H_2\). R function for the 2nd option is in +development.
+
+
+3 Conclusions
+The WPGSD approach provides an unification of previous work on +parametric testing in group sequential design. It enabled more complex +scenarios and requires attention to consonance and intersection +hypotheses. Although detailed closed testing is required, this should +not be a deterrent. The approach accommodates various spending +approaches and provides more relaxed bounds and improved power compared +to the Bonferroni approach.
+
+
+
+
+
+References
+
+
+
+Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022.
+“A Unified Framework for Weighted Parametric Group Sequential
+Design.” Biometrical Journal 64 (7): 1219–39.
+
+
+Bretz, Frank, Martin Posch, Ekkehard Glimm, Florian Klinglmueller, Willi
+Maurer, and Kornelius Rohmeyer. 2011. “Graphical Approaches for
+Multiple Comparison Procedures Using Weighted Bonferroni, Simes, or
+Parametric Tests.” Biometrical Journal 53 (6): 894–913.
+
+
+Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021.
+“Multiplicity for a Group Sequential Trial with Biomarker
+Subpopulations.” Contemporary Clinical Trials 101:
+106249.
+
+
+Maurer, Willi, and Frank Bretz. 2013. “Multiple Testing in Group
+Sequential Trials Using Graphical Approaches.” Statistics in
+Biopharmaceutical Research 5 (4): 311–20.
+
+
+Xi, Dong, Ekkehard Glimm, Willi Maurer, and Frank Bretz. 2017. “A
+Unified Framework for Weighted Parametric Multiple Test
+Procedures.” Biometrical Journal 59 (5): 918–31.
+
+}}\preformatted{my_function <- function(data, var, ...) \{
+ data \%>\%
+ group_by(...) \%>\%
+ summarise(mean = mean(\{\{ var \}\}))
+\}
+}\if{html}{\out{
}}
+\item \code{\link[=enquo]{enquo()}} and \code{\link[=enquos]{enquos()}} delay the execution of one or several
+function arguments. The former returns a single expression, the
+latter returns a list of expressions. Once defused, expressions
+will no longer evaluate on their own. They must be injected back
+into an evaluation context with \verb{!!} (for a single expression) and
+\verb{!!!} (for a list of expressions).
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, ...) \{
+ # Defuse
+ var <- enquo(var)
+ dots <- enquos(...)
+
+ # Inject
+ data \%>\%
+ group_by(!!!dots) \%>\%
+ summarise(mean = mean(!!var))
+\}
+}\if{html}{\out{
}}
+
+In this simple case, the code is equivalent to the usage of \verb{\{\{}
+and \code{...} above. Defusing with \code{enquo()} or \code{enquos()} is only
+needed in more complex cases, for instance if you need to inspect
+or modify the expressions in some way.
+\item The \code{.data} pronoun is an object that represents the current
+slice of data. If you have a variable name in a string, use the
+\code{.data} pronoun to subset that variable with \code{[[}.
+
+\if{html}{\out{}}\preformatted{my_var <- "disp"
+mtcars \%>\% summarise(mean = mean(.data[[my_var]]))
+}\if{html}{\out{
}}
+\item Another tidy eval operator is \verb{:=}. It makes it possible to use
+glue and curly-curly syntax on the LHS of \code{=}. For technical
+reasons, the R language doesn't support complex expressions on
+the left of \code{=}, so we use \verb{:=} as a workaround.
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, suffix = "foo") \{
+ # Use `\{\{` to tunnel function arguments and the usual glue
+ # operator `\{` to interpolate plain strings.
+ data \%>\%
+ summarise("\{\{ var \}\}_mean_\{suffix\}" := mean(\{\{ var \}\}))
+\}
+}\if{html}{\out{
}}
+\item Many tidy eval functions like \code{dplyr::mutate()} or
+\code{dplyr::summarise()} give an automatic name to unnamed inputs. If
+you need to create the same sort of automatic names by yourself,
+use \code{as_label()}. For instance, the glue-tunnelling syntax above
+can be reproduced manually with:
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, suffix = "foo") \{
+ var <- enquo(var)
+ prefix <- as_label(var)
+ data \%>\%
+ summarise("\{prefix\}_mean_\{suffix\}" := mean(!!var))
+\}
+}\if{html}{\out{
}}
+
+Expressions defused with \code{enquo()} (or tunnelled with \verb{\{\{}) need
+not be simple column names, they can be arbitrarily complex.
+\code{as_label()} handles those cases gracefully. If your code assumes
+a simple column name, use \code{as_name()} instead. This is safer
+because it throws an error if the input is not a name as expected.
+}
+}
+\keyword{internal}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd
new file mode 100644
index 0000000..bc49567
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/man/wpgsd-package.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/wpgsd-package.R
+\docType{package}
+\name{wpgsd-package}
+\alias{wpgsd}
+\alias{wpgsd-package}
+\title{wpgsd: Weighted Parametric Group Sequential Design}
+\description{
+\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
+
+Adjusted inference for weighted parametric group sequential design. Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) \doi{10.1002/bimj.202100085} allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here, correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+}
+\seealso{
+Useful links:
+\itemize{
+ \item \url{https://merck.github.io/wpgsd/}
+ \item \url{https://github.com/Merck/wpgsd}
+ \item Report bugs at \url{https://github.com/Merck/wpgsd/issues}
+}
+
+}
+\author{
+\strong{Maintainer}: Yujie Zhao \email{yujie.zhao@merck.com}
+
+Authors:
+\itemize{
+ \item Keaven Anderson \email{keaven_anderson@merck.com}
+ \item Zifang Guo \email{zifang.guo@merck.com}
+ \item Jing Zhao \email{jing_zhaox@merck.com}
+ \item Linda Sun \email{linda_sun@merck.com}
+ \item Yi Cui \email{yi.cui@merck.com}
+ \item Larry Leon \email{larry.leon2@merck.com}
+}
+
+Other contributors:
+\itemize{
+ \item Merck Sharp & Dohme Corp [copyright holder]
+}
+
+}
+\keyword{internal}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R
new file mode 100644
index 0000000..39921f0
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(wpgsd)
+
+test_check("wpgsd")
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R
new file mode 100644
index 0000000..d378ff3
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/helper-generate_corr_new.R
@@ -0,0 +1,126 @@
+# Helper functions used by test-independent-generate_corr_new.R
+
+#' Generate correlation matrix based on event counts
+#'
+#' @param event Event count of each hypothesis at each analysis, including
+#' event count of the intersection of hypotheses.
+#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`.
+#' `H1` needs to be listed as 1, 2, 3, etc. as numbers.
+#'
+#' @return A correlation matrix.
+#'
+#' @importFrom dplyr filter select %>%
+#'
+#' @export
+#'
+#' @examples
+#' # Build the transition matrix
+#' m <- matrix(c(
+#' 0, 0.5, 0.5,
+#' 0.5, 0, 0.5,
+#' 0.5, 0.5, 0
+#' ), nrow = 3, byrow = TRUE)
+#' # initialize weights
+#' w <- c(1 / 3, 1 / 3, 1 / 3)
+#'
+#' # Input event count of intersection of paired hypotheses - Table 2
+#' event <- tibble::tribble(
+#' ~H1, ~H2, ~Analysis, ~Event,
+#' 1, 1, 1, 155,
+#' 2, 2, 1, 160,
+#' 3, 3, 1, 165,
+#' 1, 2, 1, 85,
+#' 1, 3, 1, 85,
+#' 2, 3, 1, 85,
+#' 1, 1, 2, 305,
+#' 2, 2, 2, 320,
+#' 3, 3, 2, 335,
+#' 1, 2, 2, 170,
+#' 1, 3, 2, 170,
+#' 2, 3, 2, 170
+#' )
+#'
+#' # Generate correlation from events
+#' gs_corr <- generate_corr_new(event)
+generate_corr_new <- function(event) {
+ elem <- event %>% subset(H1 == H2)
+ inter <- event %>% subset(H1 != H2)
+ n_hypotheses <- max(as.numeric(elem$H1))
+ n_analyses <- max(elem$Analysis)
+
+ # Diagonal
+ D <- diag(elem$Event)
+
+ # Within hypothesis across analyses
+ if (n_analyses > 1) {
+ for (i in 1:n_hypotheses) {
+ for (j in 1:(n_analyses - 1)) {
+ count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i]
+ for (k in (j + 1):n_analyses) {
+ D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count
+ D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count
+ }
+ }
+ }
+ }
+
+ # Between hypotheses and analyses
+ for (i in 1:(n_hypotheses - 1)) {
+ for (j in c((i + 1):n_hypotheses)) {
+ for (k in 1:n_analyses) {
+ count1 <- as.numeric(event %>%
+ subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>%
+ select(Event))[1]
+ for (l in (k:n_analyses)) {
+ D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1
+ D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1
+ D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1
+ D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1
+ }
+ }
+ }
+ }
+
+ corr_mat <- d_corr(D)
+
+ col_names <- NULL
+ for (k in 1:n_analyses) {
+ for (i in 1:n_hypotheses) {
+ name_tmp <- paste("H", i, "_A", k, sep = "")
+ col_names <- c(col_names, name_tmp)
+ }
+ }
+
+ colnames(corr_mat) <- col_names
+
+ return(corr_mat)
+}
+
+test_generate_corr_new <- function() {
+ a1 <- 80
+ b1 <- 100
+ ab1 <- 60
+ a2 <- 120
+ b2 <- 150
+ ab2 <- 80
+
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, a1,
+ 2, 2, 1, b1,
+ 1, 2, 1, ab1,
+ 1, 1, 2, a2,
+ 2, 2, 2, b2,
+ 1, 2, 2, ab2
+ )
+
+ list(
+ "a1" = a1,
+ "b1" = b1,
+ "ab1" = ab1,
+ "a2" = a2,
+ "b2" = b2,
+ "ab2" = ab2,
+ "event" = event
+ )
+}
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R
new file mode 100644
index 0000000..9c2a339
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R
@@ -0,0 +1,23 @@
+test_that("Generate event table returns the expected sorted data", {
+ expected_data <- tibble(
+ one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
+ another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
+ analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
+ common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335)
+ )
+
+ event <- data.frame(
+ Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
+ IA = c(70, 75, 80, 85),
+ FA = c(135, 150, 165, 170)
+ )
+
+ hypothesis <- list(
+ H1 = "Experimental 1 vs. Control",
+ H2 = "Experimental 2 vs. Control",
+ H3 = "Experimental 1 vs. Experimental 2"
+ )
+
+ result_table <- generate_event_table_cc(event, hypothesis)
+ expect_identical(result_table, expected_data)
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R
new file mode 100644
index 0000000..c611242
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R
@@ -0,0 +1,23 @@
+test_that("Generate event table ol returns the expected sorted data", {
+ expected_data <- tibble(
+ one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
+ another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
+ analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
+ common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450)
+ )
+
+ event <- data.frame(
+ Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
+ IA = c(100, 110, 80, 225),
+ FA = c(200, 220, 160, 450)
+ )
+
+ hypothesis <- list(
+ H1 = "Efficacy in Population 1",
+ H2 = "Efficacy in Population 2",
+ H3 = "Efficacy in Overall population"
+ )
+
+ result_table <- generate_event_table_ol(event, hypothesis)
+ expect_identical(result_table, expected_data)
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R
new file mode 100644
index 0000000..ef088a0
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-closed_test.R
@@ -0,0 +1,25 @@
+test_that("closed_test reject hypothesis as expected", {
+ p_obs <- dplyr::bind_rows(
+ tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001),
+ tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001)
+ )
+
+ bound <- tibble::tribble(
+ ~Analysis, ~Hypotheses, ~H1, ~H2,
+ 1, "H1", 0.02, NA,
+ 1, "H1, H2", 0.0001, 0.00001,
+ 1, "H2", NA, 0.003,
+ 2, "H1", 0.02, NA,
+ 2, "H1, H2", 0.02, 0.00001,
+ 2, "H2", NA, 0.003
+ )
+
+ closed_test <- closed_test(bound, p_obs)
+ closed_test_a1 <- closed_test %>% dplyr::filter(Analysis == "Analysis 1")
+ closed_test_a2 <- closed_test %>% dplyr::filter(Analysis == "Analysis 2")
+
+ expect_equal(closed_test_a1$H1, "Fail")
+ expect_equal(closed_test_a1$H2, "Fail")
+ expect_equal(closed_test_a2$H1, "Success")
+ expect_equal(closed_test_a2$H2, "Success")
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R
new file mode 100644
index 0000000..67d474b
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_bounds.R
@@ -0,0 +1,580 @@
+test_that("BH bounds replicate tables A3 and A4", {
+ # Example 1 BH weighting results in Table A3 and A4
+ set.seed(1234)
+
+ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex1 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+ # Transition matrix in Figure A1
+ m <- matrix(c(
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+ ), nrow = 3, byrow = TRUE)
+ # Initial weights
+ w <- c(0.3, 0.3, 0.4)
+
+ # Event count of intersection of paired hypotheses - Table 1
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+ )
+ event
+
+ # Generate correlation from events
+ corr <- generate_corr(event)
+ corr # correlation matrix in Table 3
+
+ # WPGSD bounds, spending method 3b
+ bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = gsDesign::sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+ )
+
+ # Bonferroni bounds
+ bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+ )
+
+ # Combine and back-calculate xi
+ bounds <- dplyr::left_join(
+ bound_Bonf,
+ bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+ )
+ bounds <- bounds %>%
+ dplyr::rowwise() %>%
+ dplyr::mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+ # Reorder for output
+ bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+ bounds <- bounds %>% dplyr::arrange(Analysis, order)
+
+ # Z-statistics boundary, Table A4
+ zbounds <- bounds %>%
+ dplyr::mutate(
+ zH1.B = -qnorm(H1.B),
+ zH2.B = -qnorm(H2.B),
+ zH3.B = -qnorm(H3.B),
+ zH1.W = -qnorm(H1.W),
+ zH2.W = -qnorm(H2.W),
+ zH3.W = -qnorm(H3.W)
+ ) %>%
+ select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W)
+
+
+ # Table A3
+ # Test H1
+ # From publication Weighted Bonferroni
+ A3_result1 <- c(
+ 0.0009, 0.0015, 0.0013, NA,
+ 0.003, NA, NA, 0.007, 0.0118,
+ 0.0101, NA, 0.0238, NA, NA
+ )
+
+ A3_result1_test <- round(bounds$H1.B, 4)
+
+ expect_equal(A3_result1_test, A3_result1)
+
+ # WPGSD
+
+ wA3_result1 <- c(
+ 0.0011, 0.0017, 0.0014, NA,
+ 0.003, NA, NA, 0.0092, 0.0144,
+ 0.0116, NA, 0.0238, NA, NA
+ )
+
+ wA3_result1_test <- round(bounds$H1.W, 4)
+
+ expect_equal(wA3_result1_test, wA3_result1)
+
+
+ # Table A4
+ # Test H1
+ # From publication Weighted Bonferroni
+ A4_result1 <- c(
+ 3.12, 2.97, 3.02, NA, 2.75, NA, NA,
+ 2.46, 2.26, 2.32, NA, 1.98, NA, NA
+ )
+
+ A4_result1_test <- round(zbounds$zH1.B, 2)
+
+ expect_equal(A4_result1_test, A4_result1)
+
+ # WPGSD
+ wA4_result1 <- c(
+ 3.08, 2.93, 2.99, NA, 2.75, NA, NA,
+ 2.36, 2.19, 2.27, NA, 1.98, NA, NA
+ )
+
+ wA4_result1_test <- round(zbounds$zH1.W, 2)
+
+ expect_equal(wA4_result1_test, wA4_result1)
+
+
+ ########################
+ # Next, reproduce H2?
+ ########################
+
+ A3_result2 <- c(
+ 0.0009, 0.0015, NA, 0.0013, NA,
+ 0.003, NA, 0.007, 0.0118, NA, 0.0101, NA, 0.0238, NA
+ )
+
+ A3_result2_test <- round(bounds$H2.B, 4)
+
+ expect_equal(A3_result2_test, A3_result2)
+
+ # WPGSD
+
+ wA3_result2 <- c(
+ 0.0011, 0.0017, NA, 0.0014, NA,
+ 0.003, NA, 0.0092, 0.0144,
+ NA, 0.0118, NA, 0.0238, NA
+ )
+
+ wA3_result2_test <- round(bounds$H2.W, 4)
+
+ expect_equal(wA3_result2_test, wA3_result2)
+
+ # A4
+
+ A4_result2 <- c(
+ 3.12, 2.97, NA, 3.02, NA, 2.75, NA, 2.46, 2.26, NA, 2.32,
+ NA, 1.98, NA
+ )
+
+ A4_result2_test <- round(zbounds$zH2.B, 2)
+
+ expect_equal(A4_result2_test, A4_result2)
+
+ # WPGSD
+ wA4_result2 <- c(
+ 3.08, 2.93, NA, 2.99, NA, 2.75, NA, 2.36, 2.19,
+ NA, 2.26, NA, 1.98, NA
+ )
+
+ wA4_result2_test <- round(zbounds$zH2.W, 2)
+
+ expect_equal(wA4_result2_test, wA4_result2)
+
+
+ ########################
+ # Next, reproduce H3?
+ ########################
+
+ A3_result3 <- c(
+ 0.0012, NA, 0.0017, 0.0017, NA, NA, 0.003, 0.0094, NA,
+ 0.0135, 0.0135, NA, NA, 0.0238
+ )
+
+ A3_result3_test <- round(bounds$H3.B, 4)
+
+ expect_equal(A3_result3_test, A3_result3)
+
+ # WPGSD
+
+ wA3_result3 <- c(
+ 0.0014, NA, 0.0018, 0.0019, NA, NA, 0.003, 0.0123, NA,
+ 0.0155, 0.0158, NA, NA, 0.0238
+ )
+
+ wA3_result3_test <- round(bounds$H3.W, 4)
+
+ expect_equal(wA3_result3_test, wA3_result3)
+
+ # A4
+
+ A4_result3 <- c(3.04, NA, 2.93, 2.93, NA, NA, 2.75, 2.35, NA, 2.21, 2.21, NA, NA, 1.98)
+
+ A4_result3_test <- round(zbounds$zH3.B, 2)
+
+ expect_equal(A4_result3_test, A4_result3)
+
+ # WPGSD
+ wA4_result3 <- c(2.99, NA, 2.9, 2.9, NA, NA, 2.75, 2.25, NA, 2.16, 2.15, NA, NA, 1.98)
+
+ wA4_result3_test <- round(zbounds$zH3.W, 2)
+
+ expect_equal(wA4_result3_test, wA4_result3)
+})
+
+test_that("BH bounds replicate tables A6 and A7", {
+ # From wpgsd github:
+ # Example 2 BH weighting results in Table A6 and A7
+ set.seed(1234)
+
+ # Transition matrix in Figure A2
+ m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+ ), nrow = 3, byrow = TRUE)
+ # Initial weights
+ w <- c(1 / 3, 1 / 3, 1 / 3)
+
+ # Event count of intersection of paired hypotheses - Table 2
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+ )
+ event
+
+ # Generate correlation from events
+ corr <- generate_corr(event)
+ corr # correlation matrix in Table 4
+
+ # WPGSD bounds, spending method 3c
+ bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+ )
+
+ # Bonferroni bounds
+ bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+ )
+
+ bounds <- dplyr::left_join(
+ bound_Bonf,
+ bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+ )
+
+ # Reorder for output
+ bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+ bounds <- bounds %>% arrange(Analysis, order)
+
+ # Table A6
+ bounds
+
+ bounds <- bounds %>% arrange(Analysis, order)
+
+ # Z-statistics boundary, Table A7
+ zbounds <- bounds %>%
+ mutate(
+ zH1.B = -qnorm(H1.B),
+ zH2.B = -qnorm(H2.B),
+ zH3.B = -qnorm(H3.B),
+ zH1.W = -qnorm(H1.W),
+ zH2.W = -qnorm(H2.W),
+ zH3.W = -qnorm(H3.W)
+ ) %>%
+ select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W)
+
+
+ # Table A6
+ # Test H1
+ # From publication Weighted Bonferroni
+ A6_result1 <- c(
+ 0.00021488,
+ 0.000458864,
+ 0.000458864,
+ NA,
+ 0.001665671,
+ NA,
+ NA,
+ 0.008259394,
+ 0.0123448,
+ 0.0123448,
+ NA,
+ 0.024455472,
+ NA,
+ NA
+ )
+
+ A6_result1_test <- round(bounds$H1.B, 4)
+
+ expect_equal(A6_result1_test, round(A6_result1, 4))
+
+ # H2
+
+ A6_result2 <- c(
+ 0.000190676,
+ 0.000411979,
+ NA,
+ 0.000411979,
+ NA,
+ 0.001525323,
+ NA,
+ 0.0082675,
+ 0.012360191,
+ NA,
+ 0.012360191,
+ NA,
+ 0.024499778,
+ NA
+ )
+
+ A6_result2_test <- round(bounds$H2.B, 4)
+
+ expect_equal(A6_result2_test, round(A6_result2, 4))
+
+ # H3
+
+ A6_result3 <- c(
+ 0.000170445,
+ NA,
+ 0.000372343,
+ 0.000372343,
+ NA,
+ NA,
+ 0.001404398,
+ 0.008274305,
+ NA,
+ 0.012373258,
+ 0.012373258,
+ NA,
+ NA,
+ 0.024538108
+ )
+
+ A6_result3_test <- round(bounds$H3.B, 4)
+
+ expect_equal(A6_result3_test, round(A6_result3, 4))
+
+ ########
+ # WPGSD
+ ########
+
+ wA6_result1 <- c(
+ 0.000224701,
+ 0.000471076,
+ 0.000470177,
+ NA,
+ 0.001665671,
+ NA,
+ NA,
+ 0.009491524,
+ 0.013508544,
+ 0.013452942,
+ NA,
+ 0.024455472,
+ NA,
+ NA
+ )
+
+ wA6_result1_test <- round(bounds$H1.W, 4)
+
+ expect_equal(wA6_result1_test, round(wA6_result1, 4))
+
+
+
+ wA6_result2 <- c(
+ 0.00019939,
+ 0.000422943,
+ NA,
+ 0.000421453,
+ NA,
+ 0.001525323,
+ NA,
+ 0.00950084,
+ 0.013525386,
+ NA,
+ 0.01341849,
+ NA,
+ 0.024499778,
+ NA
+ )
+
+ wA6_result2_test <- round(bounds$H2.W, 4)
+
+ expect_equal(wA6_result2_test, round(wA6_result2, 4))
+
+
+ wA6_result3 <- c(
+ 0.000178234,
+ NA,
+ 0.000381523,
+ 0.000380905,
+ NA,
+ NA,
+ 0.001404398,
+ 0.00950866,
+ NA,
+ 0.013483955,
+ 0.013432676,
+ NA,
+ NA,
+ 0.024538108
+ )
+
+ wA6_result3_test <- round(bounds$H3.W, 4)
+
+ expect_equal(wA6_result3_test, round(wA6_result3, 4))
+
+
+ # Z-statistics
+
+
+ # Table A7
+ A7_result1 <- c(
+ 3.521099809,
+ 3.314604451,
+ 3.314604451,
+ NA,
+ 2.93538486,
+ NA,
+ NA,
+ 2.397246926,
+ 2.246225001,
+ 2.246225001,
+ NA,
+ 1.969367163,
+ NA,
+ NA
+ )
+
+ A7_result1_test <- round(zbounds$zH1.B, 4)
+
+ expect_equal(A7_result1_test, round(A7_result1, 4))
+
+
+ A7_result2 <- c(
+ 3.552662921,
+ 3.34461863,
+ NA,
+ 3.34461863,
+ NA,
+ 2.962588043,
+ NA,
+ 2.396887486,
+ 2.245744429,
+ NA,
+ 2.245744429,
+ NA,
+ 1.968595527,
+ NA
+ )
+
+ A7_result2_test <- round(zbounds$zH2.B, 4)
+
+ expect_equal(A7_result2_test, round(A7_result2, 4))
+
+
+
+ A7_result3 <- c(
+ 3.582064348,
+ NA,
+ 3.372575697,
+ 3.372575697,
+ NA,
+ NA,
+ 2.987923795,
+ 2.396585993,
+ NA,
+ 2.24533684,
+ 2.24533684,
+ NA,
+ NA,
+ 1.967928919
+ )
+
+ A7_result3_test <- round(zbounds$zH3.B, 4)
+
+ expect_equal(A7_result3_test, round(A7_result3, 4))
+
+
+
+
+
+ # Table A7
+ wA7_result1 <- c(
+ 3.509232997,
+ 3.307254785,
+ 3.307789645,
+ NA,
+ 2.93538486,
+ NA,
+ NA,
+ 2.345863682,
+ 2.21127083,
+ 2.212880514,
+ NA,
+ 1.969367163,
+ NA,
+ NA
+ )
+
+ wA7_result1_test <- round(zbounds$zH1.W, 4)
+
+ expect_equal(wA7_result1_test, round(wA7_result1, 4))
+
+
+ wA7_result2 <- c(
+ 3.540889382,
+ 3.337326516,
+ NA,
+ 3.338307071,
+ NA,
+ 2.962588043,
+ NA,
+ 2.345498009,
+ 2.210784367,
+ NA,
+ 2.213880806,
+ NA,
+ 1.968595527,
+ NA
+ )
+
+
+ wA7_result2_test <- round(zbounds$zH2.W, 4)
+
+ expect_equal(wA7_result2_test, round(wA7_result2, 4))
+
+
+
+ wA7_result3 <- c(
+ 3.570376445,
+ NA,
+ 3.365863239,
+ 3.366309865,
+ NA,
+ NA,
+ 2.987923795,
+ 2.345191286,
+ NA,
+ 2.21198197,
+ 2.213468666,
+ NA,
+ NA,
+ 1.967928919
+ )
+
+ wA7_result3_test <- round(zbounds$zH3.W, 4)
+
+ expect_equal(wA7_result3_test, round(wA7_result3, 4))
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R
new file mode 100644
index 0000000..a1699f5
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr.R
@@ -0,0 +1,31 @@
+test_that("2 endpoints 2 analysis correlation as expected", {
+ a1 <- 80
+ b1 <- 100
+ ab1 <- 60
+ a2 <- 120
+ b2 <- 150
+ ab2 <- 80
+
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, a1,
+ 2, 2, 1, b1,
+ 1, 2, 1, ab1,
+ 1, 1, 2, a2,
+ 2, 2, 2, b2,
+ 1, 2, 2, ab2
+ )
+
+ corr <- generate_corr(event)
+ corr_test <- matrix(
+ c(
+ 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2),
+ ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2),
+ a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2),
+ ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1
+ ),
+ nrow = 4, byrow = TRUE
+ )
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test)
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R
new file mode 100644
index 0000000..aae7943
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-independent-generate_corr_new.R
@@ -0,0 +1,62 @@
+test_that("2 endpoints 2 analysis correlation as expected", {
+ res <- test_generate_corr_new()
+ a1 <- res$a1
+ b1 <- res$b1
+ ab1 <- res$ab1
+ a2 <- res$a2
+ b2 <- res$b2
+ ab2 <- res$ab2
+ event <- res$event
+
+ corr <- generate_corr_new(event)
+ corr_test <- matrix(
+ c(
+ 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2),
+ ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2),
+ a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2),
+ ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1
+ ),
+ nrow = 4, byrow = TRUE
+ )
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test)
+})
+
+# This is a 2 hypothesis, 3 analysis example
+test_that("2 hypotheses 3 analysis correlation as expected", {
+ event <- tibble::tribble(
+ ~Analysis, ~H1, ~H2, ~Event,
+ 1, 1, 1, 147,
+ 1, 2, 2, 167,
+ 1, 1, 2, 88,
+ 2, 1, 1, 278,
+ 2, 2, 2, 289,
+ 2, 1, 2, 158,
+ 3, 1, 1, 342,
+ 3, 2, 2, 350,
+ 3, 1, 2, 192
+ )
+ corr <- generate_corr_new(event)
+ n_hypotheses <- 2
+ n_analyses <- 3
+ corr_test <- diag(1, n_hypotheses * n_analyses)
+ for (k in 1:n_analyses) {
+ for (l in k:n_analyses) {
+ for (i in 1:(n_hypotheses)) {
+ countkii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == k))$Event)
+ for (j in i:n_hypotheses) {
+ countkjj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == k))$Event)
+ countljj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == l))$Event)
+ countlii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == l))$Event)
+ countkij <- as.numeric((event %>% filter(H1 == i & H2 == j & Analysis == k))$Event)
+ corr_test[(k - 1) * n_hypotheses + i, (l - 1) * n_hypotheses + j] <- countkij / sqrt(countkii * countljj)
+ corr_test[(k - 1) * n_hypotheses + j, (l - 1) * n_hypotheses + i] <- countkij / sqrt(countkjj * countlii)
+ corr_test[(l - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + j] <- countkij / sqrt(countlii * countkjj)
+ corr_test[(l - 1) * n_hypotheses + j, (k - 1) * n_hypotheses + i] <- countkij / sqrt(countljj * countkii)
+ }
+ }
+ }
+ }
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 6, byrow = TRUE), corr_test)
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R
new file mode 100644
index 0000000..ceca45c
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/tests/testthat/test-s7-event-table.R
@@ -0,0 +1,171 @@
+test_that("EventTable can be created with valid data", {
+ # Create valid event data
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 1, 2, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 1, 2, 2, 170
+ )
+
+ # Create EventTable
+ event_table <- EventTable(data = event_data)
+
+ # Check that object was created successfully
+ expect_true(S7::S7_inherits(event_table, EventTable))
+ expect_equal(event_table@n_hypotheses, 2L)
+ expect_equal(event_table@n_analyses, 2L)
+ expect_equal(nrow(event_table@data), 6)
+})
+
+test_that("EventTable validates required columns", {
+ # Missing Event column
+ invalid_data1 <- tibble::tibble(
+ H1 = c(1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data1),
+ "EventTable requires columns: Event"
+ )
+
+ # Missing H1 column
+ invalid_data2 <- tibble::tibble(
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data2),
+ "EventTable requires columns: H1"
+ )
+})
+
+test_that("EventTable validates data types and values", {
+ # Non-numeric H1
+ invalid_data1 <- tibble::tibble(
+ H1 = c("A", "B"),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data1),
+ "@data\\$H1 and @data\\$H2 must be numeric"
+ )
+
+ # Negative hypothesis index
+ invalid_data2 <- tibble::tibble(
+ H1 = c(-1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data2),
+ "Hypothesis indices \\(H1, H2\\) must be positive integers"
+ )
+
+ # Negative event count
+ invalid_data3 <- tibble::tibble(
+ H1 = c(1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(-100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data3),
+ "Event counts must be non-negative"
+ )
+})
+
+test_that("EventTable print method works", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ event_table <- EventTable(data = event_data)
+
+ # Test the show method (which S7 uses for printing)
+ expect_output(show(event_table), "EventTable with 2 rows")
+ expect_output(show(event_table), "Hypotheses: 2")
+ expect_output(show(event_table), "Analyses: 1")
+})
+
+test_that("subset_event_table works correctly", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 1, 2, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 1, 2, 2, 170
+ )
+
+ event_table <- EventTable(data = event_data)
+
+ # Subset by analysis
+ subset_a1 <- subset_event_table(event_table, analysis = 1)
+ expect_equal(subset_a1@n_analyses, 1L)
+ expect_equal(nrow(subset_a1@data), 3)
+
+ # Subset by hypotheses
+ subset_h1 <- subset_event_table(event_table, hypotheses = c(1))
+ expect_equal(nrow(subset_h1@data), 2) # Only H1-H1 pairs
+
+ # Error for non-EventTable input
+ expect_error(
+ subset_event_table(data.frame(), analysis = 1),
+ "x must be an EventTable object"
+ )
+})
+
+test_that("as_event_table conversion works", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ # Convert tibble to EventTable
+ event_table <- as_event_table(event_data)
+ expect_true(S7::S7_inherits(event_table, EventTable))
+
+ # Should return same object if already EventTable
+ event_table2 <- as_event_table(event_table)
+ expect_identical(event_table, event_table2)
+})
+
+test_that("validate_event_table_data works", {
+ # Valid data should pass
+ valid_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ expect_true(validate_event_table_data(valid_data))
+
+ # Invalid data should fail
+ invalid_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, # Missing Event column
+ 1, 1, 1,
+ 2, 2, 1
+ )
+
+ expect_error(
+ validate_event_table_data(invalid_data),
+ "Missing required columns: Event"
+ )
+})
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd
new file mode 100644
index 0000000..df94c1c
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/adj-seq-p.Rmd
@@ -0,0 +1,810 @@
+---
+title: "Adjusted sequential p-values"
+author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+# bibliography: "example.bib"
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Adjusted sequential p-values}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- \item $H_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
+
+```{r}
+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
+
+```{r}
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+The information fraction of $H_1, H_2, H_3$ at IA is
+
+```{r}
+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
+```
+
+We assign the initial weights of $H_1, H_2, H_3$ as$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+# 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)
+```
+
+```{r}
+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
+
+```{r}
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+```
+
+# Sequential p-value
+
+## IA
+
+```{r, wpgsdSeqIA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqIA, message=FALSE}
+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
+
+```{r, wpgsdSeqFA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqFA, message=FALSE}
+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
+
+```{r, wpgsdAdjSeqIA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqIA}
+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")
+```
+
+## FA
+
+### WPGSD
+```{r, wpgsdAdjSeqFA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqFA}
+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")
+```
+
+# Summary
+
+```{r}
+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()
+```
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd
new file mode 100644
index 0000000..df67ae9
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/corr_calculation.Rmd
@@ -0,0 +1,180 @@
+---
+title: "Correlated test statistics"
+author: "Chenguang Zhang, Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Correlated test statistics}
+bibliography: wpgsd.bib
+---
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+
+# Methodologies to calculate correlations
+
+Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
+
+We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix.
+
+Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
+$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$.
+
+# Examples
+
+We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be:
+
+In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B:
+
+* Biomarker A positive, the population 1,
+* Biomarker B positive, the population 2,
+* Overall population.
+
+The 3 primary elementary hypotheses are:
+
+* **H1**: the experimental treatment is superior to the control in the population 1
+* **H2**: the experimental treatment is superior to the control in the population 2
+* **H3**: 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. The number of events are listed as
+```{r,message=FALSE}
+library(dplyr)
+library(tibble)
+library(gt)
+```
+
+```{r}
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+```
+
+## Correlation of different populations within the same analysis
+Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$
+The number of events are listed as
+```{r}
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+```
+The the corrleation could be simply calculated as
+$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$
+```{r}
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses within the same population
+Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$
+The number of events are listed as
+```{r}
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+```
+The the corrleation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$
+The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1.
+```{r}
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses and different population
+Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$
+The number of events are listed as
+```{r}
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+```
+
+The correlation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$
+The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis.
+```{r}
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+```
+
+# Generate the correlation matrix by `generate_corr()`
+Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function.
+
+First, we need a event table including the information of the study.
+
+- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2;
+- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis;
+- `Event` is the common events overlap by `H1` and `H2`.
+
+For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis.
+
+Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160.
+
+To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`.
+```{r, message=FALSE}
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+```
+
+Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow.
+```{r}
+generate_corr(event)
+```
+
+# References
+
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css
new file mode 100644
index 0000000..3054002
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/custom.css
@@ -0,0 +1,122 @@
+body {
+ font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, "Helvetica Neue", Arial, "Noto Sans", "Liberation Sans", sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji";
+ font-size: 16px;
+ line-height: 1.5;
+ color: #000;
+ padding-top: 25px;
+ padding-bottom: 25px;
+}
+
+h1.title {
+ padding-bottom: 10px;
+}
+
+h1, h2, h3, h4, h5, h6 {
+ color: #000;
+ font-weight: 500;
+}
+
+h1.title {
+ font-size: 38px;
+}
+
+h1 {
+ font-size: 32px;
+}
+
+h2 {
+ font-size: 28px;
+}
+
+h3 {
+ font-size: 24px;
+}
+
+h4 {
+ font-size: 20px;
+}
+
+h5 {
+ font-size: 18px;
+}
+
+h6 {
+ font-size: 16px;
+}
+
+h4.author {
+ padding-bottom: 10px;
+}
+
+h4.author>em {
+ font-size: 14px;
+ font-style: normal;
+ font-weight: 300;
+}
+
+h4.date {
+ padding-bottom: 10px;
+}
+
+h4.date>em {
+ font-size: 14px;
+ font-style: normal;
+ font-weight: 300;
+}
+
+a {
+ color: #00857c;
+ text-decoration: none;
+}
+
+a:hover, a:focus, a:active {
+ color: #005c55;
+ text-decoration: underline;
+}
+
+a:focus {
+ outline: thin dotted;
+}
+
+a:hover, a:active {
+ outline: 0;
+}
+
+pre, code {
+ font-family: SFMono-Regular, Menlo, Monaco, Consolas, "Liberation Mono", "Courier New", monospace;
+ background-color: #F7F7F7;
+}
+
+/* selection */
+
+::-moz-selection {
+ background: #6eceb2;
+}
+
+::selection {
+ background: #6eceb2;
+}
+
+/* float toc */
+
+.list-group-item.active, .list-group-item.active:focus, .list-group-item.active:hover {
+ background-color: #00857C;
+ border-color: #00857C;
+}
+
+/* figure */
+
+div.figure {
+ text-align: center;
+}
+
+p.caption {
+ text-align: center;
+}
+
+.footnote {
+ position: absolute;
+ bottom: 3em;
+ padding-right: 4em;
+ color: #00857C;
+}
\ No newline at end of file
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png
new file mode 100644
index 0000000..d335b8f
Binary files /dev/null and b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/figures/ex1-pop.png differ
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/tech-detail-wb.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/tech-detail-wb.Rmd
new file mode 100644
index 0000000..1eec9cb
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/tech-detail-wb.Rmd
@@ -0,0 +1,599 @@
+---
+title: "Procedure to compute p-value boundaries by weighted Bonferroni"
+author: "Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- $H_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
+
+```{r}
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+```
+
+## Observed p-values
+
+```{r}
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+## Information fraction
+
+```{r}
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+```
+
+The information fraction of $H_1$, $H_2$, $H_3$ at IA is
+
+```{r}
+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
+```
+
+## Initial weight and transition matrix
+
+We assign the initial weights of $H_1$, $H_2$, $H_3$ as
+$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be
+propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected,
+then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+```
+
+```{r}
+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
+```
+
+```{r}
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+```
+
+```{r}
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+```
+
+## Correlations
+
+The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are
+
+```{r}
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+```
+
+# Boundary calculation
+
+## Boundary of $H_1$
+
+For the elementary hypothesis $H_1$, its weight is 1, namely,
+
+```{r}
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+```
+
+## Boundary of $H_2$
+
+For the elementary hypothesis $H_2$, its weight is 1, namely,
+
+```{r}
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_3$
+
+For the elementary hypothesis $H_3$, its weight is 1, namely,
+
+```{r}
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_2$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+```
+
+And the boundary for $H_1$ and $H_2$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+```
+
+And the boundary for $H_1$ and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_2 \cap H_3$
+
+For the interaction hypothesis $H_2 \cap H_3$, its weight is
+
+```{r}
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+```
+
+And the boundary for $H_2$ and $H_3$ are
+
+```{r}
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H1 \cap H_2 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+```
+
+And the boundary for $H_1$, $H_2$, and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+# Summary
+
+With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`.
+
+```{r}
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+```
+
+# Implementation in wpgsd
+
+The above results can be computed in one function call in wpgsd by using
+the `generate_bounds()` function as
+
+```{r}
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+```
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd
new file mode 100644
index 0000000..4771094
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.Rmd
@@ -0,0 +1,591 @@
+---
+title: "Quickstart guide"
+author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_depth: 3
+ toc_float: true
+ code_folding: hide
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+bibliography: wpgsd.bib
+vignette: >
+ %\VignetteIndexEntry{Quickstart guide}
+ %\VignetteEncoding{UTF-8}
+ %\VignetteEngine{knitr::rmarkdown}
+editor_options:
+ markdown:
+ wrap: 72
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+```
+
+```{r, message=FALSE, warning=FALSE}
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+```
+
+# Background
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
+
+# Methods and Examples
+
+## Closed Testing and Parametric Tests
+
+We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
+
+## Consonance
+
+A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
+
+## Group Sequential Design Notations and Assumptions
+
+- A set $I$ of hypotheses for $i \in I$.
+- $K$ group sequential analyses, $k = 1, \ldots, K$
+- Single endpoint
+ * Not required, and can be generalized
+- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$
+
+## Correlation Structure
+
+- Notation
+ * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$.
+ * Assume the same endpoint for all hypotheses (can be relaxed)
+ * For binary or continuous outcomes $n_{ik}$ represents sample size
+ * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$
+ * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$.
+- Key result
+ $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$
+- Proof builds on standard group sequential theory (@chen2021multiplicity)
+
+## Example 1: Overlapping Populations, Two Analyses
+
+Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified.
+
+```{r, eval=FALSE, echo=FALSE}
+library(ggplot2)
+library(ggforce)
+
+ellipse_data <- data.frame(
+ id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+ x = c(0, 1, 0.5),
+ y = c(0, 0, 0),
+ a = c(1, 1, 2),
+ b = c(0.5, 0.5, 1)
+)
+
+ragg::agg_png(
+ "vignettes/figures/ex1-pop.png",
+ width = 1920,
+ height = 1920 / 1.618,
+ res = 96,
+ scaling = 2
+)
+ggplot() +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+ color = NA, alpha = 0.5, show.legend = FALSE
+ ) +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+ color = NA, alpha = 0.85, show.legend = FALSE
+ ) +
+ geom_text(aes(
+ x = x, y = y, label = id,
+ hjust = ifelse(id == "H1: Population 1", 1.1,
+ ifelse(id == "H2: Population 2", -0.1, 0.5)
+ ),
+ vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+ ), data = ellipse_data, size = 6) +
+ scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+ coord_fixed() +
+ theme_void()
+dev.off()
+```
+
+```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"}
+knitr::include_graphics("figures/ex1-pop.png")
+```
+
+The multiplicity strategy is defined as follows.
+
+```{r, out.width="80%"}
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+```
+
+The event count of each hypothesis at each analysis is shown below.
+
+| Population | Number of Events at IA | Number of Events at FA |
+|:---------------------:|:----------------------:|:----------------------:|
+| Population 1 | 100 | 200 |
+| Population 2 | 110 | 220 |
+| Population 1 $\cap$ 2 | 80 | 160 |
+| Overall Population | 225 | 450 |
+
+Table: Number of events at each analysis for each population in Example 1.
+IA: interim analysis. FA: final analysis.
+
+The correlation matrix among test statistics is as follows.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ |
+| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ |
+| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ |
+| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ |
+| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ |
+| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 |
+
+Table: Correlation Matrix of Test Statistics for Example 1.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Example 2: Common Control, Two Analyses
+
+Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified.
+
+```{r, out.width="80%", echo = FALSE}
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+```
+
+| Treatment Arm | Number of Events at IA | Number of Events at FA |
+|:--------------:|:----------------------:|:----------------------:|
+| Experimental 1 | 70 | 135 |
+| Experimental 2 | 75 | 150 |
+| Experimental 3 | 80 | 165 |
+| Control | 85 | 170 |
+
+Table: Number of events at each analysis for each treatment arm in Example 2.
+IA: interim analysis. FA: final analysis.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ |
+| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ |
+| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ |
+| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ |
+| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ |
+| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 |
+
+Table: Correlation Matrix for Example 2.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Hypotheses Set
+
+These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 |
+| $H_1 \cap H_2$ | 0.5 | 0.5 | - |
+| $H_1 \cap H_3$ | 0.3 | - | 0.7 |
+| $H_2 \cap H_3$ | - | 0.3 | 0.7 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 1.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 |
+| $H_1 \cap H_2$ | 1/2 | 1/2 | - |
+| $H_1 \cap H_3$ | 1/2 | - | 1/2 |
+| $H_2 \cap H_3$ | - | 1/2 | 1/2 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 2.
+
+## $\alpha$ Spending: 3 approaches
+
+The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed:
+
+- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
+
+- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$.
+
+- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$.
+
+## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis)
+
+- Assume ($Z_1,Z_2$) bivariate normal with known correlation
+
+- Find $\alpha$-inflation factor $c_J$ such that
+ $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$
+
+- Basic algorithm code in @bretz2011graphical
+
+### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$.
+
+ ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$.
+
+ iii Compute type I error rate up to analysis $k$
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$
+
+ iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$
+
+ v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020).
+
+### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$.
+
+ ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$
+
+ iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$
+
+ iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020).
+
+## Implementation of Example 1 with Overlapping Populations
+
+We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows:
+
+- Analysis: Analysis number (1 for interim, 2 for final).
+- Event: Event counts.
+- H1, H2: Hypotheses intersected.
+ * (1, 1) represents counts for hypothesis 1
+ * (1, 2) for counts for the intersection of hypotheses 1 and 2
+
+```{r}
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+```
+
+Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests.
+
+```{r}
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type.
+
+- 0 = Bonferroni. Separate alpha spending for each hypotheses.
+- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+
+Compute Bonferroni bounds.
+
+```{r}
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+```
+
+Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions.
+
+```{r}
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+```
+
+Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
+
+```{r, echo=FALSE}
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+Closed testing procedure can then be performed using `closed_test()`.
+
+```{r}
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+```
+
+```{r}
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+```
+
+## Implementation of Example 2 with Common Control
+
+Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper.
+
+```{r}
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+```{r}
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+## Power Considerations
+
+The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development.
+
+# Conclusions
+
+The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds
+and improved power compared to the Bonferroni approach.
+
+# References
diff --git a/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib
new file mode 100644
index 0000000..0285346
--- /dev/null
+++ b/wpgsd.Rcheck/00_pkg_src/wpgsd/vignettes/wpgsd.bib
@@ -0,0 +1,53 @@
+@article{anderson2022unified,
+ title = {A unified framework for weighted parametric group sequential design},
+ author = {Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z},
+ journal = {Biometrical Journal},
+ volume = {64},
+ number = {7},
+ pages = {1219--1239},
+ year = {2022},
+ publisher = {Wiley Online Library}
+}
+
+@article{bretz2011graphical,
+ title = {Graphical approaches for multiple comparison procedures using weighted Bonferroni, Simes, or parametric tests},
+ author = {Bretz, Frank and Posch, Martin and Glimm, Ekkehard and Klinglmueller, Florian and Maurer, Willi and Rohmeyer, Kornelius},
+ journal = {Biometrical Journal},
+ volume = {53},
+ number = {6},
+ pages = {894--913},
+ year = {2011},
+ publisher = {Wiley Online Library}
+}
+
+@article{chen2021multiplicity,
+ title = {Multiplicity for a group sequential trial with biomarker subpopulations},
+ author = {Chen, Ting-Yu and Zhao, Jing and Sun, Linda and Anderson, Keaven M},
+ journal = {Contemporary Clinical Trials},
+ volume = {101},
+ pages = {106249},
+ year = {2021},
+ publisher = {Elsevier}
+}
+
+@article{maurer2013multiple,
+ title = {Multiple testing in group sequential trials using graphical approaches},
+ author = {Maurer, Willi and Bretz, Frank},
+ journal = {Statistics in Biopharmaceutical Research},
+ volume = {5},
+ number = {4},
+ pages = {311--320},
+ year = {2013},
+ publisher = {Taylor \& Francis}
+}
+
+@article{xi2017unified,
+ title = {A unified framework for weighted parametric multiple test procedures},
+ author = {Xi, Dong and Glimm, Ekkehard and Maurer, Willi and Bretz, Frank},
+ journal = {Biometrical Journal},
+ volume = {59},
+ number = {5},
+ pages = {918--931},
+ year = {2017},
+ publisher = {Wiley Online Library}
+}
\ No newline at end of file
diff --git a/wpgsd.Rcheck/00check.log b/wpgsd.Rcheck/00check.log
new file mode 100644
index 0000000..3d59ff8
--- /dev/null
+++ b/wpgsd.Rcheck/00check.log
@@ -0,0 +1,89 @@
+* using log directory ‘/Users/Anderkea/Documents/GitHub/wpgsd/wpgsd.Rcheck’
+* using R version 4.5.0 (2025-04-11)
+* using platform: aarch64-apple-darwin20
+* R was compiled by
+ Apple clang version 14.0.0 (clang-1400.0.29.202)
+ GNU Fortran (GCC) 14.2.0
+* running under: macOS Sequoia 15.6
+* using session charset: UTF-8
+* using option ‘--no-manual’
+* checking for file ‘wpgsd/DESCRIPTION’ ... OK
+* this is package ‘wpgsd’ version ‘0.1.0’
+* package encoding: UTF-8
+* checking package namespace information ... OK
+* checking package dependencies ... OK
+* checking if this is a source package ... OK
+* checking if there is a namespace ... OK
+* checking for executable files ... OK
+* checking for hidden files and directories ... OK
+* checking for portable file names ... WARNING
+Found the following file with a non-portable file name:
+ inst/aiprompts/s7 prompts.md
+These are not fully portable file names.
+See section ‘Package structure’ in the ‘Writing R Extensions’ manual.
+* checking for sufficient/correct file permissions ... OK
+* checking whether package ‘wpgsd’ can be installed ... OK
+* checking installed package size ... INFO
+ installed size is 5.0Mb
+ sub-directories of 1Mb or more:
+ doc 4.7Mb
+* checking package directory ... OK
+* checking ‘build’ directory ... OK
+* checking DESCRIPTION meta-information ... NOTE
+Package listed in more than one of Depends, Imports, Suggests, Enhances:
+ ‘S7’
+A package should be listed in only one of these fields.
+* checking top-level files ... OK
+* checking for left-over files ... OK
+* checking index information ... OK
+* checking package subdirectories ... OK
+* checking code files for non-ASCII characters ... OK
+* checking R files for syntax errors ... OK
+* checking whether the package can be loaded ... OK
+* checking whether the package can be loaded with stated dependencies ... OK
+* checking whether the package can be unloaded cleanly ... OK
+* checking whether the namespace can be loaded with stated dependencies ... OK
+* checking whether the namespace can be unloaded cleanly ... OK
+* checking loading without being on the library search path ... OK
+* checking dependencies in R code ... NOTE
+Package in Depends field not imported from: ‘S7’
+ These packages need to be imported from (in the NAMESPACE file)
+ for when this namespace is loaded but not attached.
+* checking S3 generic/method consistency ... OK
+* checking replacement functions ... OK
+* checking foreign function calls ... OK
+* checking R code for possible problems ... OK
+* checking Rd files ... OK
+* checking Rd metadata ... OK
+* checking Rd cross-references ... OK
+* checking for missing documentation entries ... OK
+* checking for code/documentation mismatches ... OK
+* checking Rd \usage sections ... OK
+* checking Rd contents ... OK
+* checking for unstated dependencies in examples ... OK
+* checking installed files from ‘inst/doc’ ... OK
+* checking files in ‘vignettes’ ... OK
+* checking examples ... OK
+* checking for unstated dependencies in ‘tests’ ... OK
+* checking tests ... ERROR
+ Running ‘testthat.R’
+Running the tests in ‘tests/testthat.R’ failed.
+Last 13 lines of output:
+ 1. └─testthat::expect_output(show(event_table), "Hypotheses: 2") at test-s7-event-table.R:101:3
+ 2. └─testthat::expect_match(...)
+ 3. └─testthat:::expect_match_(...)
+ ── Failure ('test-s7-event-table.R:102:3'): EventTable print method works ──────
+ `show\(event_table\)` does not match "Analyses: 1".
+ Actual value: "
+
+
+[](https://github.com/Merck/wpgsd/actions/workflows/R-CMD-check.yaml)
+[](https://app.codecov.io/gh/Merck/wpgsd?branch=main)
+
+
+Weighted parametric group sequential design (WPGSD) allows one to take advantage
+of the known correlation structure in constructing efficacy bounds to control
+family-wise error rate (FWER) for a group sequential design. Here correlation
+may be due to common observations in nested populations, due to common
+observations in overlapping populations, or due to common observations
+in the control arm.
+
+## Installation
+
+The easiest way to get wpgsd is to install from CRAN:
+
+```r
+install.packages("wpgsd")
+```
+
+Alternatively, to use a new feature or get a bug fix,
+you can install the development version of wpgsd from GitHub:
+
+```r
+# install.packages("remotes")
+remotes::install_github("Merck/wpgsd")
+```
+
+## Current limitations
+
+There are some limitations that are currently being addressed.
+Please use the package with caution in production environments.
+
+- The current implementation may have limitations when handling more
+ complex scenarios beyond what has been demonstrated.
+- The API is subject to potential breaking changes as it is currently
+ being reviewed and refactored.
+- Further validation is needed to ensure the reliability of the package.
+- More documentation is expected in the future releases.
+
+## References
+
+Anderson, K. M., Guo, Z., Zhao, J., & Sun, L. Z. (2022).
+A unified framework for weighted parametric group sequential design.
+_Biometrical Journal_, 64(7), 1219--1239.
+
+BibTeX entry:
+
+```
+@article{anderson2022unified,
+ title = {A unified framework for weighted parametric group sequential design},
+ author = {Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z},
+ journal = {Biometrical Journal},
+ volume = {64},
+ number = {7},
+ pages = {1219--1239},
+ year = {2022},
+ publisher = {Wiley Online Library}
+}
+```
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb b/wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb
new file mode 100644
index 0000000..c78d6ee
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/build/partial.rdb differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds b/wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds
new file mode 100644
index 0000000..5ec4d87
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/build/vignette.rds differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R b/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R
new file mode 100644
index 0000000..06fb2b6
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/examples/event_table_integration.R
@@ -0,0 +1,71 @@
+# Example integration of EventTable S7 class with existing wpgsd functions
+# This shows how EventTable can work with generate_corr()
+
+library(wpgsd)
+library(tibble)
+
+# Example 1: Using EventTable with generate_corr()
+# Create event data using the EventTable class
+event_data_raw <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Create EventTable object
+event_table <- EventTable(data = event_data_raw)
+print("Created EventTable:")
+print(event_table)
+
+# Use with generate_corr (currently expects tibble/data.frame)
+# The @data slot extracts the underlying tibble
+correlation_matrix <- generate_corr(event_table@data)
+print("Generated correlation matrix:")
+print(correlation_matrix)
+
+# Example 2: Data validation before processing
+cat("\nExample 2: Data validation\n")
+cat("==========================\n")
+
+# Try to create EventTable with invalid data
+tryCatch({
+ invalid_data <- tibble::tibble(
+ H1 = c(1, 2, -1), # Invalid: negative hypothesis index
+ H2 = c(1, 2, 3),
+ Analysis = c(1, 1, 1),
+ Event = c(100, 200, 150)
+ )
+
+ invalid_table <- EventTable(data = invalid_data)
+}, error = function(e) {
+ cat("Validation caught error:", e$message, "\n")
+})
+
+# Example 3: Subsetting capabilities
+cat("\nExample 3: Subsetting\n")
+cat("=====================\n")
+
+# Get only first analysis
+analysis_1 <- subset_event_table(event_table, analysis = 1)
+cat("Analysis 1 events:\n")
+print(analysis_1@data)
+
+# Get only H1-H2 hypothesis pairs
+h1_h2_events <- subset_event_table(event_table, hypotheses = c(1, 2))
+cat("\nH1-H2 hypothesis events:\n")
+print(h1_h2_events@data)
+
+# Example 4: Summary information
+cat("\nExample 4: Summary\n")
+cat("==================\n")
+summary(event_table)
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R b/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R
new file mode 100644
index 0000000..d55ecbf
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/examples/test_event_table.R
@@ -0,0 +1,50 @@
+# Test script for EventTable S7 class
+# This demonstrates how to use the new EventTable class
+
+library(wpgsd)
+library(tibble)
+
+# Create sample event data as used in the package
+event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Create EventTable object
+event_table <- EventTable(data = event_data)
+
+# Print the object
+print(event_table)
+
+# Get summary
+summary(event_table)
+
+# Subset by analysis
+subset_analysis_1 <- subset_event_table(event_table, analysis = 1)
+print("Analysis 1 subset:")
+print(subset_analysis_1)
+
+# Subset by hypotheses
+subset_h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2))
+print("H1-H2 subset:")
+print(subset_h1_h2)
+
+# Convert existing tibble to EventTable
+converted_table <- as_event_table(event_data)
+print("Converted table:")
+print(converted_table)
+
+# Validate data
+validate_event_table_data(event_data)
+print("Data validation passed!")
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION b/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION
new file mode 100644
index 0000000..4cf24a4
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/CITATION
@@ -0,0 +1,12 @@
+bibentry(
+ "Article",
+ title = "A unified framework for weighted parametric group sequential design",
+ author = "Keaven M Anderson and Zifang Guo and Jing Zhao and Linda Z Sun",
+ journal = "Biometrical Journal",
+ volume = "64",
+ number = "7",
+ pages = "1219--1239",
+ year = "2022",
+ publisher = "Wiley Online Library",
+ doi = "10.1002/bimj.202100085",
+)
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt
new file mode 100644
index 0000000..6c9d599
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/compute_correlations_prompts.txt
@@ -0,0 +1,76 @@
+Three functions are defined here, one for checking input data (`check_event_data()`) and
+another for computing correlations (`compute_correlations()`) and one (`gen_corr()`) for transforming a data frame where correlations are computed
+to a correlation matrix.
+All three should be exported.
+When users enter the `event` input to `compute_correlations()`, it is advised to call `check_event_data()` first by
+specifying check = TRUE (the default).
+Output will be output either as a data frame or as a correlation matrix, as specified below.
+An exported function `gen_corr()` will do a transformation from the data frame output to a symmetric matrix.
+
+Let M > 1 be the integer number of hypotheses to be tested.
+Assume there are integer K > 1 analyses.
+Let real-valued Z[i, k] be the standardized normal test statistic for
+hypothesis i, 1 <= i <= M, analysis k, 1 <= k <= K.
+We wish to compute and return correlations for all hypothesis tests
+performed across analyses.
+For tests Z[i1, k1], Z[i2, k2], 1 <= i1 <= i2 <= M, 1 <= k1 <= k2 <= K that are
+performed we will provide the count of events (for time-to-event outcomes) or
+sample size (for other outcomes) that are common between the two tests.
+This is input in a data frame called `event`
+with the following columns:
+
+`H1` - hypothesis i1 = H1
+`H2` - hypothesis i2 = H2
+`Analysis` - value in 1,2,...,K
+`Event` - event count for time-to-event endpoints, otherwise sample size which
+is included in the both test Z[H1, Analysis] and Z[H2, Analysis].
+
+Other arguments for `compute_correlations()` are
+
+`check` - logical indicating whether to perform input checks using `check_event_data()` (default is TRUE)
+`return_matrix` - logical indicating whether to return a correlation matrix (default is TRUE)
+
+The function `check_event_data()` will have the argument `event` as specified above.
+Data checks in `check_event_data()` :
+- Check that `event` is a data frame and return an informative error message if not.
+- Check that columns specified above exist and return informative error message, if not.
+- Check that H1 <= H2 for each row and provide informative error message, if not.
+- Check that the combination of H1, H2, Analysis is a unique in the input;
+this should be evaluated and appropriate error message returned if not unique.
+Check that Event is an integer >= 0 for all rows and provide an
+appropriate error message, if not.
+- Check that unique values of Analysis are sequential positive integers with
+minimum value 1 and maximum value > 1; K from above will be the maximum value.
+Return an informative error message if any of these checks fail.
+- Check that unique values of H1 are sequential integers with minimum value 1
+and maximum value > 1; M from above will be the maximum value.
+Same for H2.
+Return an informative error message if any of these checks fail.
+- Check that for k=1,...,K that if there is a row with H1 < H2, then there is also a row with H1 == H2.
+Return an informative error message if not.
+- Check that for any value of Analysis, and H1 = i1 < H2 = i2 specified that there is also a row with H1 = i1, H2 = i1 and another with
+H1 = i2, H2 = i2. Return an informative error message if not.
+
+
+Returned value from `compute_correlations()`.
+The returned value either a data frame (if `return_matrix = FALSE`) or a correlation matrix, otherwise.
+The data frame has the following columns.
+ H1 - hypothesis i1
+ H2 - hypothesis i2 >= i1
+ Analysis1 - k1.
+ Analysis2 - k2 >= k1.
+ Correlation - correlation between Z[i1, k1] and Z[i2, k2].
+
+Correlation is computed as
+Event for i1, i2 and k1 divided by square root of the product of
+Event for H1 = i1, H2 = i1, Analysis = min(k1, k2) times
+Event for H1 = i2, H2 = i2, Analysis = k2.
+
+If `return_ matrix = TRUE` (default) then a symmetric matrix should be returned as follows.
+Columns should be named `H1_A1`, `H1_A2`, ..., `H1_AK`, `H2_A1`, `H2_A2`, ..., `H2_AK`, ..., `HM_A1`, `HM_A2`, ..., `HM_AK` where
+M and K are as computed from `event`.
+Rows should be labeled the same way.
+Diagonal elements are all 1.
+Off-diagonal elements are filled with the computed correlations.
+Only cells included should be where `Event` value was provided for the combination of Analysis, H1 and H2.
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md
new file mode 100644
index 0000000..69bae54
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/aiprompts/s7 prompts.md
@@ -0,0 +1,101 @@
+## Prompt for s7 Class conversion
+
+We want to convert the wpgsd R package to operate with s7 classes throughout.
+Please check for exported functions in the R directory suggest what s7 classes need to be developed.
+
+## Suggested S7 Classes for wpgsd Package Conversion
+
+Based on the exported functions and their data structures, here are the key S7 classes that should be developed:
+
+### 1. **EventTable Class**
+- **Purpose**: Represents event count data structure used in `generate_corr()` and `generate_event_table()`
+- **Key Fields**:
+ - `H1`, `H2`: Hypothesis indices
+ - `Analysis`: Analysis number
+ - `Event`: Event count
+- **Methods**: Validation, printing, subsetting
+
+### 2. **CorrelationMatrix Class**
+- **Purpose**: Represents correlation matrices returned by `generate_corr()`
+- **Key Fields**:
+ - `matrix`: The correlation matrix
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+ - `column_names`: Named columns (e.g., "H1_A1", "H2_A1", etc.)
+- **Methods**: Validation (positive definite), printing, subsetting
+
+### 3. **TransitionMatrix Class**
+- **Purpose**: Represents transition matrices used in graphical procedures
+- **Key Fields**:
+ - `matrix`: The transition matrix
+ - `n_hypotheses`: Number of hypotheses
+- **Methods**: Validation (row sums ≤ 1), printing
+
+### 4. **Bounds Class**
+- **Purpose**: Represents p-value boundaries from `generate_bounds()`
+- **Key Fields**:
+ - `data`: Tibble with Analysis, Hypotheses, H1, H2, etc., xi columns
+ - `type`: Boundary type (0, 1, 2, or 3)
+ - `alpha`: Overall alpha level
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+- **Methods**: Validation, printing, plotting
+
+### 5. **ObservedPValues Class**
+- **Purpose**: Represents observed p-values for `closed_test()`
+- **Key Fields**:
+ - `data`: Tibble with Analysis, H1, H2, etc. columns
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of analyses
+- **Methods**: Validation, printing
+
+### 6. **ClosedTestResult Class**
+- **Purpose**: Represents results from `closed_test()`
+- **Key Fields**:
+ - `outcome_matrix`: Matrix summarizing testing results
+ - `bounds`: Associated bounds used
+ - `p_obs`: Observed p-values used
+ - `rejected_hypotheses`: List of rejected hypotheses by analysis
+- **Methods**: Validation, printing, summary
+
+### 7. **StudyDesign Class**
+- **Purpose**: High-level class to encapsulate entire study design
+- **Key Fields**:
+ - `initial_weights`: Vector of initial hypothesis weights
+ - `transition_matrix`: TransitionMatrix object
+ - `n_hypotheses`: Number of hypotheses
+ - `n_analyses`: Number of planned analyses
+ - `alpha`: Overall alpha level
+ - `spending_functions`: List of spending functions
+- **Methods**: Validation, printing, summary
+
+### 8. **SequentialPValue Class**
+- **Purpose**: Represents sequential p-values from `calc_seq_p()`
+- **Key Fields**:
+ - `value`: The sequential p-value
+ - `test_analysis`: Analysis index
+ - `test_hypothesis`: Hypothesis being tested
+ - `method_type`: Alpha spending type used
+- **Methods**: Validation, printing
+
+## Implementation Benefits
+
+1. **Type Safety**: S7 classes provide strong typing and validation
+2. **Method Dispatch**: Can implement specialized methods for each class
+3. **Consistency**: Standardized data structures across the package
+4. **User Experience**: Better error messages and documentation
+5. **Extensibility**: Easy to add new methods and functionality
+
+## Migration Strategy
+
+1. Start with core data structures (`EventTable`, `CorrelationMatrix`)
+2. Update `generate_corr()` to return `CorrelationMatrix` objects
+3. Update `generate_bounds()` to return `Bounds` objects
+4. Progressively convert other functions
+5. Ensure backward compatibility during transition
+6. Update documentation and vignettes
+
+This S7 class structure would provide a solid foundation for the wpgsd package while maintaining the existing functionality and improving the user experience with better type safety and method dispatch.
+
+Claude Sonnet 4 running under VSCode returned the following:
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R
new file mode 100644
index 0000000..63d7cc2
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.R
@@ -0,0 +1,739 @@
+## ----message = FALSE, warning = FALSE-----------------------------------------
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+
+## -----------------------------------------------------------------------------
+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,
+)
+
+## -----------------------------------------------------------------------------
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+# 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
+
+## -----------------------------------------------------------------------------
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+
+## ----wpgsdSeqIA, message=FALSE------------------------------------------------
+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)
+)
+
+## ----weightedBonferroniSeqIA, message=FALSE-----------------------------------
+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)
+)
+
+## ----wpgsdSeqFA, message=FALSE------------------------------------------------
+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)
+)
+
+## ----weightedBonferroniSeqFA, message=FALSE-----------------------------------
+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)
+)
+
+## ----wpgsdAdjSeqIA------------------------------------------------------------
+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")
+
+## ----weightedBonferroniAdjSeqIA-----------------------------------------------
+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")
+
+## ----wpgsdAdjSeqFA------------------------------------------------------------
+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")
+
+## ----weightedBonferroniAdjSeqFA-----------------------------------------------
+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")
+
+## -----------------------------------------------------------------------------
+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()
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd
new file mode 100644
index 0000000..df94c1c
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.Rmd
@@ -0,0 +1,810 @@
+---
+title: "Adjusted sequential p-values"
+author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+# bibliography: "example.bib"
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Adjusted sequential p-values}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- \item $H_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
+
+```{r}
+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
+
+```{r}
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+The information fraction of $H_1, H_2, H_3$ at IA is
+
+```{r}
+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
+```
+
+We assign the initial weights of $H_1, H_2, H_3$ as$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+# 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)
+```
+
+```{r}
+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
+
+```{r}
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+```
+
+# Sequential p-value
+
+## IA
+
+```{r, wpgsdSeqIA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqIA, message=FALSE}
+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
+
+```{r, wpgsdSeqFA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqFA, message=FALSE}
+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
+
+```{r, wpgsdAdjSeqIA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqIA}
+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")
+```
+
+## FA
+
+### WPGSD
+```{r, wpgsdAdjSeqFA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqFA}
+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")
+```
+
+# Summary
+
+```{r}
+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()
+```
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html
new file mode 100644
index 0000000..0236e45
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/adj-seq-p.html
@@ -0,0 +1,3399 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R
new file mode 100644
index 0000000..9b8c02d
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.R
@@ -0,0 +1,86 @@
+## ----message=FALSE------------------------------------------------------------
+library(dplyr)
+library(tibble)
+library(gt)
+
+## -----------------------------------------------------------------------------
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+
+## -----------------------------------------------------------------------------
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+
+## -----------------------------------------------------------------------------
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+
+## -----------------------------------------------------------------------------
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+
+## -----------------------------------------------------------------------------
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+
+## ----message=FALSE------------------------------------------------------------
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+
+## -----------------------------------------------------------------------------
+generate_corr(event)
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd
new file mode 100644
index 0000000..df67ae9
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.Rmd
@@ -0,0 +1,180 @@
+---
+title: "Correlated test statistics"
+author: "Chenguang Zhang, Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Correlated test statistics}
+bibliography: wpgsd.bib
+---
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+
+# Methodologies to calculate correlations
+
+Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
+
+We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix.
+
+Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
+$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$.
+
+# Examples
+
+We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be:
+
+In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B:
+
+* Biomarker A positive, the population 1,
+* Biomarker B positive, the population 2,
+* Overall population.
+
+The 3 primary elementary hypotheses are:
+
+* **H1**: the experimental treatment is superior to the control in the population 1
+* **H2**: the experimental treatment is superior to the control in the population 2
+* **H3**: 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. The number of events are listed as
+```{r,message=FALSE}
+library(dplyr)
+library(tibble)
+library(gt)
+```
+
+```{r}
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+```
+
+## Correlation of different populations within the same analysis
+Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$
+The number of events are listed as
+```{r}
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+```
+The the corrleation could be simply calculated as
+$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$
+```{r}
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses within the same population
+Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$
+The number of events are listed as
+```{r}
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+```
+The the corrleation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$
+The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1.
+```{r}
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses and different population
+Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$
+The number of events are listed as
+```{r}
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+```
+
+The correlation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$
+The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis.
+```{r}
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+```
+
+# Generate the correlation matrix by `generate_corr()`
+Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function.
+
+First, we need a event table including the information of the study.
+
+- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2;
+- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis;
+- `Event` is the common events overlap by `H1` and `H2`.
+
+For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis.
+
+Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160.
+
+To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`.
+```{r, message=FALSE}
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+```
+
+Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow.
+```{r}
+generate_corr(event)
+```
+
+# References
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html
new file mode 100644
index 0000000..28c00f5
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/corr_calculation.html
@@ -0,0 +1,4137 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Adjusted sequential p-values
+Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson
+ +library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+
+1 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:
+-
+
- \(H_1\): the experimental treatment +is superior to the control in the biomarker A positive population; +
- \(H_2\): the experimental treatment +is superior to the control in the biomarker B positive population; +
- \(H_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_pThe information fraction of \(H_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.5We assign the initial weights of \(H_1, +H_2, H_3\) as\(\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 \(H_1\) is +rejected, then \(3/7\) local +significance level \(\alpha_1\) will be +propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_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
+
+2 Sequential p-value
+
+
+2.1 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)
+)
+
+2.2 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)
+)
+
+3 Adjusted-Sequential +p-value
+
+
+3.1 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.1942751 0.1942751 0.1942751adj_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
+
+3.2 FA
+
+
+3.2.1 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.02097944 0.02097944 0.02063497adj_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
+
+
+
+
+4 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.0206 | +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.0206 |
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R
new file mode 100644
index 0000000..81d0f9a
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.R
@@ -0,0 +1,477 @@
+## ----message = FALSE, warning = FALSE-----------------------------------------
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+
+## -----------------------------------------------------------------------------
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+
+## -----------------------------------------------------------------------------
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+## -----------------------------------------------------------------------------
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+
+## -----------------------------------------------------------------------------
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+
+## -----------------------------------------------------------------------------
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+
+## -----------------------------------------------------------------------------
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+
+## -----------------------------------------------------------------------------
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+
+## -----------------------------------------------------------------------------
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+
+## -----------------------------------------------------------------------------
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+
+## -----------------------------------------------------------------------------
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd
new file mode 100644
index 0000000..1eec9cb
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.Rmd
@@ -0,0 +1,599 @@
+---
+title: "Procedure to compute p-value boundaries by weighted Bonferroni"
+author: "Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- $H_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
+
+```{r}
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+```
+
+## Observed p-values
+
+```{r}
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+## Information fraction
+
+```{r}
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+```
+
+The information fraction of $H_1$, $H_2$, $H_3$ at IA is
+
+```{r}
+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
+```
+
+## Initial weight and transition matrix
+
+We assign the initial weights of $H_1$, $H_2$, $H_3$ as
+$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be
+propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected,
+then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+```
+
+```{r}
+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
+```
+
+```{r}
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+```
+
+```{r}
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+```
+
+## Correlations
+
+The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are
+
+```{r}
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+```
+
+# Boundary calculation
+
+## Boundary of $H_1$
+
+For the elementary hypothesis $H_1$, its weight is 1, namely,
+
+```{r}
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+```
+
+## Boundary of $H_2$
+
+For the elementary hypothesis $H_2$, its weight is 1, namely,
+
+```{r}
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_3$
+
+For the elementary hypothesis $H_3$, its weight is 1, namely,
+
+```{r}
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_2$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+```
+
+And the boundary for $H_1$ and $H_2$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+```
+
+And the boundary for $H_1$ and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_2 \cap H_3$
+
+For the interaction hypothesis $H_2 \cap H_3$, its weight is
+
+```{r}
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+```
+
+And the boundary for $H_2$ and $H_3$ are
+
+```{r}
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H1 \cap H_2 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+```
+
+And the boundary for $H_1$, $H_2$, and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+# Summary
+
+With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`.
+
+```{r}
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+```
+
+# Implementation in wpgsd
+
+The above results can be computed in one function call in wpgsd by using
+the `generate_bounds()` function as
+
+```{r}
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+```
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html
new file mode 100644
index 0000000..63b3a07
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/tech-detail-wb.html
@@ -0,0 +1,7117 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Correlated test statistics
+Chenguang Zhang, Yujie Zhao
+ +The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to +take advantage of the known correlation structure in constructing +efficacy bounds to control family-wise error rate (FWER) for a group +sequential design. Here correlation may be due to common observations in +nested populations, due to common observations in overlapping +populations, or due to common observations in the control arm.
+
+
+1 Methodologies to +calculate correlations
+Suppose that in a group sequential trial there are \(m\) elementary null hypotheses \(H_i\), \(i \in +I={1,...,m}\), and there are \(K\) analyses. Let \(k\) be the index for the interim analyses +and final analyses, \(k=1,2,...K\). For +any nonempty set \(J \subseteq I\), we +denote the intersection hypothesis \(H_J=\cap_{j \in J}H_j\). We note that \(H_I\) is the global null hypothesis.
+We assume the plan is for all hypotheses to be tested at each of the +\(k\) planned analyses if the trial +continues to the end for all hypotheses. We further assume that the +distribution of the \(m \times K\) +tests of \(m\) individual hypotheses at +all \(k\) analyses is multivariate +normal with a completely known correlation matrix.
+Let \(Z_{ik}\) be the standardized +normal test statistic for hypothesis \(i \in +I\), analysis \(1 \le k \le K\). +Let \(n_{ik}\) be the number of events +collected cumulatively through stage \(k\) for hypothesis \(i\). Then \(n_{i +\wedge i',k \wedge k'}\) is the number of events included +in both \(Z_{ik}\) and \(i\), \(i' \in +I\), \(1 \le k\), \(k' \le K\). The key of the parametric +tests to utilize the correlation among the test statistics. The +correlation between \(Z_{ik}\) and +\(Z_{i'k'}\) is \[Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge +i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}\].
+
+
+2 Examples
+We borrow an example from a paper by Anderson et al. (Anderson et al. (2022)), demonstrated in Section +2 - Motivating Examples, we use Example 1 as the basis here. The setting +will be:
+In a two-arm controlled clinical trial with one primary endpoint, +there are three patient populations defined by the status of two +biomarkers, A and B:
+-
+
- Biomarker A positive, the population 1, +
- Biomarker B positive, the population 2, +
- Overall population. +
The 3 primary elementary hypotheses are:
+-
+
- H1: the experimental treatment is superior to the +control in the population 1 +
- H2: the experimental treatment is superior to the +control in the population 2 +
- H3: 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. The number of events are listed as
+library(dplyr)
+library(tibble)
+library(gt)event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+
+
+
+
+
+| Number of events at each population | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
| Population 2 | +110 | +220 |
| Overlap of Population 1 and 2 | +80 | +160 |
| Overall Population | +225 | +450 |
+
+2.1 Correlation of +different populations within the same analysis
+Let’s consider a simple situation, we want to compare the population +1 and population 2 in only interim analyses. Then \(k=1\), and to compare \(H_{1}\) and \(H_{2}\), the \(i\) will be \(i=1\) and \(i=2\). The correlation matrix will be \[Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge +1}}{\sqrt{n_{11}*n_{21}}}\] The number of events are listed +as
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+
+
+
+
+
+| Number of events at each population in example 1 | +|
| Population | +Number of Event in IA | +
|---|---|
| Population 1 | +100 |
| Population 2 | +110 |
| Overlap in population 1 and 2 | +80 |
The the corrleation could be simply calculated as \[Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76\]
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)## [1] 0.76
+
+2.2 Correlation of +different analyses within the same population
+Let’s consider another simple situation, we want to compare single +population, for example, the population 1, but in different analyses, +interim and final analyses. Then \(i=1\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge +2}}{\sqrt{n_{11}*n_{12}}}\] The number of events are listed +as
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+
+
+
+
+
+| Number of events at each analyses in example 2 | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
The the corrleation could be simply calculated as \[\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71\] +The 100 in the numerator is the overlap number of events of interim +analysis and final analysis in population 1.
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)## [1] 0.71
+
+2.3 Correlation of +different analyses and different population
+Let’s consider the situation that we want to compare population 1 in +interim analyses and population 2 in final analyses. Then for different +population, \(i=1\) and \(i=2\), and to compare IA and FA, the \(k\) will be \(k=1\) and \(k=2\). The correlation matrix will be \[\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 +\wedge 2}}{\sqrt{n_{11}*n_{22}}}\] The number of events are +listed as
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+
+
+
+
+
+| Number of events at each population & analyses in example 3 | +||
| Population | +Number of Event in IA | +Number of Event in FA | +
|---|---|---|
| Population 1 | +100 | +200 |
| Population 2 | +110 | +220 |
| Overlap in population 1 and 2 | +80 | +160 |
The correlation could be simply calculated as \[\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54\] +The 80 in the numerator is the overlap number of events of population 1 +in interim analysis and population 2 in final analysis.
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)## [1] 0.54
+3 Generate the
+correlation matrix by
+
+3 Generate the
+correlation matrix by generate_corr()
+Now we know how to calculate the correlation values under different
+situations, and the generate_corr() function was built
+based on this logic. We can directly calculate the results for each
+cross situation via the function.
First, we need a event table including the information of the +study.
+-
+
H1refers to one hypothesis, selected depending on the +interest, whileH2refers to the other hypothesis, both of +which are listed for multiplicity testing. For example,H1+means the experimental treatment is superior to the control in the +population 1/experimental arm 1;H2means the experimental +treatment is superior to the control in the population 2/experimental +arm 2;
+Analysismeans different analysis stages, for example, +1 means the interim analysis, and 2 means the final analysis;
+Eventis the common events overlap byH1+andH2.
+
For example: H1=1, H2=1,
+Analysis=1, Event=100indicates that in the
+first population, there are 100 cases where the experimental treatment
+is superior to the control in the interim analysis.
Another example: H1=1, H2=2,
+Analysis=2, Event=160 indicates that the
+number of overlapping cases where the experimental treatment is superior
+to the control in population 1 and 2 in the final analysis is 160.
To be noticed, the column names in this function are fixed to be
+H1, H2, Analysis,
+Event.
library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+
+
+
+
+
+| Number of events at each population & analyses | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +100 |
| 2 | +2 | +1 | +110 |
| 3 | +3 | +1 | +225 |
| 1 | +2 | +1 | +80 |
| 1 | +3 | +1 | +100 |
| 2 | +3 | +1 | +110 |
| 1 | +1 | +2 | +200 |
| 2 | +2 | +2 | +220 |
| 3 | +3 | +2 | +450 |
| 1 | +2 | +2 | +160 |
| 1 | +3 | +2 | +200 |
| 2 | +3 | +2 | +220 |
Then we input the above event table to the function of
+generate_corr(), and get the correlation matrix as
+follow.
generate_corr(event)## H1_A1 H2_A1 H3_A1 H1_A2 H2_A2 H3_A2
+## [1,] 1.0000000 0.7627701 0.6666667 0.7071068 0.5393599 0.4714045
+## [2,] 0.7627701 1.0000000 0.6992059 0.5393599 0.7071068 0.4944132
+## [3,] 0.6666667 0.6992059 1.0000000 0.4714045 0.4944132 0.7071068
+## [4,] 0.7071068 0.5393599 0.4714045 1.0000000 0.7627701 0.6666667
+## [5,] 0.5393599 0.7071068 0.4944132 0.7627701 1.0000000 0.6992059
+## [6,] 0.4714045 0.4944132 0.7071068 0.6666667 0.6992059 1.0000000
+
+
+
+
+References
+
+
+
+Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022.
+“A Unified Framework for Weighted Parametric Group Sequential
+Design.” Biometrical Journal 64 (7): 1219–39.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R
new file mode 100644
index 0000000..8aea00b
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.R
@@ -0,0 +1,335 @@
+## ----include = FALSE----------------------------------------------------------
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+
+## ----message=FALSE, warning=FALSE---------------------------------------------
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+
+## ----eval=FALSE, echo=FALSE---------------------------------------------------
+# library(ggplot2)
+# library(ggforce)
+#
+# ellipse_data <- data.frame(
+# id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+# x = c(0, 1, 0.5),
+# y = c(0, 0, 0),
+# a = c(1, 1, 2),
+# b = c(0.5, 0.5, 1)
+# )
+#
+# ragg::agg_png(
+# "vignettes/figures/ex1-pop.png",
+# width = 1920,
+# height = 1920 / 1.618,
+# res = 96,
+# scaling = 2
+# )
+# ggplot() +
+# geom_ellipse(
+# aes(
+# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+# ),
+# data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+# color = NA, alpha = 0.5, show.legend = FALSE
+# ) +
+# geom_ellipse(
+# aes(
+# x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+# ),
+# data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+# color = NA, alpha = 0.85, show.legend = FALSE
+# ) +
+# geom_text(aes(
+# x = x, y = y, label = id,
+# hjust = ifelse(id == "H1: Population 1", 1.1,
+# ifelse(id == "H2: Population 2", -0.1, 0.5)
+# ),
+# vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+# ), data = ellipse_data, size = 6) +
+# scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+# coord_fixed() +
+# theme_void()
+# dev.off()
+
+## ----echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"------------------
+knitr::include_graphics("figures/ex1-pop.png")
+
+## ----out.width="80%"----------------------------------------------------------
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+
+## ----out.width="80%", echo = FALSE--------------------------------------------
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+
+## -----------------------------------------------------------------------------
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+## -----------------------------------------------------------------------------
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+
+## -----------------------------------------------------------------------------
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+## -----------------------------------------------------------------------------
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+
+## -----------------------------------------------------------------------------
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+
+## ----echo=FALSE---------------------------------------------------------------
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
+## -----------------------------------------------------------------------------
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+
+## -----------------------------------------------------------------------------
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+
+## -----------------------------------------------------------------------------
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+## -----------------------------------------------------------------------------
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+## -----------------------------------------------------------------------------
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd
new file mode 100644
index 0000000..4771094
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.Rmd
@@ -0,0 +1,591 @@
+---
+title: "Quickstart guide"
+author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_depth: 3
+ toc_float: true
+ code_folding: hide
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+bibliography: wpgsd.bib
+vignette: >
+ %\VignetteIndexEntry{Quickstart guide}
+ %\VignetteEncoding{UTF-8}
+ %\VignetteEngine{knitr::rmarkdown}
+editor_options:
+ markdown:
+ wrap: 72
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+```
+
+```{r, message=FALSE, warning=FALSE}
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+```
+
+# Background
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
+
+# Methods and Examples
+
+## Closed Testing and Parametric Tests
+
+We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
+
+## Consonance
+
+A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
+
+## Group Sequential Design Notations and Assumptions
+
+- A set $I$ of hypotheses for $i \in I$.
+- $K$ group sequential analyses, $k = 1, \ldots, K$
+- Single endpoint
+ * Not required, and can be generalized
+- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$
+
+## Correlation Structure
+
+- Notation
+ * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$.
+ * Assume the same endpoint for all hypotheses (can be relaxed)
+ * For binary or continuous outcomes $n_{ik}$ represents sample size
+ * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$
+ * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$.
+- Key result
+ $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$
+- Proof builds on standard group sequential theory (@chen2021multiplicity)
+
+## Example 1: Overlapping Populations, Two Analyses
+
+Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified.
+
+```{r, eval=FALSE, echo=FALSE}
+library(ggplot2)
+library(ggforce)
+
+ellipse_data <- data.frame(
+ id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+ x = c(0, 1, 0.5),
+ y = c(0, 0, 0),
+ a = c(1, 1, 2),
+ b = c(0.5, 0.5, 1)
+)
+
+ragg::agg_png(
+ "vignettes/figures/ex1-pop.png",
+ width = 1920,
+ height = 1920 / 1.618,
+ res = 96,
+ scaling = 2
+)
+ggplot() +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+ color = NA, alpha = 0.5, show.legend = FALSE
+ ) +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+ color = NA, alpha = 0.85, show.legend = FALSE
+ ) +
+ geom_text(aes(
+ x = x, y = y, label = id,
+ hjust = ifelse(id == "H1: Population 1", 1.1,
+ ifelse(id == "H2: Population 2", -0.1, 0.5)
+ ),
+ vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+ ), data = ellipse_data, size = 6) +
+ scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+ coord_fixed() +
+ theme_void()
+dev.off()
+```
+
+```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"}
+knitr::include_graphics("figures/ex1-pop.png")
+```
+
+The multiplicity strategy is defined as follows.
+
+```{r, out.width="80%"}
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+```
+
+The event count of each hypothesis at each analysis is shown below.
+
+| Population | Number of Events at IA | Number of Events at FA |
+|:---------------------:|:----------------------:|:----------------------:|
+| Population 1 | 100 | 200 |
+| Population 2 | 110 | 220 |
+| Population 1 $\cap$ 2 | 80 | 160 |
+| Overall Population | 225 | 450 |
+
+Table: Number of events at each analysis for each population in Example 1.
+IA: interim analysis. FA: final analysis.
+
+The correlation matrix among test statistics is as follows.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ |
+| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ |
+| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ |
+| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ |
+| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ |
+| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 |
+
+Table: Correlation Matrix of Test Statistics for Example 1.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Example 2: Common Control, Two Analyses
+
+Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified.
+
+```{r, out.width="80%", echo = FALSE}
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+```
+
+| Treatment Arm | Number of Events at IA | Number of Events at FA |
+|:--------------:|:----------------------:|:----------------------:|
+| Experimental 1 | 70 | 135 |
+| Experimental 2 | 75 | 150 |
+| Experimental 3 | 80 | 165 |
+| Control | 85 | 170 |
+
+Table: Number of events at each analysis for each treatment arm in Example 2.
+IA: interim analysis. FA: final analysis.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ |
+| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ |
+| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ |
+| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ |
+| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ |
+| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 |
+
+Table: Correlation Matrix for Example 2.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Hypotheses Set
+
+These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 |
+| $H_1 \cap H_2$ | 0.5 | 0.5 | - |
+| $H_1 \cap H_3$ | 0.3 | - | 0.7 |
+| $H_2 \cap H_3$ | - | 0.3 | 0.7 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 1.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 |
+| $H_1 \cap H_2$ | 1/2 | 1/2 | - |
+| $H_1 \cap H_3$ | 1/2 | - | 1/2 |
+| $H_2 \cap H_3$ | - | 1/2 | 1/2 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 2.
+
+## $\alpha$ Spending: 3 approaches
+
+The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed:
+
+- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
+
+- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$.
+
+- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$.
+
+## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis)
+
+- Assume ($Z_1,Z_2$) bivariate normal with known correlation
+
+- Find $\alpha$-inflation factor $c_J$ such that
+ $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$
+
+- Basic algorithm code in @bretz2011graphical
+
+### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$.
+
+ ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$.
+
+ iii Compute type I error rate up to analysis $k$
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$
+
+ iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$
+
+ v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020).
+
+### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$.
+
+ ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$
+
+ iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$
+
+ iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020).
+
+## Implementation of Example 1 with Overlapping Populations
+
+We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows:
+
+- Analysis: Analysis number (1 for interim, 2 for final).
+- Event: Event counts.
+- H1, H2: Hypotheses intersected.
+ * (1, 1) represents counts for hypothesis 1
+ * (1, 2) for counts for the intersection of hypotheses 1 and 2
+
+```{r}
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+```
+
+Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests.
+
+```{r}
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type.
+
+- 0 = Bonferroni. Separate alpha spending for each hypotheses.
+- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+
+Compute Bonferroni bounds.
+
+```{r}
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+```
+
+Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions.
+
+```{r}
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+```
+
+Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
+
+```{r, echo=FALSE}
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+Closed testing procedure can then be performed using `closed_test()`.
+
+```{r}
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+```
+
+```{r}
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+```
+
+## Implementation of Example 2 with Common Control
+
+Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper.
+
+```{r}
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+```{r}
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+## Power Considerations
+
+The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development.
+
+# Conclusions
+
+The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds
+and improved power compared to the Bonferroni approach.
+
+# References
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html
new file mode 100644
index 0000000..7d0095d
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/inst/doc/wpgsd.html
@@ -0,0 +1,7846 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Procedure to compute p-value boundaries by +weighted Bonferroni
+Yujie Zhao
+ +library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+
+1 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:
+-
+
- \(H_1\): the experimental treatment +is superior to the control in the biomarker A positive population; +
- \(H_2\): the experimental treatment +is superior to the control in the biomarker B positive population; +
- \(H_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
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+
+1.1 Observed +p-values
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ 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.006 | +2.512144 |
| H1 | +2 | +0.015 | +2.170090 |
| H2 | +2 | +0.012 | +2.257129 |
| H3 | +2 | +0.004 | +2.652070 |
p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+1.2 Information +fraction
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)The information fraction of \(H_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
+
+1.3 Initial weight and +transition matrix
+We assign the initial weights of \(H_1\), \(H_2\), \(H_3\) as \(\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 +\(H_1\) is rejected, then \(3/7\) local significance level \(\alpha_1\) will be propagated to \(H_2\), and \(4/7\) will go to \(H_3\). If \(H_3\) is rejected, then half of \(\alpha_3\) goes to \(H_1\), and half goes to \(H_2\).
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weightsname_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
# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+
+
+
+
+
+| Weight of all possible interaction hypothesis | +||
| H1 | +H2 | +H3 | +
|---|---|---|
| 1.0000000 | +NA | +NA |
| NA | +1.0000000 | +NA |
| 0.5000000 | +0.5000000 | +NA |
| NA | +NA | +1.0000000 |
| 0.4285714 | +NA | +0.5714286 |
| NA | +0.4285714 | +0.5714286 |
| 0.3000000 | +0.3000000 | +0.4000000 |
+
+1.4 Correlations
+The correlation of the 6 statistic (2 analyses \(\times\) 3 hypotheses) 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 80
+## 2 2 2 1 88
+## 3 3 3 1 180
+## 4 1 2 1 64
+## 5 1 3 1 80
+## 6 2 3 1 88
+## 7 1 1 2 160
+## 8 2 2 2 176
+## 9 3 3 2 360
+## 10 1 2 2 128
+## 11 1 3 2 160
+## 12 2 3 2 176# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+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
+
+2 Boundary +calculation
+
+
+2.1 Boundary of \(H_1\)
+For the elementary hypothesis \(H_1\), its weight is 1, namely,
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1 | +0.002980073 | +NA | +NA |
| 2 | +H1 | +0.023788266 | +NA | +NA |
+
+2.2 Boundary of \(H_2\)
+For the elementary hypothesis \(H_2\), its weight is 1, namely,
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H2 | +NA | +0.002980073 | +NA |
| 2 | +H2 | +NA | +0.023788266 | +NA |
ans <- rbind(ans, ans_new)
+
+2.3 Boundary of \(H_3\)
+For the elementary hypothesis \(H_3\), its weight is 1, namely,
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H3 | +NA | +NA | +0.002980073 |
| 2 | +H3 | +NA | +NA | +0.023788266 |
ans <- rbind(ans, ans_new)
+
+2.4 Boundary of \(H_1 \cap H_2\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12## [1] 0.5 0.5And the boundary for \(H_1\) and +\(H_2\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H2 | +0.001490037 | +0.001490037 | +NA |
| 2 | +H1, H2 | +0.011782800 | +0.011782800 | +NA |
ans <- rbind(ans, ans_new)
+
+2.5 Boundary of \(H_1 \cap H_3\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13## [1] 0.4285714 0.5714286And the boundary for \(H_1\) and +\(H_3\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H3 | +0.001277174 | +NA | +0.001702899 |
| 2 | +H1, H3 | +0.010079863 | +NA | +0.013489389 |
ans <- rbind(ans, ans_new)
+
+2.6 Boundary of \(H_2 \cap H_3\)
+For the interaction hypothesis \(H_2 \cap +H_3\), its weight is
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23## [1] 0.4285714 0.5714286And the boundary for \(H_2\) and +\(H_3\) are
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H2, H3 | +NA | +0.001277174 | +0.001702899 |
| 2 | +H2, H3 | +NA | +0.010079863 | +0.013489389 |
ans <- rbind(ans, ans_new)
+
+2.7 Boundary of \(H1 \cap H_2 \cap H_3\)
+For the interaction hypothesis \(H_1 \cap +H_2\), its weight is
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123## [1] 0.3 0.3 0.4And the boundary for \(H_1\), \(H_2\), and \(H_3\) are
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+
+
+
+
+
+| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +
|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 |
ans <- rbind(ans, ans_new)
+
+3 Summary
+With the p-value boundaries, one can get the Z-statistics boundaries
+by qnorm().
ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+
+
+
+
+
+| p-values/Z-statistics boundaries of weighted Bonferroni | +|||||
| Analysis | +Interaction/Elementary hypotheses | +H1 p-value boundary | +H2 p-value boundary | +H3 p-value boundary | +H1 Z-statistics boundary | +
|---|---|---|---|---|---|
| 1 | +H1 | +0.0029800731 | +NA | +NA | +NA |
| 1 | +H1, H2 | +0.0014900365 | +0.0014900365 | +NA | +NA |
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 | +3.037681 |
| 1 | +H1, H3 | +0.0012771742 | +NA | +0.001702899 | +2.928520 |
| 1 | +H2 | +NA | +0.0029800731 | +NA | +NA |
| 1 | +H2, H3 | +NA | +0.0012771742 | +0.001702899 | +2.928520 |
| 1 | +H3 | +NA | +NA | +0.002980073 | +2.749966 |
| 2 | +H1 | +0.0237882657 | +NA | +NA | +NA |
| 2 | +H1, H2 | +0.0117828003 | +0.0117828003 | +NA | +NA |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 | +2.349480 |
| 2 | +H1, H3 | +0.0100798631 | +NA | +0.013489389 | +2.211825 |
| 2 | +H2 | +NA | +0.0237882657 | +NA | +NA |
| 2 | +H2, H3 | +NA | +0.0100798631 | +0.013489389 | +2.211825 |
| 2 | +H3 | +NA | +NA | +0.023788266 | +1.981131 |
+
+
+
+
+4 Implementation in +wpgsd
+The above results can be computed in one function call in wpgsd by
+using the generate_bounds() function as
generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+
+
+
+
+
+| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0029800731 | +NA | +NA |
| 1 | +H1, H2 | +0.0014900365 | +0.0014900365 | +NA |
| 1 | +H1, H2, H3 | +0.0008940219 | +0.0008940219 | +0.001192029 |
| 1 | +H1, H3 | +0.0012771742 | +NA | +0.001702899 |
| 1 | +H2 | +NA | +0.0029800731 | +NA |
| 1 | +H2, H3 | +NA | +0.0012771742 | +0.001702899 |
| 1 | +H3 | +NA | +NA | +0.002980073 |
| 2 | +H1 | +0.0237882657 | +NA | +NA |
| 2 | +H1, H2 | +0.0117828003 | +0.0117828003 | +NA |
| 2 | +H1, H2, H3 | +0.0070254979 | +0.0070254979 | +0.009399818 |
| 2 | +H1, H3 | +0.0100798631 | +NA | +0.013489389 |
| 2 | +H2 | +NA | +0.0237882657 | +NA |
| 2 | +H2, H3 | +NA | +0.0100798631 | +0.013489389 |
| 2 | +H3 | +NA | +NA | +0.023788266 |
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat b/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat
new file mode 100644
index 0000000..cb0d0a8
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adsl.sas7bdat differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adtte.sas7bdat b/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adtte.sas7bdat
new file mode 100644
index 0000000..4c73e2e
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/inst/extdata/adtte.sas7bdat differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/calc_seq_p.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/calc_seq_p.Rd
new file mode 100644
index 0000000..b5a2dde
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/calc_seq_p.Rd
@@ -0,0 +1,101 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/calc_seq_p.R
+\name{calc_seq_p}
+\alias{calc_seq_p}
+\title{Calculate sequential p-values for interaction/elementary hypothesis}
+\usage{
+calc_seq_p(
+ test_analysis = 2,
+ test_hypothesis = "H1, H2, H3",
+ p_obs = tibble::tibble(analysis = 1:2, H1 = c(0.02, 0.0015), H2 = c(0.01, 0.01), H3 =
+ c(0.01, 0.004)),
+ alpha_spending_type = 2,
+ n_analysis = 2,
+ initial_weight = c(0.3, 0.3, 0.4),
+ transition_mat = matrix(c(0, 0.4285714, 0.5714286, 0.4285714, 0, 0.5714286, 0.5, 0.5,
+ 0), nrow = 3, byrow = TRUE),
+ z_corr = matrix(c(1, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045, 0.7627701,
+ 1, 0.6992059, 0.5393599, 0.7071068, 0.4944132, 0.6666667, 0.6992059, 1, 0.4714045,
+ 0.4944132, 0.7071068, 0.7071068, 0.5393599, 0.4714045, 1, 0.7627701, 0.6666667,
+ 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1, 0.6992059, 0.4714045, 0.4944132,
+ 0.7071068, 0.6666667, 0.6992059, 1), nrow = 6, byrow = TRUE),
+ spending_fun = gsDesign::sfHSD,
+ spending_fun_par = -4,
+ info_frac = c(0.5, 1),
+ interval = c(1e-04, 0.2)
+)
+}
+\arguments{
+\item{test_analysis}{The index of the analysis to be tested, such as 1, 2, ...}
+
+\item{test_hypothesis}{A character of the tested interaction/elementary hypothesis,
+such as \code{"H1, H2, H3"}, \verb{H1, H2}, \code{"H1"}.}
+
+\item{p_obs}{Observed p-values up to \code{test_analysis}.}
+
+\item{alpha_spending_type}{Type Boundary type.
+\itemize{
+\item \code{0} - Bonferroni. Separate alpha spending for each hypotheses.
+\item \code{1} - Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+\item \code{2} - Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+\item \code{3} - Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+}}
+
+\item{n_analysis}{Total number of analysis.}
+
+\item{initial_weight}{Initial weight assigned to the elementary hypothesis.}
+
+\item{transition_mat}{Transition matrix.}
+
+\item{z_corr}{Correlation matrix of the Z statistics.}
+
+\item{spending_fun}{Spending function.}
+
+\item{spending_fun_par}{Parameter of the spending function.}
+
+\item{info_frac}{Information fractions.}
+
+\item{interval}{Interval to search the uniroot.}
+}
+\value{
+The sequential p-values of the \code{test_hypothesis} at the \code{test_analysis}.
+}
+\description{
+Calculate sequential p-values for interaction/elementary hypothesis
+}
+\examples{
+\donttest{
+calc_seq_p(
+ test_analysis = 2,
+ test_hypothesis = "H1, H2, H3",
+ p_obs = tibble::tibble(
+ analysis = 1:2,
+ H1 = c(0.02, 0.0015),
+ H2 = c(0.01, 0.01),
+ H3 = c(0.01, 0.004)
+ ),
+ alpha_spending_type = 2,
+ n_analysis = 2,
+ initial_weight = c(0.3, 0.3, 0.4),
+ transition_mat = matrix(c(
+ 0.0000000, 0.4285714, 0.5714286,
+ 0.4285714, 0.0000000, 0.5714286,
+ 0.5000000, 0.5000000, 0.0000000
+ ), nrow = 3, byrow = TRUE),
+ z_corr = matrix(
+ c(
+ 1.0000000, 0.7627701, 0.6666667, 0.7071068, 0.5393599, 0.4714045,
+ 0.7627701, 1.0000000, 0.6992059, 0.5393599, 0.7071068, 0.4944132,
+ 0.6666667, 0.6992059, 1.0000000, 0.4714045, 0.4944132, 0.7071068,
+ 0.7071068, 0.5393599, 0.4714045, 1.0000000, 0.7627701, 0.6666667,
+ 0.5393599, 0.7071068, 0.4944132, 0.7627701, 1.0000000, 0.6992059,
+ 0.4714045, 0.4944132, 0.7071068, 0.6666667, 0.6992059, 1.0000000
+ ),
+ nrow = 6, byrow = TRUE
+ ),
+ spending_fun = gsDesign::sfHSD,
+ spending_fun_par = -4,
+ info_frac = c(0.5, 1),
+ interval = c(1e-4, 0.2)
+)}
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/closed_test.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/closed_test.Rd
new file mode 100644
index 0000000..553315f
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/closed_test.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/closed_test.R
+\name{closed_test}
+\alias{closed_test}
+\title{Perform closed testing procedure}
+\usage{
+closed_test(bounds, p_obs)
+}
+\arguments{
+\item{bounds}{A tibble of nominal p-value boundaries from \code{\link[=generate_bounds]{generate_bounds()}}
+containing columns \code{Analysis}, \code{Hypotheses}, \code{H1}, \code{H2}, etc.}
+
+\item{p_obs}{A tibble of observed p-values containing columns
+\code{Analysis}, \code{H1}, \code{H2}, etc.}
+}
+\value{
+An outcome matrix summarizing the testing results.
+}
+\description{
+Perform closed testing procedure
+}
+\examples{
+p_obs <- dplyr::bind_rows(
+ tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001),
+ tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001)
+)
+bound <- tibble::tribble(
+ ~Analysis, ~Hypotheses, ~H1, ~H2,
+ 1, "H1", 0.02, NA,
+ 1, "H1, H2", 0.0001, 0.00001,
+ 1, "H2", NA, 0.003,
+ 2, "H1", 0.02, NA,
+ 2, "H1, H2", 0.02, 0.00001,
+ 2, "H2", NA, 0.003
+)
+
+closed_test <- closed_test(bound, p_obs)
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.png b/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.png
new file mode 100644
index 0000000..cb5e55e
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.png differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.xcf b/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.xcf
new file mode 100644
index 0000000..f9a63ed
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/man/figures/logo.xcf differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd
new file mode 100644
index 0000000..0a922b5
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/find_astar.Rd
@@ -0,0 +1,78 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/find_astar.R
+\name{find_astar}
+\alias{find_astar}
+\title{Utility function for root-finding to compute crossing probabilities
+with the overall alpha spending approach}
+\usage{
+find_astar(
+ a,
+ alpha_prev = NULL,
+ astar,
+ w,
+ sig,
+ maxpts = 50000,
+ abseps = 1e-05,
+ ...
+)
+}
+\arguments{
+\item{a}{Cumulative overall alpha spending up to current analysis.}
+
+\item{alpha_prev}{alpha boundary at previous interim analyses using
+the WPGSD approach.}
+
+\item{astar}{Total nominal alpha level at current analysis from
+the WPGSD approach.}
+
+\item{w}{Vector of alpha weights at current analysis.}
+
+\item{sig}{Correlation matrix of previous and current analyses test statistics.}
+
+\item{maxpts}{GenzBretz function maximum number of function values as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{...}{Additional arguments.}
+}
+\value{
+Difference. Should be 0 with \code{a} and \code{astar} identified.
+}
+\description{
+Utility function for root-finding to compute crossing probabilities
+with the overall alpha spending approach
+}
+\examples{
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_astar(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ astar = 1,
+ w = c(0.5, 0.5),
+ sig = my_corr[
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1"),
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1")
+ ]
+)
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd
new file mode 100644
index 0000000..0e33534
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/find_xi.Rd
@@ -0,0 +1,75 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/find_xi.R
+\name{find_xi}
+\alias{find_xi}
+\title{Utility function for root-finding to compute inflation factor xi
+with the separate alpha spending approach}
+\usage{
+find_xi(
+ a,
+ alpha_prev = NULL,
+ aprime,
+ xi,
+ sig,
+ maxpts = 50000,
+ abseps = 1e-05,
+ ...
+)
+}
+\arguments{
+\item{a}{Sum of cumulative alpha spending from the Bonferroni approach.}
+
+\item{alpha_prev}{alpha boundary at previous interim analyses using the MTP approach.}
+
+\item{aprime}{Nominal alpha boundary from the Bonferroni approach.}
+
+\item{xi}{Inflation factor.}
+
+\item{sig}{Correlation matrix of previous and current analyses test statistics.}
+
+\item{maxpts}{GenzBretz function maximum number of function values as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{...}{Additional arguments.}
+}
+\value{
+Difference. Should be 0 with \code{xi} identified.
+}
+\description{
+Utility function for root-finding to compute inflation factor xi
+with the separate alpha spending approach
+}
+\examples{
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_xi(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ xi = 1,
+ sig = my_corr[
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1"),
+ colnames(my_corr) \%in\% c("H1_A1", "H2_A1")
+ ]
+)
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd
new file mode 100644
index 0000000..53c1660
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_bounds.Rd
@@ -0,0 +1,135 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_bounds.R
+\name{generate_bounds}
+\alias{generate_bounds}
+\title{Compute p-value boundaries of the parametric MTP method with overall
+alpha spending for all hypotheses}
+\usage{
+generate_bounds(
+ type = 1,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ cum_alpha = NULL,
+ maxpts = 50000,
+ abseps = 1e-05,
+ tol = 1e-10,
+ sf = gsDesign::sfHSD,
+ sfparm = -4,
+ t = c(0.5, 1),
+ ...
+)
+}
+\arguments{
+\item{type}{Boundary type.
+\itemize{
+\item \code{0} = Bonferroni. Separate alpha spending for each hypotheses.
+\item \code{1} = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+\item \code{2} = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+\item \code{3} = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+}}
+
+\item{k}{Number of analyses up to the current analysis.}
+
+\item{w}{Initial weights.}
+
+\item{m}{Transition matrix.}
+
+\item{corr}{Correlation matrix of all test statistics up to the
+current analysis. dim = k * length(w).}
+
+\item{alpha}{Overall alpha.}
+
+\item{cum_alpha}{Cumulative alpha spent at each analysis.
+Only required for \code{type = 1}.}
+
+\item{maxpts}{GenzBretz function maximum number of function values
+as integer.}
+
+\item{abseps}{GenzBretz function absolute error tolerance.}
+
+\item{tol}{Find root tolerance.}
+
+\item{sf}{A list of alpha spending functions to spend alpha for
+each hypotheses.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{sf} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{sfparm}{A list of parameters to be supplied to sfs.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{sfparm} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{t}{A list of information fraction used for alpha spending,
+may be different from the actual information fraction.
+Each component corresponds to a hypothesis.
+\itemize{
+\item If \code{type = 0} or \code{3} then length equals to number of hypotheses.
+\item If \code{type = 1} then \code{t} is not needed.
+\item If \code{type = 2} then only the first component is used.
+}}
+
+\item{...}{Additional arguments.}
+}
+\value{
+A tibble with \code{k * (2^(n_hypotheses - 1))} rows of
+p-value boundaries. Inflation factor is also provided if \code{type = 3}.
+}
+\description{
+Compute p-value boundaries of the parametric MTP method with overall
+alpha spending for all hypotheses
+}
+\examples{
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+
+# Initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input information fraction
+IF_IA <- c(155 / 305, 160 / 320, 165 / 335)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+
+# Generate bounds
+generate_bounds(
+ type = 3,
+ k = 2,
+ w = w,
+ m = m,
+ corr = gs_corr,
+ alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1))
+)
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd
new file mode 100644
index 0000000..4a139c9
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_corr.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_corr.R
+\name{generate_corr}
+\alias{generate_corr}
+\title{Generate correlation matrix based on event counts}
+\usage{
+generate_corr(event)
+}
+\arguments{
+\item{event}{Event count of each hypothesis at each analysis, including
+event count of the intersection of hypotheses.
+It contains 4 columns: \code{H1}, \code{H2}, \code{Analysis}, \code{Event}.
+\code{H1} needs to be listed as 1, 2, 3, etc. as numbers.}
+}
+\value{
+A correlation matrix.
+}
+\description{
+Generate correlation matrix based on event counts
+}
+\examples{
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd
new file mode 100644
index 0000000..3b355c4
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/generate_event_table.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_event_table.R
+\name{generate_event_table}
+\alias{generate_event_table}
+\title{Generate table of event counts from ADSL and ADTTE datasets}
+\usage{
+generate_event_table(paths, h_select, adsl_name, adtte_name, key_var, cnsr_var)
+}
+\arguments{
+\item{paths}{A vector of paths for analysis datasets.
+Length should be equal to the number of analyses completed.}
+
+\item{h_select}{Selection criterion for each hypothesis.
+Should be a tibble containing 2 columns: \code{Hypothesis} and \code{Crit}.}
+
+\item{adsl_name}{SAS dataset name for subject-level analysis data.
+Usually it is \code{"adsl"}.}
+
+\item{adtte_name}{SAS dataset name for time-to-event analysis data.
+Usually it is \code{"adtte"}.}
+
+\item{key_var}{Key variable to join the \code{adsl} and \code{adtte} datasets.
+For example, \code{"USUBJID"} or \code{"SUBJID"}.}
+
+\item{cnsr_var}{Variable to indicate censoring (\code{1} = censor; \code{0} = event).
+For example, \code{"CNSR"}.}
+}
+\value{
+A list with two components:
+\itemize{
+\item \code{event}: an event count table as input for \code{\link[=generate_bounds]{generate_bounds()}}.
+\item \code{dsets}: analysis datasets of each hypothesis.
+}
+}
+\description{
+Generate table of event counts from ADSL and ADTTE datasets
+}
+\examples{
+library(dplyr)
+
+paths <- system.file("extdata/", package = "wpgsd")
+
+# Selection criteria for each hypothesis
+h_select <- tibble::tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD == 'OS' & TRT01P \%in\% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event \%>\%
+ gt::gt() \%>\%
+ gt::tab_header(title = "Event Count - Computed from SAS Datasets Example")
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd
new file mode 100644
index 0000000..f773abf
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/tidyeval.Rd
@@ -0,0 +1,98 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils-tidy-eval.R
+\name{tidyeval}
+\alias{tidyeval}
+\alias{enquo}
+\alias{enquos}
+\alias{.data}
+\alias{:=}
+\alias{as_name}
+\alias{as_label}
+\title{Tidy eval helpers}
+\description{
+This page lists the tidy eval tools reexported in this package from
+rlang. To learn about using tidy eval in scripts and packages at a
+high level, see the \href{https://dplyr.tidyverse.org/articles/programming.html}{dplyr programming vignette}
+and the \href{https://ggplot2.tidyverse.org/articles/ggplot2-in-packages.html}{ggplot2 in packages vignette}.
+The \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming section} of \href{https://adv-r.hadley.nz}{Advanced R} may also be useful for a deeper dive.
+\itemize{
+\item The tidy eval operators \verb{\{\{}, \verb{!!}, and \verb{!!!} are syntactic
+constructs which are specially interpreted by tidy eval functions.
+You will mostly need \verb{\{\{}, as \verb{!!} and \verb{!!!} are more advanced
+operators which you should not have to use in simple cases.
+
+The curly-curly operator \verb{\{\{} allows you to tunnel data-variables
+passed from function arguments inside other tidy eval functions.
+\verb{\{\{} is designed for individual arguments. To pass multiple
+arguments contained in dots, use \code{...} in the normal way.
+
+\if{html}{\out{
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Quickstart guide
+Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. +Sun
+ +library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+
+1 Background
+The weighted parametric group sequential design (WPGSD) (Anderson et al. (2022)) approach allows one to +take advantage of the known correlation structure in constructing +efficacy bounds to control family-wise error rate (FWER) for a group +sequential design. Here correlation may be due to common observations in +nested populations, due to common observations in overlapping +populations, or due to common observations in the control arm. This +document illustrates the use of the R package wpgsd to implement this +approach.
+
+
+2 Methods and +Examples
+
+
+2.1 Closed Testing and +Parametric Tests
+We aim to control the familywise error rate (FWER) at level \(\alpha\). Let \(J +\subseteq I\). The intersection hypothesis \(H_J\) assumes the null hypothesis for all +individual hypotheses \(H_i\) with +\(i \in J\). Closed testing principle +is as follows: if for all sets \(J \subseteq +I\) with \(j \in J\), \(H_J\) can be rejected at level \(\alpha\), then \(H_j\) can be rejected. Weighted parametric +tests can be used for this: Bretz et al. +(2011), Xi et al. (2017) for fixed +designs or Maurer and Bretz (2013) for +group sequential.
+
+
+2.2 Consonance
+A closed procedure is called consonant if the rejection of the +complete intersection null hypothesis \(H_I\) further implies that at least one +elementary hypothesis \(H_i, i \in I\), +is rejected. Consonance is a desirable property leading to short-cut +procedures that give the same rejection decisions as the original closed +procedure but with fewer operations. For WPGSD, consonance does not +always hold and in general the closed-testing procedure is required.
+
+
+2.3 Group Sequential +Design Notations and Assumptions
+-
+
- A set \(I\) of hypotheses for \(i \in I\). +
- \(K\) group sequential analyses, +\(k = 1, \ldots, K\) +
- Single endpoint
+
-
+
- Not required, and can be generalized +
+ - Assume tests \(Z_{ik}\), \(i \in I\), \(1 +\leq k \leq K\) where a large \(Z_{ik}\) is used to reject \(H_i\) +
+
+2.4 Correlation +Structure
+-
+
- Notation
+
-
+
- Events for individual hypothesis \(H_i\),\(i \in +I\) at analysis k denoted by \(n_{ik}\). +
- Assume the same endpoint for all hypotheses (can be relaxed) +
- For binary or continuous outcomes \(n_{ik}\) represents sample size +
- \(Z_{ik}\) is standardized normal +test for treatment effect for individual hypothesis \(H_i\) at analysis \(k\) +
- Denote \(n_{i\wedge i^\prime,k\wedge +k^\prime}\) as the number of observations (or events) included in +both \(Z_{ik}\) and \(Z_{i^\prime k^\prime}\), \(i\in I\), \(1\le +k\le K\). +
+ - Key result \[ \hbox{Corr}(Z_{ik}, +Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime +}}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} \] +
- Proof builds on standard group sequential theory (Chen et al. (2021)) +
+
+
+
+
+
+2.5 Example 1: +Overlapping Populations, Two Analyses
+Following illustrates the first example, which has overlapping +populations (e.g. due to biomarker) and is also example 1 in Anderson et al. (2022).
+
+
+
+
++Ex1: Populations +
+The multiplicity strategy is defined as follows.
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
The event count of each hypothesis at each analysis is shown +below.
+| Population | +Number of Events at IA | +Number of Events at FA | +
|---|---|---|
| Population 1 | +100 | +200 | +
| Population 2 | +110 | +220 | +
| Population 1 \(\cap\) 2 | +80 | +160 | +
| Overall Population | +225 | +450 | +
The correlation matrix among test statistics is as follows.
+| \(i,k\) | +1,1 | +2,1 | +3,1 | +1,2 | +2,2 | +3,2 | +
|---|---|---|---|---|---|---|
| 1,1 | +1 | +\(\frac{80}{\sqrt{100\cdot +110}}\) | +\(\frac{100}{\sqrt{100 +\cdot 225}}\) | +\(\frac{100}{\sqrt{100\cdot +200}}\) | +\(\frac{80}{\sqrt{100\cdot +220}}\) | +\(\frac{100}{\sqrt{100 +\cdot 450}}\) | +
| 2,1 | +0.76 | +1 | +\(\frac{110}{\sqrt{110 +\cdot 225}}\) | +\(\frac{80}{\sqrt{110\cdot +200}}\) | +\(\frac{110}{\sqrt{110\cdot +220}}\) | +\(\frac{110}{\sqrt{110 +\cdot 450}}\) | +
| 3,1 | +0.67 | +0.70 | +1 | +\(\frac{100}{\sqrt{225 +\cdot 200}}\) | +\(\frac{110}{\sqrt{225 +\cdot 220}}\) | +\(\frac{225}{\sqrt{225 +\cdot 450}}\) | +
| 1,2 | +0.71 | +0.54 | +0.47 | +1 | +\(\frac{160}{\sqrt{200 +\cdot 220}}\) | +\(\frac{200}{\sqrt{200 +\cdot 450}}\) | +
| 2,2 | +0.54 | +0.71 | +0.49 | +0.76 | +1 | +\(\frac{220}{\sqrt{220 +\cdot 450}}\) | +
| 3,2 | +0.47 | +0.49 | +0.71 | +0.67 | +0.70 | +1 | +
+
+
+
+
+
+2.6 Example 2: Common +Control, Two Analyses
+Following illustrates the second example in which correlation comes +from common control arm. This is also example 2 in Anderson et al. (2022).
+
| Treatment Arm | +Number of Events at IA | +Number of Events at FA | +
|---|---|---|
| Experimental 1 | +70 | +135 | +
| Experimental 2 | +75 | +150 | +
| Experimental 3 | +80 | +165 | +
| Control | +85 | +170 | +
| \(i,k\) | +1,1 | +2,1 | +3,1 | +1,2 | +2,2 | +3,2 | +
|---|---|---|---|---|---|---|
| 1,1 | +1 | +\(\frac{85}{\sqrt{155\cdot +160}}\) | +\(\frac{85}{\sqrt{155 \cdot +165}}\) | +\(\frac{155}{\sqrt{155\cdot +305}}\) | +\(\frac{85}{\sqrt{155\cdot +320}}\) | +\(\frac{85}{\sqrt{155 \cdot +335}}\) | +
| 2,1 | +0.54 | +1 | +\(\frac{85}{\sqrt{160 \cdot +165}}\) | +\(\frac{85}{\sqrt{160 \cdot +305}}\) | +\(\frac{160}{\sqrt{160\cdot +320}}\) | +\(\frac{85}{\sqrt{160 \cdot +335}}\) | +
| 3,1 | +0.53 | +0.52 | +1 | +\(\frac{85}{\sqrt{165 \cdot +305}}\) | +\(\frac{85}{\sqrt{165\cdot +320}}\) | +\(\frac{165}{\sqrt{165 +\cdot 335}}\) | +
| 1,2 | +0.71 | +0.38 | +0.38 | +1 | +\(\frac{170}{\sqrt{305\cdot +320}}\) | +\(\frac{170}{\sqrt{305 +\cdot 335}}\) | +
| 2,2 | +0.38 | +0.71 | +0.37 | +0.54 | +1 | +\(\frac{170}{\sqrt{320 +\cdot 335}}\) | +
| 3,2 | +0.37 | +0.37 | +0.70 | +0.53 | +0.52 | +1 | +
+
+
+
+
+
+2.7 Hypotheses Set
+These 2 examples each has 7 intersection hypotheses and the +corresponding weighting strategies are illustrated below.
+| \(H_J\) | +\(w_1(J)\) | +\(w_2(J)\) | +\(w_3(J)\) | +
|---|---|---|---|
| \(H_1 \cap H_2 \cap +H_3\) | +0.3 | +0.3 | +0.4 | +
| \(H_1 \cap +H_2\) | +0.5 | +0.5 | +- | +
| \(H_1 \cap +H_3\) | +0.3 | +- | +0.7 | +
| \(H_2 \cap +H_3\) | +- | +0.3 | +0.7 | +
| \(H_1\) | +1 | +- | +- | +
| \(H_2\) | +- | +1 | +- | +
| \(H_3\) | +- | +- | +1 | +
| \(H_J\) | +\(w_1(J)\) | +\(w_2(J)\) | +\(w_3(J)\) | +
|---|---|---|---|
| \(H_1 \cap H_2 \cap +H_3\) | +1/3 | +1/3 | +1/3 | +
| \(H_1 \cap +H_2\) | +1/2 | +1/2 | +- | +
| \(H_1 \cap +H_3\) | +1/2 | +- | +1/2 | +
| \(H_2 \cap +H_3\) | +- | +1/2 | +1/2 | +
| \(H_1\) | +1 | +- | +- | +
| \(H_2\) | +- | +1 | +- | +
| \(H_3\) | +- | +- | +1 | +
+
+2.8 \(\alpha\) Spending: 3 approaches
+The WPGSD approach uses all known correlations between tests in the +study. This relaxes bounds and allows increased power or smaller sample +size. Three spending approaches have been proposed:
+-
+
Fixed spending (Fleming-Harrington-O’Brien (FHO) approach). +Specify \(0 < \alpha_1(J) < \alpha_2(J) +< \ldots < \alpha_K(J) = \alpha(J) \leq \alpha\) for all +\(J\subseteq I\), where \(\alpha(J)\) is the total alpha for +intersection hypothesis \(H_J\) +according to the graphical approach.
+\(\alpha\)-spending approach 1. +We choose a spending function family \(f(t,\alpha)\) and set \(\alpha_k(J)=f(t_k(J),\alpha(J))\) for \(1\le k\le K\) for all intersection +hypotheses \(J\subseteq I\).
+\(\alpha\)-spending approach 2. +For each elementary hypothesis \(i\) +(\(i\) = 1, 2, , \(m\)), specify the \(\alpha\)-spending function family \(f_i(t,\gamma)\) where \(\gamma\) is the \(\alpha\) level for the hypothesis and \(f_i(t_{ik},\gamma)\) determines how much +\(\alpha\) to spend up to analysis +\(k\) for hypothesis \(i\) when level \(\gamma\) is allocated to the hypothesis. +Then \(\alpha_k(J) = \sum_{i \in J} +f_i(t_{ik}, w_i(J)\alpha)\).
+
+
+2.9 Bounds Computation: +Parametric Test, Fixed Design (For Example, Two Populations, One +Analysis)
+-
+
Assume (\(Z_1,Z_2\)) bivariate +normal with known correlation
+Find \(\alpha\)-inflation factor +\(c_J\) such that \[ \alpha = P[\cup_{i \in J} \{p_i \leq +c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq +\Phi^{-1}(1-c_Jw_{J,i}\alpha \}]\]
+Basic algorithm code in Bretz et al. +(2011)
+
+
+2.9.1 +Bounds Computation: WPGSD - Fixed spending and \(\alpha\) spending approach 1
+-
+
Assume for \(j < k\) that +bounds \(c_{ij} (J), i \in J, j < +k\), have already been set and remain unchanged.
+At analysis \(k\), compute the +correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = +1, \ldots, k\).
+i Initialize \(\alpha_{k}^{*}(J) = +\alpha_{k}(J) - \alpha_{k-1}(J)\).
+ii Set \(b_{ik} = \Phi^{-1}(1 - +w_{i}(J)\alpha_{k}^{*} (J))\), \(i\in +J\).
+iii Compute type I error rate up to analysis \(k\) \[ 1 - +Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ +Z_{ij} < c_{ij}(J) \} ). \]
+iv Update \(\alpha_{k}^{*}(J)\) +using root-finding with steps ii - iii until the type I error rate +through analysis \(k\) is controlled at +\(\alpha_{k}(J)\) for \(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} +\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. +\]
+v Set \(c_{ik}(J) = b_{ik}\) from +the previous step. The corresponding nominal \(p\)-value boundary is \(p_{ik}(J)= 1-\Phi(c_{ik}(J)) += w_i(J)\alpha_k^*(J)\).
+Note: interim bound does not depend on future analyses. Solution +only requires root finding for a single \(\alpha_{k}^{*}(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate +normal computation from mvtnorm R package Genz et al. (2020).
+
+
+2.9.2 +Bounds Computation: WPGSD - \(\alpha\) +spending approach 2
+-
+
Assume for \(j < k\) that +bounds \(c_{ij} (J), i \in J, j < +k\), have already been set and remain unchanged.
+At analysis \(k\), compute the +correlation matrix of \(Z_{ij}\), \(i \in J\), \(j = +1, \ldots, k\).
+i Determine what the nominal \(p\)-value boundary would be for each +elementary hypothesis in \(J\) for a +weighted Bonferroni test in a group sequential design as described in +Maurer and Bretz (2013). Let these nominal +\(p\)-value boundaries be \(\alpha^\prime_{ik}(J)\).
+ii Choose an inflation factor \(\xi_{k}(J) +> 1\) and set \[b_{ik} = +\Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).\]
+iii Update \(\xi_k(J)\) until this +type I error rate up to analysis \(k\) +is controlled at \(\alpha_{k}(J)\) for +\(H_J\). That is, \[ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} +\cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = +\alpha_{k}(J).\]
+iv After the appropriate \(\xi_k(J)\) has been derived, the nominal +\(p\)-value boundaries are \(p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)\), +and \(b_{ik}\) is computed as in step +ii, we set \(c_{ik}(J) = +b_{ik}\).
+Note: interim bound does not depend on future analyses. Solution +only requires root finding for a single \(\xi_k(J)\) at a time, \(k = 1, \ldots, K\). Requires multivariate +normal computation from the mvtnorm R package Genz et +al. (2020).
+
+
+2.10 Implementation of +Example 1 with Overlapping Populations
+We first define the transition matrix and weights as shown above in +Section 2.5. Next we set up the event count table as follows:
+-
+
- Analysis: Analysis number (1 for interim, 2 for final). +
- Event: Event counts. +
- 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, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+
+
+
+
+| Event Count | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +100 |
| 2 | +2 | +1 | +110 |
| 3 | +3 | +1 | +225 |
| 1 | +2 | +1 | +80 |
| 1 | +3 | +1 | +100 |
| 2 | +3 | +1 | +110 |
| 1 | +1 | +2 | +200 |
| 2 | +2 | +2 | +220 |
| 3 | +3 | +2 | +450 |
| 1 | +2 | +2 | +160 |
| 1 | +3 | +2 | +200 |
| 2 | +3 | +2 | +220 |
# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+
+
+
+
+
+| Event Count - Computed from SAS Datasets Example | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +66 |
| 2 | +2 | +1 | +59 |
| 1 | +2 | +1 | +45 |
Then we compute correlation matrix using the event count table and
+generate_corr(). We see that the correlations not accounted
+for by the Bonferroni approach are substantial and, thus, might expect a
+non-trivial impact on bounds for hypothesis tests.
## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+
+
+
+
+| Correlation Matrix | +|||||
| H1_A1 | +H2_A1 | +H3_A1 | +H1_A2 | +H2_A2 | +H3_A2 | +
|---|---|---|---|---|---|
| 1.00 | +0.76 | +0.67 | +0.71 | +0.54 | +0.47 |
| 0.76 | +1.00 | +0.70 | +0.54 | +0.71 | +0.49 |
| 0.67 | +0.70 | +1.00 | +0.47 | +0.49 | +0.71 |
| 0.71 | +0.54 | +0.47 | +1.00 | +0.76 | +0.67 |
| 0.54 | +0.71 | +0.49 | +0.76 | +1.00 | +0.70 |
| 0.47 | +0.49 | +0.71 | +0.67 | +0.70 | +1.00 |
Bonferroni and WPGSD bounds can then be computed via
+generate_bounds(). In this example, we useHSD(-4) as \(\alpha\)-spending for all hypotheses. Of
+note, generate_bounds() input type specifies boundary
+type.
-
+
- 0 = Bonferroni. Separate alpha spending for each hypotheses. +
- 1 = Fixed alpha spending for all hypotheses. Method 3a in the +manuscript. +
- 2 = Overall alpha spending for all hypotheses. Method 3b in the +manuscript. +
- 3 = Separate alpha spending for each hypotheses. Method 3c in the +manuscript. +
Compute Bonferroni bounds.
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+
+
+
+
+
+| Bonferroni bounds | +||||
| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0030 | +NA | +NA |
| 1 | +H1, H2 | +0.0015 | +0.0015 | +NA |
| 1 | +H1, H2, H3 | +0.0009 | +0.0009 | +0.0012 |
| 1 | +H1, H3 | +0.0013 | +NA | +0.0016 |
| 1 | +H2 | +NA | +0.0030 | +NA |
| 1 | +H2, H3 | +NA | +0.0013 | +0.0016 |
| 1 | +H3 | +NA | +NA | +0.0030 |
| 2 | +H1 | +0.0238 | +NA | +NA |
| 2 | +H1, H2 | +0.0118 | +0.0118 | +NA |
| 2 | +H1, H2, H3 | +0.0070 | +0.0070 | +0.0094 |
| 2 | +H1, H3 | +0.0106 | +NA | +0.0130 |
| 2 | +H2 | +NA | +0.0238 | +NA |
| 2 | +H2, H3 | +NA | +0.0106 | +0.0130 |
| 2 | +H3 | +NA | +NA | +0.0238 |
Compute WPGSD Bounds using \(\alpha\)-spending approach 1 with HSD(-4) +spending. Here spending time was defined as minimum of the 3 observed +information fractions.
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+
+
+
+
+
+| WPGSD bounds | +||||
| Analysis | +Hypotheses | +H1 | +H2 | +H3 | +
|---|---|---|---|---|
| 1 | +H1 | +0.0030 | +NA | +NA |
| 1 | +H1, H2 | +0.0017 | +0.0017 | +NA |
| 1 | +H1, H2, H3 | +0.0011 | +0.0011 | +0.0014 |
| 1 | +H1, H3 | +0.0014 | +NA | +0.0018 |
| 1 | +H2 | +NA | +0.0030 | +NA |
| 1 | +H2, H3 | +NA | +0.0015 | +0.0018 |
| 1 | +H3 | +NA | +NA | +0.0030 |
| 2 | +H1 | +0.0238 | +NA | +NA |
| 2 | +H1, H2 | +0.0144 | +0.0144 | +NA |
| 2 | +H1, H2, H3 | +0.0092 | +0.0092 | +0.0123 |
| 2 | +H1, H3 | +0.0122 | +NA | +0.0149 |
| 2 | +H2 | +NA | +0.0238 | +NA |
| 2 | +H2, H3 | +NA | +0.0124 | +0.0152 |
| 2 | +H3 | +NA | +NA | +0.0238 |
Below shows the comparison between the Bonferroni and WPGSD bounds. +Nominal level at final analysis by using the WPGSD method increased by +up to 1.3× over those obtained via the Bonferroni approach.
+
+
+
+
+
+
+| Bonferroni and WPGSD Bounds | +||||||||
| Analysis | +Hypotheses | +H1.B | +H2.B | +H3.B | +H1.W | +H2.W | +H3.W | +xi | +
|---|---|---|---|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0009 | +0.0009 | +0.0012 | +0.0011 | +0.0011 | +0.0014 | +1.1770 |
| 1 | +H1, H2 | +0.0015 | +0.0015 | +NA | +0.0017 | +0.0017 | +NA | +1.1363 |
| 1 | +H1, H3 | +0.0013 | +NA | +0.0016 | +0.0014 | +NA | +0.0018 | +1.0810 |
| 1 | +H2, H3 | +NA | +0.0013 | +0.0016 | +NA | +0.0015 | +0.0018 | +1.0962 |
| 1 | +H1 | +0.0030 | +NA | +NA | +0.0030 | +NA | +NA | +1.0000 |
| 1 | +H2 | +NA | +0.0030 | +NA | +NA | +0.0030 | +NA | +1.0000 |
| 1 | +H3 | +NA | +NA | +0.0030 | +NA | +NA | +0.0030 | +1.0000 |
| 2 | +H1, H2, H3 | +0.0070 | +0.0070 | +0.0094 | +0.0092 | +0.0092 | +0.0123 | +1.3092 |
| 2 | +H1, H2 | +0.0118 | +0.0118 | +NA | +0.0144 | +0.0144 | +NA | +1.2250 |
| 2 | +H1, H3 | +0.0106 | +NA | +0.0130 | +0.0122 | +NA | +0.0149 | +1.1532 |
| 2 | +H2, H3 | +NA | +0.0106 | +0.0130 | +NA | +0.0124 | +0.0152 | +1.1735 |
| 2 | +H1 | +0.0238 | +NA | +NA | +0.0238 | +NA | +NA | +1.0000 |
| 2 | +H2 | +NA | +0.0238 | +NA | +NA | +0.0238 | +NA | +1.0000 |
| 2 | +H3 | +NA | +NA | +0.0238 | +NA | +NA | +0.0238 | +1.0000 |
Closed testing procedure can then be performed using
+closed_test().
## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+
+
+
+
+
+| Observed Nominal p-Values | +|||
| Analysis | +H1 | +H2 | +H3 | +
|---|---|---|---|
| 1 | +0.01 | +0.0004 | +0.03 |
| 2 | +0.05 | +0.002 | +0.015 |
test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+
+
+
+
+
+| Closed Testing Results | +|||
| H1 | +H2 | +H3 | +Analysis | +
|---|---|---|---|
| Fail | +Success | +Fail | +Analysis 1 |
| Fail | +Success | +Fail | +Analysis 2 |
+
+2.11 Implementation of +Example 2 with Common Control
+Similarly, codes below reproduce the result of Example 2 of Anderson et al. (2022), which uses spending +method 3c specified in the paper.
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+
+
+
+
+
+| Event Count | +|||
| H1 | +H2 | +Analysis | +Event | +
|---|---|---|---|
| 1 | +1 | +1 | +155 |
| 2 | +2 | +1 | +160 |
| 3 | +3 | +1 | +165 |
| 1 | +2 | +1 | +85 |
| 1 | +3 | +1 | +85 |
| 2 | +3 | +1 | +85 |
| 1 | +1 | +2 | +305 |
| 2 | +2 | +2 | +320 |
| 3 | +3 | +2 | +335 |
| 1 | +2 | +2 | +170 |
| 1 | +3 | +2 | +170 |
| 2 | +3 | +2 | +170 |
# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+
+
+
+
+
+| Correlation Matrix | +|||||
| H1_A1 | +H2_A1 | +H3_A1 | +H1_A2 | +H2_A2 | +H3_A2 | +
|---|---|---|---|---|---|
| 1.00 | +0.54 | +0.53 | +0.71 | +0.38 | +0.37 |
| 0.54 | +1.00 | +0.52 | +0.38 | +0.71 | +0.37 |
| 0.53 | +0.52 | +1.00 | +0.38 | +0.37 | +0.70 |
| 0.71 | +0.38 | +0.38 | +1.00 | +0.54 | +0.53 |
| 0.38 | +0.71 | +0.37 | +0.54 | +1.00 | +0.52 |
| 0.37 | +0.37 | +0.70 | +0.53 | +0.52 | +1.00 |
# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+
+
+
+
+
+| Bonferroni and WPGSD Bounds | +||||||||
| Analysis | +Hypotheses | +H1.B | +H2.B | +H3.B | +H1.W | +H2.W | +H3.W | +xi | +
|---|---|---|---|---|---|---|---|---|
| 1 | +H1, H2, H3 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +0.0002 | +1.0421 |
| 1 | +H1, H2 | +0.0005 | +0.0004 | +NA | +0.0005 | +0.0004 | +NA | +1.0266 |
| 1 | +H1, H3 | +0.0005 | +NA | +0.0004 | +0.0005 | +NA | +0.0004 | +1.0247 |
| 1 | +H2, H3 | +NA | +0.0004 | +0.0004 | +NA | +0.0004 | +0.0004 | +1.0230 |
| 1 | +H1 | +0.0017 | +NA | +NA | +0.0017 | +NA | +NA | +1.0000 |
| 1 | +H2 | +NA | +0.0015 | +NA | +NA | +0.0015 | +NA | +1.0000 |
| 1 | +H3 | +NA | +NA | +0.0014 | +NA | +NA | +0.0014 | +1.0000 |
| 2 | +H1, H2, H3 | +0.0083 | +0.0083 | +0.0083 | +0.0095 | +0.0095 | +0.0095 | +1.1493 |
| 2 | +H1, H2 | +0.0123 | +0.0124 | +NA | +0.0135 | +0.0135 | +NA | +1.0942 |
| 2 | +H1, H3 | +0.0123 | +NA | +0.0124 | +0.0135 | +NA | +0.0135 | +1.0898 |
| 2 | +H2, H3 | +NA | +0.0124 | +0.0124 | +NA | +0.0134 | +0.0134 | +1.0855 |
| 2 | +H1 | +0.0245 | +NA | +NA | +0.0245 | +NA | +NA | +1.0000 |
| 2 | +H2 | +NA | +0.0245 | +NA | +NA | +0.0245 | +NA | +1.0000 |
| 2 | +H3 | +NA | +NA | +0.0245 | +NA | +NA | +0.0245 | +1.0000 |
+
+2.12 Power +Considerations
+The above illustrates the use of the WPGSD approach to compute bounds +at the analysis stage. At the design stage, one can take one of the +following 2 options: 1) The trial can be first designed as if the +testing would be done with a weighted Bonferroni with conservative +sample size estimate. At the analysis stage, the correlation can be +taken into consideration with the WPGSD approach for bound calculation; +or 2) To adjust the sample size downward using the WPGSD approach at the +design stage, one can power the study by taking the minimum \(p\)-value bound for a given individual +hypothesis from the WPGSD table (with assumed correlation structure). +For example, for \(H_2\) of example 1, +this is \(\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010\) +for \(k=1\) and \(\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081\) +for \(k=2\). Then the \(H_2\) bounds of 0.0010 (\(k=1\)) and 0.0081 (\(k=2\)) can be used to power \(H_2\). R function for the 2nd option is in +development.
+
+
+3 Conclusions
+The WPGSD approach provides an unification of previous work on +parametric testing in group sequential design. It enabled more complex +scenarios and requires attention to consonance and intersection +hypotheses. Although detailed closed testing is required, this should +not be a deterrent. The approach accommodates various spending +approaches and provides more relaxed bounds and improved power compared +to the Bonferroni approach.
+
+
+
+
+
+References
+
+
+
+Anderson, Keaven M, Zifang Guo, Jing Zhao, and Linda Z Sun. 2022.
+“A Unified Framework for Weighted Parametric Group Sequential
+Design.” Biometrical Journal 64 (7): 1219–39.
+
+
+Bretz, Frank, Martin Posch, Ekkehard Glimm, Florian Klinglmueller, Willi
+Maurer, and Kornelius Rohmeyer. 2011. “Graphical Approaches for
+Multiple Comparison Procedures Using Weighted Bonferroni, Simes, or
+Parametric Tests.” Biometrical Journal 53 (6): 894–913.
+
+
+Chen, Ting-Yu, Jing Zhao, Linda Sun, and Keaven M Anderson. 2021.
+“Multiplicity for a Group Sequential Trial with Biomarker
+Subpopulations.” Contemporary Clinical Trials 101:
+106249.
+
+
+Maurer, Willi, and Frank Bretz. 2013. “Multiple Testing in Group
+Sequential Trials Using Graphical Approaches.” Statistics in
+Biopharmaceutical Research 5 (4): 311–20.
+
+
+Xi, Dong, Ekkehard Glimm, Willi Maurer, and Frank Bretz. 2017. “A
+Unified Framework for Weighted Parametric Multiple Test
+Procedures.” Biometrical Journal 59 (5): 918–31.
+
+}}\preformatted{my_function <- function(data, var, ...) \{
+ data \%>\%
+ group_by(...) \%>\%
+ summarise(mean = mean(\{\{ var \}\}))
+\}
+}\if{html}{\out{
}}
+\item \code{\link[=enquo]{enquo()}} and \code{\link[=enquos]{enquos()}} delay the execution of one or several
+function arguments. The former returns a single expression, the
+latter returns a list of expressions. Once defused, expressions
+will no longer evaluate on their own. They must be injected back
+into an evaluation context with \verb{!!} (for a single expression) and
+\verb{!!!} (for a list of expressions).
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, ...) \{
+ # Defuse
+ var <- enquo(var)
+ dots <- enquos(...)
+
+ # Inject
+ data \%>\%
+ group_by(!!!dots) \%>\%
+ summarise(mean = mean(!!var))
+\}
+}\if{html}{\out{
}}
+
+In this simple case, the code is equivalent to the usage of \verb{\{\{}
+and \code{...} above. Defusing with \code{enquo()} or \code{enquos()} is only
+needed in more complex cases, for instance if you need to inspect
+or modify the expressions in some way.
+\item The \code{.data} pronoun is an object that represents the current
+slice of data. If you have a variable name in a string, use the
+\code{.data} pronoun to subset that variable with \code{[[}.
+
+\if{html}{\out{}}\preformatted{my_var <- "disp"
+mtcars \%>\% summarise(mean = mean(.data[[my_var]]))
+}\if{html}{\out{
}}
+\item Another tidy eval operator is \verb{:=}. It makes it possible to use
+glue and curly-curly syntax on the LHS of \code{=}. For technical
+reasons, the R language doesn't support complex expressions on
+the left of \code{=}, so we use \verb{:=} as a workaround.
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, suffix = "foo") \{
+ # Use `\{\{` to tunnel function arguments and the usual glue
+ # operator `\{` to interpolate plain strings.
+ data \%>\%
+ summarise("\{\{ var \}\}_mean_\{suffix\}" := mean(\{\{ var \}\}))
+\}
+}\if{html}{\out{
}}
+\item Many tidy eval functions like \code{dplyr::mutate()} or
+\code{dplyr::summarise()} give an automatic name to unnamed inputs. If
+you need to create the same sort of automatic names by yourself,
+use \code{as_label()}. For instance, the glue-tunnelling syntax above
+can be reproduced manually with:
+
+\if{html}{\out{}}\preformatted{my_function <- function(data, var, suffix = "foo") \{
+ var <- enquo(var)
+ prefix <- as_label(var)
+ data \%>\%
+ summarise("\{prefix\}_mean_\{suffix\}" := mean(!!var))
+\}
+}\if{html}{\out{
}}
+
+Expressions defused with \code{enquo()} (or tunnelled with \verb{\{\{}) need
+not be simple column names, they can be arbitrarily complex.
+\code{as_label()} handles those cases gracefully. If your code assumes
+a simple column name, use \code{as_name()} instead. This is safer
+because it throws an error if the input is not a name as expected.
+}
+}
+\keyword{internal}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd b/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd
new file mode 100644
index 0000000..bc49567
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/man/wpgsd-package.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/wpgsd-package.R
+\docType{package}
+\name{wpgsd-package}
+\alias{wpgsd}
+\alias{wpgsd-package}
+\title{wpgsd: Weighted Parametric Group Sequential Design}
+\description{
+\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
+
+Adjusted inference for weighted parametric group sequential design. Weighted parametric group sequential design (WPGSD) by Anderson et al. (2022) \doi{10.1002/bimj.202100085} allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here, correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+}
+\seealso{
+Useful links:
+\itemize{
+ \item \url{https://merck.github.io/wpgsd/}
+ \item \url{https://github.com/Merck/wpgsd}
+ \item Report bugs at \url{https://github.com/Merck/wpgsd/issues}
+}
+
+}
+\author{
+\strong{Maintainer}: Yujie Zhao \email{yujie.zhao@merck.com}
+
+Authors:
+\itemize{
+ \item Keaven Anderson \email{keaven_anderson@merck.com}
+ \item Zifang Guo \email{zifang.guo@merck.com}
+ \item Jing Zhao \email{jing_zhaox@merck.com}
+ \item Linda Sun \email{linda_sun@merck.com}
+ \item Yi Cui \email{yi.cui@merck.com}
+ \item Larry Leon \email{larry.leon2@merck.com}
+}
+
+Other contributors:
+\itemize{
+ \item Merck Sharp & Dohme Corp [copyright holder]
+}
+
+}
+\keyword{internal}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R
new file mode 100644
index 0000000..39921f0
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(wpgsd)
+
+test_check("wpgsd")
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R
new file mode 100644
index 0000000..d378ff3
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/helper-generate_corr_new.R
@@ -0,0 +1,126 @@
+# Helper functions used by test-independent-generate_corr_new.R
+
+#' Generate correlation matrix based on event counts
+#'
+#' @param event Event count of each hypothesis at each analysis, including
+#' event count of the intersection of hypotheses.
+#' It contains 4 columns: `H1`, `H2`, `Analysis`, `Event`.
+#' `H1` needs to be listed as 1, 2, 3, etc. as numbers.
+#'
+#' @return A correlation matrix.
+#'
+#' @importFrom dplyr filter select %>%
+#'
+#' @export
+#'
+#' @examples
+#' # Build the transition matrix
+#' m <- matrix(c(
+#' 0, 0.5, 0.5,
+#' 0.5, 0, 0.5,
+#' 0.5, 0.5, 0
+#' ), nrow = 3, byrow = TRUE)
+#' # initialize weights
+#' w <- c(1 / 3, 1 / 3, 1 / 3)
+#'
+#' # Input event count of intersection of paired hypotheses - Table 2
+#' event <- tibble::tribble(
+#' ~H1, ~H2, ~Analysis, ~Event,
+#' 1, 1, 1, 155,
+#' 2, 2, 1, 160,
+#' 3, 3, 1, 165,
+#' 1, 2, 1, 85,
+#' 1, 3, 1, 85,
+#' 2, 3, 1, 85,
+#' 1, 1, 2, 305,
+#' 2, 2, 2, 320,
+#' 3, 3, 2, 335,
+#' 1, 2, 2, 170,
+#' 1, 3, 2, 170,
+#' 2, 3, 2, 170
+#' )
+#'
+#' # Generate correlation from events
+#' gs_corr <- generate_corr_new(event)
+generate_corr_new <- function(event) {
+ elem <- event %>% subset(H1 == H2)
+ inter <- event %>% subset(H1 != H2)
+ n_hypotheses <- max(as.numeric(elem$H1))
+ n_analyses <- max(elem$Analysis)
+
+ # Diagonal
+ D <- diag(elem$Event)
+
+ # Within hypothesis across analyses
+ if (n_analyses > 1) {
+ for (i in 1:n_hypotheses) {
+ for (j in 1:(n_analyses - 1)) {
+ count <- D[(j - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i]
+ for (k in (j + 1):n_analyses) {
+ D[(j - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + i] <- count
+ D[(k - 1) * n_hypotheses + i, (j - 1) * n_hypotheses + i] <- count
+ }
+ }
+ }
+ }
+
+ # Between hypotheses and analyses
+ for (i in 1:(n_hypotheses - 1)) {
+ for (j in c((i + 1):n_hypotheses)) {
+ for (k in 1:n_analyses) {
+ count1 <- as.numeric(event %>%
+ subset(((H1 == i & H2 == j) | (H1 == j & H2 == i)) & Analysis == k) %>%
+ select(Event))[1]
+ for (l in (k:n_analyses)) {
+ D[n_hypotheses * (l - 1) + i, n_hypotheses * (k - 1) + j] <- count1
+ D[n_hypotheses * (l - 1) + j, n_hypotheses * (k - 1) + i] <- count1
+ D[n_hypotheses * (k - 1) + j, n_hypotheses * (l - 1) + i] <- count1
+ D[n_hypotheses * (k - 1) + i, n_hypotheses * (l - 1) + j] <- count1
+ }
+ }
+ }
+ }
+
+ corr_mat <- d_corr(D)
+
+ col_names <- NULL
+ for (k in 1:n_analyses) {
+ for (i in 1:n_hypotheses) {
+ name_tmp <- paste("H", i, "_A", k, sep = "")
+ col_names <- c(col_names, name_tmp)
+ }
+ }
+
+ colnames(corr_mat) <- col_names
+
+ return(corr_mat)
+}
+
+test_generate_corr_new <- function() {
+ a1 <- 80
+ b1 <- 100
+ ab1 <- 60
+ a2 <- 120
+ b2 <- 150
+ ab2 <- 80
+
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, a1,
+ 2, 2, 1, b1,
+ 1, 2, 1, ab1,
+ 1, 1, 2, a2,
+ 2, 2, 2, b2,
+ 1, 2, 2, ab2
+ )
+
+ list(
+ "a1" = a1,
+ "b1" = b1,
+ "ab1" = ab1,
+ "a2" = a2,
+ "b2" = b2,
+ "ab2" = ab2,
+ "event" = event
+ )
+}
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R
new file mode 100644
index 0000000..9c2a339
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R
@@ -0,0 +1,23 @@
+test_that("Generate event table returns the expected sorted data", {
+ expected_data <- tibble(
+ one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
+ another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
+ analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
+ common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335)
+ )
+
+ event <- data.frame(
+ Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
+ IA = c(70, 75, 80, 85),
+ FA = c(135, 150, 165, 170)
+ )
+
+ hypothesis <- list(
+ H1 = "Experimental 1 vs. Control",
+ H2 = "Experimental 2 vs. Control",
+ H3 = "Experimental 1 vs. Experimental 2"
+ )
+
+ result_table <- generate_event_table_cc(event, hypothesis)
+ expect_identical(result_table, expected_data)
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R
new file mode 100644
index 0000000..c611242
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-developer-generate_event_population_addhypo.R
@@ -0,0 +1,23 @@
+test_that("Generate event table ol returns the expected sorted data", {
+ expected_data <- tibble(
+ one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
+ another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
+ analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
+ common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450)
+ )
+
+ event <- data.frame(
+ Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
+ IA = c(100, 110, 80, 225),
+ FA = c(200, 220, 160, 450)
+ )
+
+ hypothesis <- list(
+ H1 = "Efficacy in Population 1",
+ H2 = "Efficacy in Population 2",
+ H3 = "Efficacy in Overall population"
+ )
+
+ result_table <- generate_event_table_ol(event, hypothesis)
+ expect_identical(result_table, expected_data)
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R
new file mode 100644
index 0000000..ef088a0
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-closed_test.R
@@ -0,0 +1,25 @@
+test_that("closed_test reject hypothesis as expected", {
+ p_obs <- dplyr::bind_rows(
+ tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001),
+ tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001)
+ )
+
+ bound <- tibble::tribble(
+ ~Analysis, ~Hypotheses, ~H1, ~H2,
+ 1, "H1", 0.02, NA,
+ 1, "H1, H2", 0.0001, 0.00001,
+ 1, "H2", NA, 0.003,
+ 2, "H1", 0.02, NA,
+ 2, "H1, H2", 0.02, 0.00001,
+ 2, "H2", NA, 0.003
+ )
+
+ closed_test <- closed_test(bound, p_obs)
+ closed_test_a1 <- closed_test %>% dplyr::filter(Analysis == "Analysis 1")
+ closed_test_a2 <- closed_test %>% dplyr::filter(Analysis == "Analysis 2")
+
+ expect_equal(closed_test_a1$H1, "Fail")
+ expect_equal(closed_test_a1$H2, "Fail")
+ expect_equal(closed_test_a2$H1, "Success")
+ expect_equal(closed_test_a2$H2, "Success")
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R
new file mode 100644
index 0000000..67d474b
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_bounds.R
@@ -0,0 +1,580 @@
+test_that("BH bounds replicate tables A3 and A4", {
+ # Example 1 BH weighting results in Table A3 and A4
+ set.seed(1234)
+
+ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex1 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+ # Transition matrix in Figure A1
+ m <- matrix(c(
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+ ), nrow = 3, byrow = TRUE)
+ # Initial weights
+ w <- c(0.3, 0.3, 0.4)
+
+ # Event count of intersection of paired hypotheses - Table 1
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+ )
+ event
+
+ # Generate correlation from events
+ corr <- generate_corr(event)
+ corr # correlation matrix in Table 3
+
+ # WPGSD bounds, spending method 3b
+ bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = gsDesign::sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+ )
+
+ # Bonferroni bounds
+ bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfHSD, gsDesign::sfHSD, gsDesign::sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+ )
+
+ # Combine and back-calculate xi
+ bounds <- dplyr::left_join(
+ bound_Bonf,
+ bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+ )
+ bounds <- bounds %>%
+ dplyr::rowwise() %>%
+ dplyr::mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+ # Reorder for output
+ bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+ bounds <- bounds %>% dplyr::arrange(Analysis, order)
+
+ # Z-statistics boundary, Table A4
+ zbounds <- bounds %>%
+ dplyr::mutate(
+ zH1.B = -qnorm(H1.B),
+ zH2.B = -qnorm(H2.B),
+ zH3.B = -qnorm(H3.B),
+ zH1.W = -qnorm(H1.W),
+ zH2.W = -qnorm(H2.W),
+ zH3.W = -qnorm(H3.W)
+ ) %>%
+ select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W)
+
+
+ # Table A3
+ # Test H1
+ # From publication Weighted Bonferroni
+ A3_result1 <- c(
+ 0.0009, 0.0015, 0.0013, NA,
+ 0.003, NA, NA, 0.007, 0.0118,
+ 0.0101, NA, 0.0238, NA, NA
+ )
+
+ A3_result1_test <- round(bounds$H1.B, 4)
+
+ expect_equal(A3_result1_test, A3_result1)
+
+ # WPGSD
+
+ wA3_result1 <- c(
+ 0.0011, 0.0017, 0.0014, NA,
+ 0.003, NA, NA, 0.0092, 0.0144,
+ 0.0116, NA, 0.0238, NA, NA
+ )
+
+ wA3_result1_test <- round(bounds$H1.W, 4)
+
+ expect_equal(wA3_result1_test, wA3_result1)
+
+
+ # Table A4
+ # Test H1
+ # From publication Weighted Bonferroni
+ A4_result1 <- c(
+ 3.12, 2.97, 3.02, NA, 2.75, NA, NA,
+ 2.46, 2.26, 2.32, NA, 1.98, NA, NA
+ )
+
+ A4_result1_test <- round(zbounds$zH1.B, 2)
+
+ expect_equal(A4_result1_test, A4_result1)
+
+ # WPGSD
+ wA4_result1 <- c(
+ 3.08, 2.93, 2.99, NA, 2.75, NA, NA,
+ 2.36, 2.19, 2.27, NA, 1.98, NA, NA
+ )
+
+ wA4_result1_test <- round(zbounds$zH1.W, 2)
+
+ expect_equal(wA4_result1_test, wA4_result1)
+
+
+ ########################
+ # Next, reproduce H2?
+ ########################
+
+ A3_result2 <- c(
+ 0.0009, 0.0015, NA, 0.0013, NA,
+ 0.003, NA, 0.007, 0.0118, NA, 0.0101, NA, 0.0238, NA
+ )
+
+ A3_result2_test <- round(bounds$H2.B, 4)
+
+ expect_equal(A3_result2_test, A3_result2)
+
+ # WPGSD
+
+ wA3_result2 <- c(
+ 0.0011, 0.0017, NA, 0.0014, NA,
+ 0.003, NA, 0.0092, 0.0144,
+ NA, 0.0118, NA, 0.0238, NA
+ )
+
+ wA3_result2_test <- round(bounds$H2.W, 4)
+
+ expect_equal(wA3_result2_test, wA3_result2)
+
+ # A4
+
+ A4_result2 <- c(
+ 3.12, 2.97, NA, 3.02, NA, 2.75, NA, 2.46, 2.26, NA, 2.32,
+ NA, 1.98, NA
+ )
+
+ A4_result2_test <- round(zbounds$zH2.B, 2)
+
+ expect_equal(A4_result2_test, A4_result2)
+
+ # WPGSD
+ wA4_result2 <- c(
+ 3.08, 2.93, NA, 2.99, NA, 2.75, NA, 2.36, 2.19,
+ NA, 2.26, NA, 1.98, NA
+ )
+
+ wA4_result2_test <- round(zbounds$zH2.W, 2)
+
+ expect_equal(wA4_result2_test, wA4_result2)
+
+
+ ########################
+ # Next, reproduce H3?
+ ########################
+
+ A3_result3 <- c(
+ 0.0012, NA, 0.0017, 0.0017, NA, NA, 0.003, 0.0094, NA,
+ 0.0135, 0.0135, NA, NA, 0.0238
+ )
+
+ A3_result3_test <- round(bounds$H3.B, 4)
+
+ expect_equal(A3_result3_test, A3_result3)
+
+ # WPGSD
+
+ wA3_result3 <- c(
+ 0.0014, NA, 0.0018, 0.0019, NA, NA, 0.003, 0.0123, NA,
+ 0.0155, 0.0158, NA, NA, 0.0238
+ )
+
+ wA3_result3_test <- round(bounds$H3.W, 4)
+
+ expect_equal(wA3_result3_test, wA3_result3)
+
+ # A4
+
+ A4_result3 <- c(3.04, NA, 2.93, 2.93, NA, NA, 2.75, 2.35, NA, 2.21, 2.21, NA, NA, 1.98)
+
+ A4_result3_test <- round(zbounds$zH3.B, 2)
+
+ expect_equal(A4_result3_test, A4_result3)
+
+ # WPGSD
+ wA4_result3 <- c(2.99, NA, 2.9, 2.9, NA, NA, 2.75, 2.25, NA, 2.16, 2.15, NA, NA, 1.98)
+
+ wA4_result3_test <- round(zbounds$zH3.W, 2)
+
+ expect_equal(wA4_result3_test, wA4_result3)
+})
+
+test_that("BH bounds replicate tables A6 and A7", {
+ # From wpgsd github:
+ # Example 2 BH weighting results in Table A6 and A7
+ set.seed(1234)
+
+ # Transition matrix in Figure A2
+ m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+ ), nrow = 3, byrow = TRUE)
+ # Initial weights
+ w <- c(1 / 3, 1 / 3, 1 / 3)
+
+ # Event count of intersection of paired hypotheses - Table 2
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+ )
+ event
+
+ # Generate correlation from events
+ corr <- generate_corr(event)
+ corr # correlation matrix in Table 4
+
+ # WPGSD bounds, spending method 3c
+ bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+ )
+
+ # Bonferroni bounds
+ bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+ )
+
+ bounds <- dplyr::left_join(
+ bound_Bonf,
+ bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+ )
+
+ # Reorder for output
+ bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+ bounds <- bounds %>% arrange(Analysis, order)
+
+ # Table A6
+ bounds
+
+ bounds <- bounds %>% arrange(Analysis, order)
+
+ # Z-statistics boundary, Table A7
+ zbounds <- bounds %>%
+ mutate(
+ zH1.B = -qnorm(H1.B),
+ zH2.B = -qnorm(H2.B),
+ zH3.B = -qnorm(H3.B),
+ zH1.W = -qnorm(H1.W),
+ zH2.W = -qnorm(H2.W),
+ zH3.W = -qnorm(H3.W)
+ ) %>%
+ select(Analysis, Hypotheses, zH1.B, zH2.B, zH3.B, zH1.W, zH2.W, zH3.W)
+
+
+ # Table A6
+ # Test H1
+ # From publication Weighted Bonferroni
+ A6_result1 <- c(
+ 0.00021488,
+ 0.000458864,
+ 0.000458864,
+ NA,
+ 0.001665671,
+ NA,
+ NA,
+ 0.008259394,
+ 0.0123448,
+ 0.0123448,
+ NA,
+ 0.024455472,
+ NA,
+ NA
+ )
+
+ A6_result1_test <- round(bounds$H1.B, 4)
+
+ expect_equal(A6_result1_test, round(A6_result1, 4))
+
+ # H2
+
+ A6_result2 <- c(
+ 0.000190676,
+ 0.000411979,
+ NA,
+ 0.000411979,
+ NA,
+ 0.001525323,
+ NA,
+ 0.0082675,
+ 0.012360191,
+ NA,
+ 0.012360191,
+ NA,
+ 0.024499778,
+ NA
+ )
+
+ A6_result2_test <- round(bounds$H2.B, 4)
+
+ expect_equal(A6_result2_test, round(A6_result2, 4))
+
+ # H3
+
+ A6_result3 <- c(
+ 0.000170445,
+ NA,
+ 0.000372343,
+ 0.000372343,
+ NA,
+ NA,
+ 0.001404398,
+ 0.008274305,
+ NA,
+ 0.012373258,
+ 0.012373258,
+ NA,
+ NA,
+ 0.024538108
+ )
+
+ A6_result3_test <- round(bounds$H3.B, 4)
+
+ expect_equal(A6_result3_test, round(A6_result3, 4))
+
+ ########
+ # WPGSD
+ ########
+
+ wA6_result1 <- c(
+ 0.000224701,
+ 0.000471076,
+ 0.000470177,
+ NA,
+ 0.001665671,
+ NA,
+ NA,
+ 0.009491524,
+ 0.013508544,
+ 0.013452942,
+ NA,
+ 0.024455472,
+ NA,
+ NA
+ )
+
+ wA6_result1_test <- round(bounds$H1.W, 4)
+
+ expect_equal(wA6_result1_test, round(wA6_result1, 4))
+
+
+
+ wA6_result2 <- c(
+ 0.00019939,
+ 0.000422943,
+ NA,
+ 0.000421453,
+ NA,
+ 0.001525323,
+ NA,
+ 0.00950084,
+ 0.013525386,
+ NA,
+ 0.01341849,
+ NA,
+ 0.024499778,
+ NA
+ )
+
+ wA6_result2_test <- round(bounds$H2.W, 4)
+
+ expect_equal(wA6_result2_test, round(wA6_result2, 4))
+
+
+ wA6_result3 <- c(
+ 0.000178234,
+ NA,
+ 0.000381523,
+ 0.000380905,
+ NA,
+ NA,
+ 0.001404398,
+ 0.00950866,
+ NA,
+ 0.013483955,
+ 0.013432676,
+ NA,
+ NA,
+ 0.024538108
+ )
+
+ wA6_result3_test <- round(bounds$H3.W, 4)
+
+ expect_equal(wA6_result3_test, round(wA6_result3, 4))
+
+
+ # Z-statistics
+
+
+ # Table A7
+ A7_result1 <- c(
+ 3.521099809,
+ 3.314604451,
+ 3.314604451,
+ NA,
+ 2.93538486,
+ NA,
+ NA,
+ 2.397246926,
+ 2.246225001,
+ 2.246225001,
+ NA,
+ 1.969367163,
+ NA,
+ NA
+ )
+
+ A7_result1_test <- round(zbounds$zH1.B, 4)
+
+ expect_equal(A7_result1_test, round(A7_result1, 4))
+
+
+ A7_result2 <- c(
+ 3.552662921,
+ 3.34461863,
+ NA,
+ 3.34461863,
+ NA,
+ 2.962588043,
+ NA,
+ 2.396887486,
+ 2.245744429,
+ NA,
+ 2.245744429,
+ NA,
+ 1.968595527,
+ NA
+ )
+
+ A7_result2_test <- round(zbounds$zH2.B, 4)
+
+ expect_equal(A7_result2_test, round(A7_result2, 4))
+
+
+
+ A7_result3 <- c(
+ 3.582064348,
+ NA,
+ 3.372575697,
+ 3.372575697,
+ NA,
+ NA,
+ 2.987923795,
+ 2.396585993,
+ NA,
+ 2.24533684,
+ 2.24533684,
+ NA,
+ NA,
+ 1.967928919
+ )
+
+ A7_result3_test <- round(zbounds$zH3.B, 4)
+
+ expect_equal(A7_result3_test, round(A7_result3, 4))
+
+
+
+
+
+ # Table A7
+ wA7_result1 <- c(
+ 3.509232997,
+ 3.307254785,
+ 3.307789645,
+ NA,
+ 2.93538486,
+ NA,
+ NA,
+ 2.345863682,
+ 2.21127083,
+ 2.212880514,
+ NA,
+ 1.969367163,
+ NA,
+ NA
+ )
+
+ wA7_result1_test <- round(zbounds$zH1.W, 4)
+
+ expect_equal(wA7_result1_test, round(wA7_result1, 4))
+
+
+ wA7_result2 <- c(
+ 3.540889382,
+ 3.337326516,
+ NA,
+ 3.338307071,
+ NA,
+ 2.962588043,
+ NA,
+ 2.345498009,
+ 2.210784367,
+ NA,
+ 2.213880806,
+ NA,
+ 1.968595527,
+ NA
+ )
+
+
+ wA7_result2_test <- round(zbounds$zH2.W, 4)
+
+ expect_equal(wA7_result2_test, round(wA7_result2, 4))
+
+
+
+ wA7_result3 <- c(
+ 3.570376445,
+ NA,
+ 3.365863239,
+ 3.366309865,
+ NA,
+ NA,
+ 2.987923795,
+ 2.345191286,
+ NA,
+ 2.21198197,
+ 2.213468666,
+ NA,
+ NA,
+ 1.967928919
+ )
+
+ wA7_result3_test <- round(zbounds$zH3.W, 4)
+
+ expect_equal(wA7_result3_test, round(wA7_result3, 4))
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R
new file mode 100644
index 0000000..a1699f5
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr.R
@@ -0,0 +1,31 @@
+test_that("2 endpoints 2 analysis correlation as expected", {
+ a1 <- 80
+ b1 <- 100
+ ab1 <- 60
+ a2 <- 120
+ b2 <- 150
+ ab2 <- 80
+
+ event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, a1,
+ 2, 2, 1, b1,
+ 1, 2, 1, ab1,
+ 1, 1, 2, a2,
+ 2, 2, 2, b2,
+ 1, 2, 2, ab2
+ )
+
+ corr <- generate_corr(event)
+ corr_test <- matrix(
+ c(
+ 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2),
+ ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2),
+ a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2),
+ ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1
+ ),
+ nrow = 4, byrow = TRUE
+ )
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test)
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R
new file mode 100644
index 0000000..aae7943
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-independent-generate_corr_new.R
@@ -0,0 +1,62 @@
+test_that("2 endpoints 2 analysis correlation as expected", {
+ res <- test_generate_corr_new()
+ a1 <- res$a1
+ b1 <- res$b1
+ ab1 <- res$ab1
+ a2 <- res$a2
+ b2 <- res$b2
+ ab2 <- res$ab2
+ event <- res$event
+
+ corr <- generate_corr_new(event)
+ corr_test <- matrix(
+ c(
+ 1, ab1 / sqrt(a1 * b1), a1 / sqrt(a1 * a2), ab1 / sqrt(a1 * b2),
+ ab1 / sqrt(a1 * b1), 1, ab1 / sqrt(a2 * b1), b1 / sqrt(b1 * b2),
+ a1 / sqrt(a1 * a2), ab1 / sqrt(a2 * b1), 1, ab2 / sqrt(a2 * b2),
+ ab1 / sqrt(a1 * b2), b1 / sqrt(b1 * b2), ab2 / sqrt(a2 * b2), 1
+ ),
+ nrow = 4, byrow = TRUE
+ )
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 4, byrow = TRUE), corr_test)
+})
+
+# This is a 2 hypothesis, 3 analysis example
+test_that("2 hypotheses 3 analysis correlation as expected", {
+ event <- tibble::tribble(
+ ~Analysis, ~H1, ~H2, ~Event,
+ 1, 1, 1, 147,
+ 1, 2, 2, 167,
+ 1, 1, 2, 88,
+ 2, 1, 1, 278,
+ 2, 2, 2, 289,
+ 2, 1, 2, 158,
+ 3, 1, 1, 342,
+ 3, 2, 2, 350,
+ 3, 1, 2, 192
+ )
+ corr <- generate_corr_new(event)
+ n_hypotheses <- 2
+ n_analyses <- 3
+ corr_test <- diag(1, n_hypotheses * n_analyses)
+ for (k in 1:n_analyses) {
+ for (l in k:n_analyses) {
+ for (i in 1:(n_hypotheses)) {
+ countkii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == k))$Event)
+ for (j in i:n_hypotheses) {
+ countkjj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == k))$Event)
+ countljj <- as.numeric((event %>% filter(H1 == j & H2 == j & Analysis == l))$Event)
+ countlii <- as.numeric((event %>% filter(H1 == i & H2 == i & Analysis == l))$Event)
+ countkij <- as.numeric((event %>% filter(H1 == i & H2 == j & Analysis == k))$Event)
+ corr_test[(k - 1) * n_hypotheses + i, (l - 1) * n_hypotheses + j] <- countkij / sqrt(countkii * countljj)
+ corr_test[(k - 1) * n_hypotheses + j, (l - 1) * n_hypotheses + i] <- countkij / sqrt(countkjj * countlii)
+ corr_test[(l - 1) * n_hypotheses + i, (k - 1) * n_hypotheses + j] <- countkij / sqrt(countlii * countkjj)
+ corr_test[(l - 1) * n_hypotheses + j, (k - 1) * n_hypotheses + i] <- countkij / sqrt(countljj * countkii)
+ }
+ }
+ }
+ }
+
+ expect_equal(matrix(corr %>% as.numeric(), nrow = 6, byrow = TRUE), corr_test)
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R
new file mode 100644
index 0000000..ceca45c
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/tests/testthat/test-s7-event-table.R
@@ -0,0 +1,171 @@
+test_that("EventTable can be created with valid data", {
+ # Create valid event data
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 1, 2, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 1, 2, 2, 170
+ )
+
+ # Create EventTable
+ event_table <- EventTable(data = event_data)
+
+ # Check that object was created successfully
+ expect_true(S7::S7_inherits(event_table, EventTable))
+ expect_equal(event_table@n_hypotheses, 2L)
+ expect_equal(event_table@n_analyses, 2L)
+ expect_equal(nrow(event_table@data), 6)
+})
+
+test_that("EventTable validates required columns", {
+ # Missing Event column
+ invalid_data1 <- tibble::tibble(
+ H1 = c(1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data1),
+ "EventTable requires columns: Event"
+ )
+
+ # Missing H1 column
+ invalid_data2 <- tibble::tibble(
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data2),
+ "EventTable requires columns: H1"
+ )
+})
+
+test_that("EventTable validates data types and values", {
+ # Non-numeric H1
+ invalid_data1 <- tibble::tibble(
+ H1 = c("A", "B"),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data1),
+ "@data\\$H1 and @data\\$H2 must be numeric"
+ )
+
+ # Negative hypothesis index
+ invalid_data2 <- tibble::tibble(
+ H1 = c(-1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data2),
+ "Hypothesis indices \\(H1, H2\\) must be positive integers"
+ )
+
+ # Negative event count
+ invalid_data3 <- tibble::tibble(
+ H1 = c(1, 2),
+ H2 = c(1, 2),
+ Analysis = c(1, 1),
+ Event = c(-100, 200)
+ )
+
+ expect_error(
+ EventTable(data = invalid_data3),
+ "Event counts must be non-negative"
+ )
+})
+
+test_that("EventTable print method works", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ event_table <- EventTable(data = event_data)
+
+ # Test the show method (which S7 uses for printing)
+ expect_output(show(event_table), "EventTable with 2 rows")
+ expect_output(show(event_table), "Hypotheses: 2")
+ expect_output(show(event_table), "Analyses: 1")
+})
+
+test_that("subset_event_table works correctly", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 1, 2, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 1, 2, 2, 170
+ )
+
+ event_table <- EventTable(data = event_data)
+
+ # Subset by analysis
+ subset_a1 <- subset_event_table(event_table, analysis = 1)
+ expect_equal(subset_a1@n_analyses, 1L)
+ expect_equal(nrow(subset_a1@data), 3)
+
+ # Subset by hypotheses
+ subset_h1 <- subset_event_table(event_table, hypotheses = c(1))
+ expect_equal(nrow(subset_h1@data), 2) # Only H1-H1 pairs
+
+ # Error for non-EventTable input
+ expect_error(
+ subset_event_table(data.frame(), analysis = 1),
+ "x must be an EventTable object"
+ )
+})
+
+test_that("as_event_table conversion works", {
+ event_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ # Convert tibble to EventTable
+ event_table <- as_event_table(event_data)
+ expect_true(S7::S7_inherits(event_table, EventTable))
+
+ # Should return same object if already EventTable
+ event_table2 <- as_event_table(event_table)
+ expect_identical(event_table, event_table2)
+})
+
+test_that("validate_event_table_data works", {
+ # Valid data should pass
+ valid_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160
+ )
+
+ expect_true(validate_event_table_data(valid_data))
+
+ # Invalid data should fail
+ invalid_data <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, # Missing Event column
+ 1, 1, 1,
+ 2, 2, 1
+ )
+
+ expect_error(
+ validate_event_table_data(invalid_data),
+ "Missing required columns: Event"
+ )
+})
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/.build.timestamp b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/.build.timestamp
new file mode 100644
index 0000000..e69de29
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R
new file mode 100644
index 0000000..d7b1892
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.R
@@ -0,0 +1,384 @@
+## ----message = FALSE, warning = FALSE-----------------------------------------
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+
+## -----------------------------------------------------------------------------
+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,
+)
+
+## -----------------------------------------------------------------------------
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+
+## -----------------------------------------------------------------------------
+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
+
+## -----------------------------------------------------------------------------
+# 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
+
+## -----------------------------------------------------------------------------
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+
+## ----wpgsdSeqIA, message=FALSE------------------------------------------------
+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)
+)
+
+## ----weightedBonferroniSeqIA, message=FALSE-----------------------------------
+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)
+)
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd
new file mode 100644
index 0000000..df94c1c
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p.Rmd
@@ -0,0 +1,810 @@
+---
+title: "Adjusted sequential p-values"
+author: "Yujie Zhao, Qi Liu, Linda Sun, Keaven Anderson"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+# bibliography: "example.bib"
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Adjusted sequential p-values}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(wpgsd)
+library(gsDesign)
+library(tibble)
+library(gt)
+library(dplyr)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- \item $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- \item $H_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
+
+```{r}
+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
+
+```{r}
+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")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+The information fraction of $H_1, H_2, H_3$ at IA is
+
+```{r}
+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
+```
+
+We assign the initial weights of $H_1, H_2, H_3$ as$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected, then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+# 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)
+```
+
+```{r}
+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
+
+```{r}
+# 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
+
+# Generate correlation from events
+gs_corr <- wpgsd::generate_corr(event)
+gs_corr %>% round(2)
+```
+
+# Sequential p-value
+
+## IA
+
+```{r, wpgsdSeqIA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqIA, message=FALSE}
+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
+
+```{r, wpgsdSeqFA, message=FALSE}
+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)
+)
+```
+
+```{r, weightedBonferroniSeqFA, message=FALSE}
+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
+
+```{r, wpgsdAdjSeqIA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqIA}
+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")
+```
+
+## FA
+
+### WPGSD
+```{r, wpgsdAdjSeqFA}
+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")
+```
+
+```{r, weightedBonferroniAdjSeqFA}
+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")
+```
+
+# Summary
+
+```{r}
+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()
+```
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png
new file mode 100644
index 0000000..378c2b8
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/adj-seq-p_files/figure-html/unnamed-chunk-6-1.png differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd
new file mode 100644
index 0000000..df67ae9
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/corr_calculation.Rmd
@@ -0,0 +1,180 @@
+---
+title: "Correlated test statistics"
+author: "Chenguang Zhang, Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Correlated test statistics}
+bibliography: wpgsd.bib
+---
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm.
+
+# Methodologies to calculate correlations
+
+Suppose that in a group sequential trial there are $m$ elementary null hypotheses $H_i$, $i \in I={1,...,m}$, and there are $K$ analyses. Let $k$ be the index for the interim analyses and final analyses, $k=1,2,...K$. For any nonempty set $J \subseteq I$, we denote the intersection hypothesis $H_J=\cap_{j \in J}H_j$. We note that $H_I$ is the global null hypothesis.
+
+We assume the plan is for all hypotheses to be tested at each of the $k$ planned analyses if the trial continues to the end for all hypotheses. We further assume that the distribution of the $m \times K$ tests of $m$ individual hypotheses at all $k$ analyses is multivariate normal with a completely known correlation matrix.
+
+Let $Z_{ik}$ be the standardized normal test statistic for hypothesis $i \in I$, analysis $1 \le k \le K$. Let $n_{ik}$ be the number of events collected cumulatively through stage $k$ for hypothesis $i$. Then $n_{i \wedge i',k \wedge k'}$ is the number of events included in both $Z_{ik}$ and $i$, $i' \in I$, $1 \le k$, $k' \le K$. The key of the parametric tests to utilize the correlation among the test statistics. The correlation between $Z_{ik}$ and $Z_{i'k'}$ is
+$$Corr(Z_{ik},Z_{i'k'})=\frac{n_{i \wedge i',k \wedge k'}}{\sqrt{n_{ik}*n_{i'k'}}}$$.
+
+# Examples
+
+We borrow an example from a paper by Anderson et al. (@anderson2022unified), demonstrated in Section 2 - Motivating Examples, we use Example 1 as the basis here. The setting will be:
+
+In a two-arm controlled clinical trial with one primary endpoint, there are three patient populations defined by the status of two biomarkers, A and B:
+
+* Biomarker A positive, the population 1,
+* Biomarker B positive, the population 2,
+* Overall population.
+
+The 3 primary elementary hypotheses are:
+
+* **H1**: the experimental treatment is superior to the control in the population 1
+* **H2**: the experimental treatment is superior to the control in the population 2
+* **H3**: 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. The number of events are listed as
+```{r,message=FALSE}
+library(dplyr)
+library(tibble)
+library(gt)
+```
+
+```{r}
+event_tb <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap of Population 1 and 2", 80, 160,
+ "Overall Population", 225, 450
+)
+event_tb %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population")
+```
+
+## Correlation of different populations within the same analysis
+Let's consider a simple situation, we want to compare the population 1 and population 2 in only interim analyses. Then $k=1$, and to compare $H_{1}$ and $H_{2}$, the $i$ will be $i=1$ and $i=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{21})=\frac{n_{1 \wedge 2,1 \wedge 1}}{\sqrt{n_{11}*n_{21}}}$$
+The number of events are listed as
+```{r}
+event_tbl <- tribble(
+ ~Population, ~"Number of Event in IA",
+ "Population 1", 100,
+ "Population 2", 110,
+ "Overlap in population 1 and 2", 80
+)
+event_tbl %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population in example 1")
+```
+The the corrleation could be simply calculated as
+$$Corr(Z_{11},Z_{21})=\frac{80}{\sqrt{100*110}}=0.76$$
+```{r}
+Corr1 <- 80 / sqrt(100 * 110)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses within the same population
+Let's consider another simple situation, we want to compare single population, for example, the population 1, but in different analyses, interim and final analyses. Then $i=1$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$Corr(Z_{11},Z_{12})=\frac{n_{1 \wedge 1,1 \wedge 2}}{\sqrt{n_{11}*n_{12}}}$$
+The number of events are listed as
+```{r}
+event_tb2 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200
+)
+event_tb2 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each analyses in example 2")
+```
+The the corrleation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{12})=\frac{100}{\sqrt{100*200}}=0.71$$
+The 100 in the numerator is the overlap number of events of interim analysis and final analysis in population 1.
+```{r}
+Corr1 <- 100 / sqrt(100 * 200)
+round(Corr1, 2)
+```
+
+## Correlation of different analyses and different population
+Let's consider the situation that we want to compare population 1 in interim analyses and population 2 in final analyses. Then for different population, $i=1$ and $i=2$, and to compare IA and FA, the $k$ will be $k=1$ and $k=2$.
+The correlation matrix will be
+$$\text{Corr}(Z_{11},Z_{22})=\frac{n_{1 \wedge 1,2 \wedge 2}}{\sqrt{n_{11}*n_{22}}}$$
+The number of events are listed as
+```{r}
+event_tb3 <- tribble(
+ ~Population, ~"Number of Event in IA", ~"Number of Event in FA",
+ "Population 1", 100, 200,
+ "Population 2", 110, 220,
+ "Overlap in population 1 and 2", 80, 160
+)
+event_tb3 %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses in example 3")
+```
+
+The correlation could be simply calculated as
+$$\text{Corr}(Z_{11},Z_{22})=\frac{80}{\sqrt{100*220}}=0.54$$
+The 80 in the numerator is the overlap number of events of population 1 in interim analysis and population 2 in final analysis.
+```{r}
+Corr1 <- 80 / sqrt(100 * 220)
+round(Corr1, 2)
+```
+
+# Generate the correlation matrix by `generate_corr()`
+Now we know how to calculate the correlation values under different situations, and the `generate_corr()` function was built based on this logic. We can directly calculate the results for each cross situation via the function.
+
+First, we need a event table including the information of the study.
+
+- `H1` refers to one hypothesis, selected depending on the interest, while `H2` refers to the other hypothesis, both of which are listed for multiplicity testing. For example, `H1` means the experimental treatment is superior to the control in the population 1/experimental arm 1; `H2` means the experimental treatment is superior to the control in the population 2/experimental arm 2;
+- `Analysis` means different analysis stages, for example, 1 means the interim analysis, and 2 means the final analysis;
+- `Event` is the common events overlap by `H1` and `H2`.
+
+For example: `H1=1`, `H2=1`, `Analysis=1`, `Event=100 `indicates that in the first population, there are 100 cases where the experimental treatment is superior to the control in the interim analysis.
+
+Another example: `H1=1`, `H2=2`, `Analysis=2`, `Event=160` indicates that the number of overlapping cases where the experimental treatment is superior to the control in population 1 and 2 in the final analysis is 160.
+
+To be noticed, the column names in this function are fixed to be `H1`, `H2`, `Analysis`, `Event`.
+```{r, message=FALSE}
+library(wpgsd)
+# The event table
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Number of events at each population & analyses")
+```
+
+Then we input the above event table to the function of `generate_corr()`, and get the correlation matrix as follow.
+```{r}
+generate_corr(event)
+```
+
+# References
+
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css
new file mode 100644
index 0000000..3054002
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/custom.css
@@ -0,0 +1,122 @@
+body {
+ font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, "Helvetica Neue", Arial, "Noto Sans", "Liberation Sans", sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji";
+ font-size: 16px;
+ line-height: 1.5;
+ color: #000;
+ padding-top: 25px;
+ padding-bottom: 25px;
+}
+
+h1.title {
+ padding-bottom: 10px;
+}
+
+h1, h2, h3, h4, h5, h6 {
+ color: #000;
+ font-weight: 500;
+}
+
+h1.title {
+ font-size: 38px;
+}
+
+h1 {
+ font-size: 32px;
+}
+
+h2 {
+ font-size: 28px;
+}
+
+h3 {
+ font-size: 24px;
+}
+
+h4 {
+ font-size: 20px;
+}
+
+h5 {
+ font-size: 18px;
+}
+
+h6 {
+ font-size: 16px;
+}
+
+h4.author {
+ padding-bottom: 10px;
+}
+
+h4.author>em {
+ font-size: 14px;
+ font-style: normal;
+ font-weight: 300;
+}
+
+h4.date {
+ padding-bottom: 10px;
+}
+
+h4.date>em {
+ font-size: 14px;
+ font-style: normal;
+ font-weight: 300;
+}
+
+a {
+ color: #00857c;
+ text-decoration: none;
+}
+
+a:hover, a:focus, a:active {
+ color: #005c55;
+ text-decoration: underline;
+}
+
+a:focus {
+ outline: thin dotted;
+}
+
+a:hover, a:active {
+ outline: 0;
+}
+
+pre, code {
+ font-family: SFMono-Regular, Menlo, Monaco, Consolas, "Liberation Mono", "Courier New", monospace;
+ background-color: #F7F7F7;
+}
+
+/* selection */
+
+::-moz-selection {
+ background: #6eceb2;
+}
+
+::selection {
+ background: #6eceb2;
+}
+
+/* float toc */
+
+.list-group-item.active, .list-group-item.active:focus, .list-group-item.active:hover {
+ background-color: #00857C;
+ border-color: #00857C;
+}
+
+/* figure */
+
+div.figure {
+ text-align: center;
+}
+
+p.caption {
+ text-align: center;
+}
+
+.footnote {
+ position: absolute;
+ bottom: 3em;
+ padding-right: 4em;
+ color: #00857C;
+}
\ No newline at end of file
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png
new file mode 100644
index 0000000..d335b8f
Binary files /dev/null and b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/figures/ex1-pop.png differ
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/tech-detail-wb.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/tech-detail-wb.Rmd
new file mode 100644
index 0000000..1eec9cb
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/tech-detail-wb.Rmd
@@ -0,0 +1,599 @@
+---
+title: "Procedure to compute p-value boundaries by weighted Bonferroni"
+author: "Yujie Zhao"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_float: true
+ toc_depth: 2
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+ code_fold: hide
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Procedure to compute p-value boundaries by weighted Bonferroni}
+---
+
+```{r, message = FALSE, warning = FALSE}
+library(tibble)
+library(gt)
+library(gsDesign)
+library(dplyr)
+library(wpgsd)
+```
+
+# 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:
+
+- $H_1$: the experimental treatment is superior to the control in the biomarker A positive population;
+- $H_2$: the experimental treatment is superior to the control in the biomarker B positive population;
+- $H_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
+
+```{r}
+k <- 2 # Number of total analysis
+n_hypotheses <- 3 # Number of hypotheses
+```
+
+## Observed p-values
+
+```{r}
+obs_tbl <- tribble(
+ ~hypothesis, ~analysis, ~obs_p,
+ "H1", 1, 0.02,
+ "H2", 1, 0.01,
+ "H3", 1, 0.006,
+ "H1", 2, 0.015,
+ "H2", 2, 0.012,
+ "H3", 2, 0.004
+) %>%
+ mutate(obs_Z = -qnorm(obs_p))
+
+obs_tbl %>%
+ gt() %>%
+ tab_header(title = "Nominal p-values")
+
+p_obs_IA <- (obs_tbl %>% filter(analysis == 1))$obs_p
+p_obs_FA <- (obs_tbl %>% filter(analysis == 2))$obs_p
+```
+
+## Information fraction
+
+```{r}
+alpha <- 0.025
+event_tbl <- tribble(
+ ~population, ~analysis, ~event,
+ "A positive", 1, 80,
+ "B positive", 1, 88,
+ "AB positive", 1, 64,
+ "overall", 1, 180,
+ "A positive", 2, 160,
+ "B positive", 2, 176,
+ "AB positive", 2, 128,
+ "overall", 2, 360,
+)
+```
+
+The information fraction of $H_1$, $H_2$, $H_3$ at IA is
+
+```{r}
+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
+```
+
+## Initial weight and transition matrix
+
+We assign the initial weights of $H_1$, $H_2$, $H_3$ as
+$\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 $H_1$ is rejected, then $3/7$ local significance level $\alpha_1$ will be
+propagated to $H_2$, and $4/7$ will go to $H_3$. If $H_3$ is rejected,
+then half of $\alpha_3$ goes to $H_1$, and half goes to $H_2$.
+
+```{r}
+m <- matrix(c( # Transition matrix
+ 0, 3 / 7, 4 / 7,
+ 3 / 7, 0, 4 / 7,
+ 1 / 2, 1 / 2, 0
+), nrow = 3, byrow = TRUE)
+
+w <- c(0.3, 0.3, 0.4) # Initial weights
+```
+
+```{r}
+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
+```
+
+```{r}
+# Get weights for all intersection hypotheses
+graph <- gMCPLite::matrix2graph(m)
+graph <- gMCPLite::setWeights(graph, w)
+```
+
+```{r}
+# Set up hypothetical p-values (0 or 1) to obtain all combinations
+pvals <- NULL
+for (i in 1:n_hypotheses) {
+ if (i == 1) {
+ pvals <- data.frame(x = c(0, 1))
+ names(pvals) <- paste("pval_H", i, sep = "")
+ } else {
+ tmp <- data.frame(x = c(0, 1))
+ names(tmp) <- paste("pval_H", i, sep = "")
+ pvals <- merge(pvals, tmp)
+ }
+}
+# Get the weights for each intersection hypothesis
+inter_weight <- NULL # Create an empty table to store the weight of interaction hypotheses
+for (i in seq_len(nrow(pvals))) { # Each row in `pvals` is 1 possible interaction hypothesis
+ pval_tmp <- as.numeric(pvals[i, ])
+ graph_tmp <- gMCPLite::gMCP(graph = graph, pvalues = pval_tmp, alpha = alpha)
+ weight_tmp <- gMCPLite::getWeights(graph_tmp)
+ inter_weight <- dplyr::bind_rows(inter_weight, weight_tmp)
+}
+
+inter_weight <- replace(inter_weight, pvals == 0, NA) # Replace the empty hypothesis as NA
+inter_weight <- inter_weight[-1, ] # Delete the first row since it is empty set
+
+inter_weight %>%
+ gt() %>%
+ tab_header("Weight of all possible interaction hypothesis")
+```
+
+## Correlations
+
+The correlation of the 6 statistic (2 analyses $\times$ 3 hypotheses) are
+
+```{r}
+# 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
+
+# Generate correlation from events
+corr <- wpgsd::generate_corr(event)
+corr %>% round(2)
+```
+
+# Boundary calculation
+
+## Boundary of $H_1$
+
+For the elementary hypothesis $H_1$, its weight is 1, namely,
+
+```{r}
+w_H1 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H1[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = NA
+)
+ans %>% gt()
+```
+
+## Boundary of $H_2$
+
+For the elementary hypothesis $H_2$, its weight is 1, namely,
+
+```{r}
+w_H2 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H2[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_3$
+
+For the elementary hypothesis $H_3$, its weight is 1, namely,
+
+```{r}
+w_H3 <- 1
+
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H3[1],
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H1
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_2$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H12 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), is.na(H3))
+w_H12 <- w_H12[(!is.na(w_H12))] # Remove NA from weight
+w_H12
+```
+
+And the boundary for $H_1$ and $H_2$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H12[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H12[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = NA
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_1 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H13 <- inter_weight %>% filter(!is.na(H1), is.na(H2), !is.na(H3))
+w_H13 <- w_H13[(!is.na(w_H13))] # Remove NA from weight
+w_H13
+```
+
+And the boundary for $H_1$ and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H13[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H13[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = NA,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H_2 \cap H_3$
+
+For the interaction hypothesis $H_2 \cap H_3$, its weight is
+
+```{r}
+w_H23 <- inter_weight %>% filter(is.na(H1), !is.na(H2), !is.na(H3))
+w_H23 <- w_H23[(!is.na(w_H23))] # Remove NA from weight
+w_H23
+```
+
+And the boundary for $H_2$ and $H_3$ are
+
+```{r}
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H23[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H23[2], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H2, H3",
+ `H1 p-value boundary` = NA,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+## Boundary of $H1 \cap H_2 \cap H_3$
+
+For the interaction hypothesis $H_1 \cap H_2$, its weight is
+
+```{r}
+w_H123 <- inter_weight %>% filter(!is.na(H1), !is.na(H2), !is.na(H3))
+w_H123 <- w_H123[(!is.na(w_H123))] # Remove NA from weight
+w_H123
+```
+
+And the boundary for $H_1$, $H_2$, and $H_3$ are
+
+```{r}
+# -------------#
+# H1 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H1", colnames(corr))
+corr_H1 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H1 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[1],
+ n.I = corr_H1[, ncol(corr_H1)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H2 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H2", colnames(corr))
+corr_H2 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H2 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[2],
+ n.I = corr_H2[, ncol(corr_H2)]^2,
+ alpha = alpha * w_H123[1], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+# -------------#
+# H3 #
+# -------------#
+# Index to select from the correlation matrix
+indx <- grep("H3", colnames(corr))
+corr_H3 <- corr[indx, indx]
+
+# Boundary for a single hypothesis across k for the intersection hypothesis
+pval_H3 <- 1 - pnorm(gsDesign::gsDesign(
+ k = k,
+ test.type = 1,
+ usTime = IF_IA[3],
+ n.I = corr_H3[, ncol(corr_H3)]^2,
+ alpha = alpha * w_H123[3], # alpha is different since the weight is updated
+ sfu = sfHSD,
+ sfupar = -4
+)$upper$bound)
+
+ans_new <- tibble(
+ Analysis = 1:2,
+ `Interaction/Elementary hypotheses` = "H1, H2, H3",
+ `H1 p-value boundary` = pval_H1,
+ `H2 p-value boundary` = pval_H2,
+ `H3 p-value boundary` = pval_H3
+)
+ans_new %>% gt()
+ans <- rbind(ans, ans_new)
+```
+
+# Summary
+
+With the p-value boundaries, one can get the Z-statistics boundaries by `qnorm()`.
+
+```{r}
+ans %>%
+ mutate(
+ `H1 Z-statistics boundary` = -qnorm(`H1 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H2 p-value boundary`),
+ `H1 Z-statistics boundary` = -qnorm(`H3 p-value boundary`)
+ ) %>%
+ arrange(Analysis, `Interaction/Elementary hypotheses`) %>%
+ gt() %>%
+ tab_header("p-values/Z-statistics boundaries of weighted Bonferroni")
+```
+
+# Implementation in wpgsd
+
+The above results can be computed in one function call in wpgsd by using
+the `generate_bounds()` function as
+
+```{r}
+generate_bounds(
+ type = 0,
+ k = 2,
+ w = w,
+ m = m,
+ corr = corr,
+ alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+) %>% gt()
+```
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd
new file mode 100644
index 0000000..4771094
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.Rmd
@@ -0,0 +1,591 @@
+---
+title: "Quickstart guide"
+author: "Zifang Guo, Keaven Anderson, Jing Zhao, Linda Z. Sun"
+output:
+ rmarkdown::html_document:
+ toc: true
+ toc_depth: 3
+ toc_float: true
+ code_folding: hide
+ number_sections: true
+ highlight: "textmate"
+ css: "custom.css"
+bibliography: wpgsd.bib
+vignette: >
+ %\VignetteIndexEntry{Quickstart guide}
+ %\VignetteEncoding{UTF-8}
+ %\VignetteEngine{knitr::rmarkdown}
+editor_options:
+ markdown:
+ wrap: 72
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ error = TRUE,
+ fig.align = "center"
+)
+```
+
+```{r, message=FALSE, warning=FALSE}
+library(wpgsd)
+library(gsDesign)
+library(gMCPLite)
+library(haven)
+library(dplyr)
+library(tidyr)
+library(reshape2)
+library(gt)
+```
+
+# Background
+
+The weighted parametric group sequential design (WPGSD) (@anderson2022unified) approach allows one to take advantage of the known correlation structure in constructing efficacy bounds to control family-wise error rate (FWER) for a group sequential design. Here correlation may be due to common observations in nested populations, due to common observations in overlapping populations, or due to common observations in the control arm. This document illustrates the use of the R package wpgsd to implement this approach.
+
+# Methods and Examples
+
+## Closed Testing and Parametric Tests
+
+We aim to control the familywise error rate (FWER) at level $\alpha$. Let $J \subseteq I$. The intersection hypothesis $H_J$ assumes the null hypothesis for all individual hypotheses $H_i$ with $i \in J$. Closed testing principle is as follows: if for all sets $J \subseteq I$ with $j \in J$, $H_J$ can be rejected at level $\alpha$, then $H_j$ can be rejected. Weighted parametric tests can be used for this: @bretz2011graphical, @xi2017unified for fixed designs or @maurer2013multiple for group sequential.
+
+## Consonance
+
+A closed procedure is called consonant if the rejection of the complete intersection null hypothesis $H_I$ further implies that at least one elementary hypothesis $H_i, i \in I$, is rejected. Consonance is a desirable property leading to short-cut procedures that give the same rejection decisions as the original closed procedure but with fewer operations. For WPGSD, consonance does not always hold and in general the closed-testing procedure is required.
+
+## Group Sequential Design Notations and Assumptions
+
+- A set $I$ of hypotheses for $i \in I$.
+- $K$ group sequential analyses, $k = 1, \ldots, K$
+- Single endpoint
+ * Not required, and can be generalized
+- Assume tests $Z_{ik}$, $i \in I$, $1 \leq k \leq K$ where a large $Z_{ik}$ is used to reject $H_i$
+
+## Correlation Structure
+
+- Notation
+ * Events for individual hypothesis $H_i$,$i \in I$ at analysis k denoted by $n_{ik}$.
+ * Assume the same endpoint for all hypotheses (can be relaxed)
+ * For binary or continuous outcomes $n_{ik}$ represents sample size
+ * $Z_{ik}$ is standardized normal test for treatment effect for individual hypothesis $H_i$ at analysis $k$
+ * Denote $n_{i\wedge i^\prime,k\wedge k^\prime}$ as the number of observations (or events) included in both $Z_{ik}$ and $Z_{i^\prime k^\prime}$, $i\in I$, $1\le k\le K$.
+- Key result
+ $$ \hbox{Corr}(Z_{ik}, Z_{i^\prime k^\prime }) = \frac{n_{i\wedge i^\prime ,k\wedge k^\prime }}{\sqrt{n_{ik}n_{i^\prime k^\prime }}} $$
+- Proof builds on standard group sequential theory (@chen2021multiplicity)
+
+## Example 1: Overlapping Populations, Two Analyses
+
+Following illustrates the first example, which has overlapping populations (e.g. due to biomarker) and is also example 1 in @anderson2022unified.
+
+```{r, eval=FALSE, echo=FALSE}
+library(ggplot2)
+library(ggforce)
+
+ellipse_data <- data.frame(
+ id = c("H1: Population 1", "H2: Population 2", "H3: Overall Population"),
+ x = c(0, 1, 0.5),
+ y = c(0, 0, 0),
+ a = c(1, 1, 2),
+ b = c(0.5, 0.5, 1)
+)
+
+ragg::agg_png(
+ "vignettes/figures/ex1-pop.png",
+ width = 1920,
+ height = 1920 / 1.618,
+ res = 96,
+ scaling = 2
+)
+ggplot() +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id == "H3: Overall Population", ],
+ color = NA, alpha = 0.5, show.legend = FALSE
+ ) +
+ geom_ellipse(
+ aes(
+ x0 = x, y0 = y, a = a, b = b, angle = 0, fill = id
+ ),
+ data = ellipse_data[ellipse_data$id != "H3: Overall Population", ],
+ color = NA, alpha = 0.85, show.legend = FALSE
+ ) +
+ geom_text(aes(
+ x = x, y = y, label = id,
+ hjust = ifelse(id == "H1: Population 1", 1.1,
+ ifelse(id == "H2: Population 2", -0.1, 0.5)
+ ),
+ vjust = ifelse(id == "H3: Overall Population", -9, 0.5)
+ ), data = ellipse_data, size = 6) +
+ scale_fill_manual(values = c("#E69F00", "#56B4E9", "#999999"), guide = "none") +
+ coord_fixed() +
+ theme_void()
+dev.off()
+```
+
+```{r, echo=FALSE, out.width="90%", fig.cap="Ex1: Populations"}
+knitr::include_graphics("figures/ex1-pop.png")
+```
+
+The multiplicity strategy is defined as follows.
+
+```{r, out.width="80%"}
+# Transition matrix
+m <- matrix(c(
+ 0, 0, 1,
+ 0, 0, 1,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Weight matrix
+w <- c(0.3, 0.3, 0.4)
+
+# Multiplicity graph
+cbPalette <- c("#999999", "#E69F00", "#56B4E9")
+
+nameHypotheses <- c(
+ "H1: Population 1",
+ "H2: Population 2",
+ "H3: Overall Population"
+)
+
+hplot <- hGraph(3,
+ alphaHypotheses = w,
+ m = m,
+ nameHypotheses = nameHypotheses,
+ 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 = cbPalette,
+ wchar = "w"
+)
+hplot
+```
+
+The event count of each hypothesis at each analysis is shown below.
+
+| Population | Number of Events at IA | Number of Events at FA |
+|:---------------------:|:----------------------:|:----------------------:|
+| Population 1 | 100 | 200 |
+| Population 2 | 110 | 220 |
+| Population 1 $\cap$ 2 | 80 | 160 |
+| Overall Population | 225 | 450 |
+
+Table: Number of events at each analysis for each population in Example 1.
+IA: interim analysis. FA: final analysis.
+
+The correlation matrix among test statistics is as follows.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{80}{\sqrt{100\cdot 110}}$ | $\frac{100}{\sqrt{100 \cdot 225}}$ | $\frac{100}{\sqrt{100\cdot 200}}$ | $\frac{80}{\sqrt{100\cdot 220}}$ | $\frac{100}{\sqrt{100 \cdot 450}}$ |
+| 2,1 | 0.76 | 1 | $\frac{110}{\sqrt{110 \cdot 225}}$ | $\frac{80}{\sqrt{110\cdot 200}}$ | $\frac{110}{\sqrt{110\cdot 220}}$ | $\frac{110}{\sqrt{110 \cdot 450}}$ |
+| 3,1 | 0.67 | 0.70 | 1 | $\frac{100}{\sqrt{225 \cdot 200}}$ | $\frac{110}{\sqrt{225 \cdot 220}}$ | $\frac{225}{\sqrt{225 \cdot 450}}$ |
+| 1,2 | 0.71 | 0.54 | 0.47 | 1 | $\frac{160}{\sqrt{200 \cdot 220}}$ | $\frac{200}{\sqrt{200 \cdot 450}}$ |
+| 2,2 | 0.54 | 0.71 | 0.49 | 0.76 | 1 | $\frac{220}{\sqrt{220 \cdot 450}}$ |
+| 3,2 | 0.47 | 0.49 | 0.71 | 0.67 | 0.70 | 1 |
+
+Table: Correlation Matrix of Test Statistics for Example 1.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Example 2: Common Control, Two Analyses
+
+Following illustrates the second example in which correlation comes from common control arm. This is also example 2 in @anderson2022unified.
+
+```{r, out.width="80%", echo = FALSE}
+cbPalette <- c(
+ "#999999", "#E69F00", "#56B4E9", "#009E73",
+ "#F0E442", "#0072B2", "#D55E00", "#CC79A7"
+)
+nameHypotheses <- c(
+ "H1: Experimental 1 vs Control",
+ "H2: Experimental 2 vs Control",
+ "H3: Experimental 3 vs Control"
+)
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+alphaHypotheses <- c(1 / 3, 1 / 3, 1 / 3)
+
+hplot <- hGraph(3,
+ alphaHypotheses = alphaHypotheses, m = m,
+ nameHypotheses = nameHypotheses, trhw = .2, trhh = .1,
+ digits = 3, trdigits = 4, size = 5, halfWid = 1.2, halfHgt = 0.5,
+ offset = 0.2, trprop = 0.35,
+ fill = as.factor(c(2, 3, 1)),
+ palette = cbPalette[1:3],
+ wchar = "w"
+)
+hplot
+```
+
+| Treatment Arm | Number of Events at IA | Number of Events at FA |
+|:--------------:|:----------------------:|:----------------------:|
+| Experimental 1 | 70 | 135 |
+| Experimental 2 | 75 | 150 |
+| Experimental 3 | 80 | 165 |
+| Control | 85 | 170 |
+
+Table: Number of events at each analysis for each treatment arm in Example 2.
+IA: interim analysis. FA: final analysis.
+
+| $i,k$ | 1,1 | 2,1 | 3,1 | 1,2 | 2,2 | 3,2 |
+|:---:|:---:|:---:|:---:|:---:|:---:|:---:|
+| 1,1 | 1 | $\frac{85}{\sqrt{155\cdot 160}}$ | $\frac{85}{\sqrt{155 \cdot 165}}$ | $\frac{155}{\sqrt{155\cdot 305}}$ | $\frac{85}{\sqrt{155\cdot 320}}$ | $\frac{85}{\sqrt{155 \cdot 335}}$ |
+| 2,1 | 0.54 | 1 | $\frac{85}{\sqrt{160 \cdot 165}}$ | $\frac{85}{\sqrt{160 \cdot 305}}$ | $\frac{160}{\sqrt{160\cdot 320}}$ | $\frac{85}{\sqrt{160 \cdot 335}}$ |
+| 3,1 | 0.53 | 0.52 | 1 | $\frac{85}{\sqrt{165 \cdot 305}}$ | $\frac{85}{\sqrt{165\cdot 320}}$ | $\frac{165}{\sqrt{165 \cdot 335}}$ |
+| 1,2 | 0.71 | 0.38 | 0.38 | 1 | $\frac{170}{\sqrt{305\cdot 320}}$ | $\frac{170}{\sqrt{305 \cdot 335}}$ |
+| 2,2 | 0.38 | 0.71 | 0.37 | 0.54 | 1 | $\frac{170}{\sqrt{320 \cdot 335}}$ |
+| 3,2 | 0.37 | 0.37 | 0.70 | 0.53 | 0.52 | 1 |
+
+Table: Correlation Matrix for Example 2.
+Identical numeric values (lower triangular) and formulas (upper triangular) shown.
+
+## Hypotheses Set
+
+These 2 examples each has 7 intersection hypotheses and the corresponding weighting strategies are illustrated below.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 0.3 | 0.3 | 0.4 |
+| $H_1 \cap H_2$ | 0.5 | 0.5 | - |
+| $H_1 \cap H_3$ | 0.3 | - | 0.7 |
+| $H_2 \cap H_3$ | - | 0.3 | 0.7 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 1.
+
+| $H_J$ | $w_1(J)$ | $w_2(J)$ | $w_3(J)$ |
+|:-----------------------:|:--------:|:--------:|:--------:|
+| $H_1 \cap H_2 \cap H_3$ | 1/3 | 1/3 | 1/3 |
+| $H_1 \cap H_2$ | 1/2 | 1/2 | - |
+| $H_1 \cap H_3$ | 1/2 | - | 1/2 |
+| $H_2 \cap H_3$ | - | 1/2 | 1/2 |
+| $H_1$ | 1 | - | - |
+| $H_2$ | - | 1 | - |
+| $H_3$ | - | - | 1 |
+
+Table: Weighting strategy of Example 2.
+
+## $\alpha$ Spending: 3 approaches
+
+The WPGSD approach uses all known correlations between tests in the study. This relaxes bounds and allows increased power or smaller sample size. Three spending approaches have been proposed:
+
+- Fixed spending (Fleming-Harrington-O'Brien (FHO) approach). Specify $0 < \alpha_1(J) < \alpha_2(J) < \ldots < \alpha_K(J) = \alpha(J) \leq \alpha$ for all $J\subseteq I$, where $\alpha(J)$ is the total alpha for intersection hypothesis $H_J$ according to the graphical approach.
+
+- $\alpha$-spending approach 1. We choose a spending function family $f(t,\alpha)$ and set $\alpha_k(J)=f(t_k(J),\alpha(J))$ for $1\le k\le K$ for all intersection hypotheses $J\subseteq I$.
+
+- $\alpha$-spending approach 2. For each elementary hypothesis $i$ ($i$ = 1, 2, \ldots, $m$), specify the $\alpha$-spending function family $f_i(t,\gamma)$ where $\gamma$ is the $\alpha$ level for the hypothesis and $f_i(t_{ik},\gamma)$ determines how much $\alpha$ to spend up to analysis $k$ for hypothesis $i$ when level $\gamma$ is allocated to the hypothesis. Then $\alpha_k(J) = \sum_{i \in J} f_i(t_{ik}, w_i(J)\alpha)$.
+
+## Bounds Computation: Parametric Test, Fixed Design (For Example, Two Populations, One Analysis)
+
+- Assume ($Z_1,Z_2$) bivariate normal with known correlation
+
+- Find $\alpha$-inflation factor $c_J$ such that
+ $$ \alpha = P[\cup_{i \in J} \{p_i \leq c_Jw_{J,i}\alpha \}] = P[\cup_{i \in J} \{Z_i \geq \Phi^{-1}(1-c_Jw_{J,i}\alpha \}]$$
+
+- Basic algorithm code in @bretz2011graphical
+
+### Bounds Computation: WPGSD - Fixed spending and $\alpha$ spending approach 1 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Initialize $\alpha_{k}^{*}(J) = \alpha_{k}(J) - \alpha_{k-1}(J)$.
+
+ ii Set $b_{ik} = \Phi^{-1}(1 - w_{i}(J)\alpha_{k}^{*} (J))$, $i\in J$.
+
+ iii Compute type I error rate up to analysis $k$
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ). $$
+
+ iv Update $\alpha_{k}^{*}(J)$ using root-finding with steps ii - iii until the type I error rate through analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}. $$
+
+ v Set $c_{ik}(J) = b_{ik}$ from the previous step. The corresponding nominal $p$-value boundary is $p_{ik}(J)= 1-\Phi(c_{ik}(J)) = w_i(J)\alpha_k^*(J)$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\alpha_{k}^{*}(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from mvtnorm R package Genz et al. (2020).
+
+### Bounds Computation: WPGSD - $\alpha$ spending approach 2 {.smaller}
+
+- Assume for $j < k$ that bounds $c_{ij} (J), i \in J, j < k$, have already been set and remain unchanged.
+
+- At analysis $k$, compute the correlation matrix of $Z_{ij}$, $i \in J$, $j = 1, \ldots, k$.
+
+ i Determine what the nominal $p$-value boundary would be for each elementary hypothesis in $J$ for a weighted Bonferroni test in a group sequential design as described in @maurer2013multiple. Let these nominal $p$-value boundaries be $\alpha^\prime_{ik}(J)$.
+
+ ii Choose an inflation factor $\xi_{k}(J) > 1$ and set $$b_{ik} = \Phi^{-1}(1 - \xi_k(J) \alpha^\prime_{ik}(J)).$$
+
+ iii Update $\xi_k(J)$ until this type I error rate up to analysis $k$ is controlled at $\alpha_{k}(J)$ for $H_J$. That is,
+ $$ 1 - Pr(\cap_{i \in J} \{ Z_{ik} < b_{ik} \} \cap_{i \in J, j < k} \{ Z_{ij} < c_{ij}(J) \} ) = \alpha_{k}(J).$$
+
+ iv After the appropriate $\xi_k(J)$ has been derived, the nominal $p$-value boundaries are $p_{ik}(J)=\xi_k(J) \alpha^\prime_{ik}(J)$, and $b_{ik}$ is computed as in step ii, we set $c_{ik}(J) = b_{ik}$.
+
+- Note: interim bound does not depend on future analyses. Solution only requires root finding for a single $\xi_k(J)$ at a time, $k = 1, \ldots, K$. Requires multivariate normal computation from the mvtnorm R package Genz et al. (2020).
+
+## Implementation of Example 1 with Overlapping Populations
+
+We first define the transition matrix and weights as shown above in Section 2.5. Next we set up the event count table as follows:
+
+- Analysis: Analysis number (1 for interim, 2 for final).
+- Event: Event counts.
+- H1, H2: Hypotheses intersected.
+ * (1, 1) represents counts for hypothesis 1
+ * (1, 2) for counts for the intersection of hypotheses 1 and 2
+
+```{r}
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 100,
+ 2, 2, 1, 110,
+ 3, 3, 1, 225,
+ 1, 2, 1, 80,
+ 1, 3, 1, 100,
+ 2, 3, 1, 110,
+ 1, 1, 2, 200,
+ 2, 2, 2, 220,
+ 3, 3, 2, 450,
+ 1, 2, 2, 160,
+ 1, 3, 2, 200,
+ 2, 3, 2, 220
+)
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Alternatively, one can manually enter paths for analysis datasets,
+# example below uses an example dataset assuming currently we are at IA1.
+paths <- system.file("extdata/", package = "wpgsd")
+
+### Generate event count table from ADSL and ADTTE datasets
+# Selection criteria for each hypothesis
+h_select <- tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD=='OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event2 <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event2 %>%
+ gt() %>%
+ tab_header(title = "Event Count - Computed from SAS Datasets Example")
+```
+
+Then we compute correlation matrix using the event count table and `generate_corr()`. We see that the correlations not accounted for by the Bonferroni approach are substantial and, thus, might expect a non-trivial impact on bounds for hypothesis tests.
+
+```{r}
+## Generate correlation from events
+corr <- generate_corr(event)
+
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+Bonferroni and WPGSD bounds can then be computed via `generate_bounds()`. In this example, we useHSD(-4) as $\alpha$-spending for all hypotheses. Of note, `generate_bounds()` input type specifies boundary type.
+
+- 0 = Bonferroni. Separate alpha spending for each hypotheses.
+- 1 = Fixed alpha spending for all hypotheses. Method 3a in the manuscript.
+- 2 = Overall alpha spending for all hypotheses. Method 3b in the manuscript.
+- 3 = Separate alpha spending for each hypotheses. Method 3c in the manuscript.
+
+Compute Bonferroni bounds.
+
+```{r}
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = list(sfHSD, sfHSD, sfHSD),
+ sfparm = list(-4, -4, -4),
+ t = list(c(0.5, 1), c(0.5, 1), c(0.5, 1))
+)
+
+bound_Bonf %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "Bonferroni bounds")
+```
+
+Compute WPGSD Bounds using $\alpha$-spending approach 1 with HSD(-4) spending. Here spending time was defined as minimum of the 3 observed information fractions.
+
+```{r}
+set.seed(1234)
+# WPGSD bounds, spending approach 1
+bound_WPGSD <- generate_bounds(
+ type = 2, k = 2, w = w, m = m,
+ corr = corr, alpha = 0.025,
+ sf = sfHSD,
+ sfparm = -4,
+ t = c(min(100 / 200, 110 / 220, 225 / 450), 1)
+)
+
+bound_WPGSD %>%
+ gt() %>%
+ fmt_number(columns = 3:5, decimals = 4) %>%
+ tab_header(title = "WPGSD bounds")
+```
+
+Below shows the comparison between the Bonferroni and WPGSD bounds. Nominal level at final analysis by using the WPGSD method increased by up to 1.3× over those obtained via the Bonferroni approach.
+
+```{r, echo=FALSE}
+# Combine and back-calculate xi
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+bounds <- bounds %>%
+ rowwise() %>%
+ mutate(xi = sum(H1.W, H2.W, H3.W, na.rm = TRUE) /
+ sum(H1.B, H2.B, H3.B, na.rm = TRUE))
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Bonferroni and WPGSD Bounds (Table 6 in the manuscript)
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+Closed testing procedure can then be performed using `closed_test()`.
+
+```{r}
+## Observed p-values.
+## The tibble must contain columns Analysis, H1, H2 etc for all hypotheses
+p_obs <- tribble(
+ ~Analysis, ~H1, ~H2, ~H3,
+ 1, 0.01, 0.0004, 0.03,
+ 2, 0.05, 0.002, 0.015
+)
+
+## Closed testing ##
+test_result <- closed_test(bound_WPGSD, p_obs)
+
+p_obs %>%
+ gt() %>%
+ fmt_number(columns = 2:4, decimals = 8, drop_trailing_zeros = TRUE) %>%
+ tab_header("Observed Nominal p-Values")
+```
+
+```{r}
+test_result %>%
+ gt() %>%
+ tab_header(title = "Closed Testing Results")
+```
+
+## Implementation of Example 2 with Common Control
+
+Similarly, codes below reproduce the result of Example 2 of @anderson2022unified, which uses spending method 3c specified in the paper.
+
+```{r}
+set.seed(1234)
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Ex2 BH ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
+# Transition matrix in Figure A2
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# Initial weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Event count of intersection of paired hypotheses - Table 2
+event <- tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+event %>%
+ gt() %>%
+ tab_header(title = "Event Count")
+```
+
+```{r}
+# Generate correlation from events
+corr <- generate_corr(event)
+
+# Correlation matrix in Table 4
+corr %>%
+ as_tibble() %>%
+ gt() %>%
+ fmt_number(columns = everything(), decimals = 2) %>%
+ tab_header(title = "Correlation Matrix")
+```
+
+```{r}
+# WPGSD bounds, spending method 3c
+bound_WPGSD <- generate_bounds(
+ type = 3, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+# Bonferroni bounds
+bound_Bonf <- generate_bounds(
+ type = 0, k = 2, w = w, m = m, corr = corr, alpha = 0.025,
+ sf = list(sfLDOF, sfLDOF, sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(155 / 305, 1), c(160 / 320, 1), c(165 / 335, 1))
+)
+
+bounds <- left_join(bound_Bonf, bound_WPGSD,
+ by = c("Hypotheses", "Analysis"),
+ suffix = c(".B", ".W")
+)
+
+# Reorder for output
+bounds$order <- rep(c(5, 2, 1, 3, 6, 4, 7), 2)
+bounds <- bounds %>%
+ arrange(Analysis, order) %>%
+ select(-order)
+
+# Table A6
+bounds %>%
+ gt() %>%
+ fmt_number(columns = 3:9, decimals = 4) %>%
+ tab_header(title = "Bonferroni and WPGSD Bounds")
+```
+
+## Power Considerations
+
+The above illustrates the use of the WPGSD approach to compute bounds at the analysis stage. At the design stage, one can take one of the following 2 options: 1) The trial can be first designed as if the testing would be done with a weighted Bonferroni with conservative sample size estimate. At the analysis stage, the correlation can be taken into consideration with the WPGSD approach for bound calculation; or 2) To adjust the sample size downward using the WPGSD approach at the design stage, one can power the study by taking the minimum $p$-value bound for a given individual hypothesis from the WPGSD table (with assumed correlation structure). For example, for $H_2$ of example 1, this is $\hbox{min}(0.0011,0.0017,0.0010,0.0030)=0.0010$ for $k=1$ and $\hbox{min}(0.0092,0.0144,0.0081,0.0238)=0.0081$ for $k=2$. Then the $H_2$ bounds of 0.0010 ($k=1$) and 0.0081 ($k=2$) can be used to power $H_2$. R function for the 2nd option is in development.
+
+# Conclusions
+
+The WPGSD approach provides an unification of previous work on parametric testing in group sequential design. It enabled more complex scenarios and requires attention to consonance and intersection hypotheses. Although detailed closed testing is required, this should not be a deterrent. The approach accommodates various spending approaches and provides more relaxed bounds
+and improved power compared to the Bonferroni approach.
+
+# References
diff --git a/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib
new file mode 100644
index 0000000..0285346
--- /dev/null
+++ b/wpgsd.Rcheck/vign_test/wpgsd/vignettes/wpgsd.bib
@@ -0,0 +1,53 @@
+@article{anderson2022unified,
+ title = {A unified framework for weighted parametric group sequential design},
+ author = {Anderson, Keaven M and Guo, Zifang and Zhao, Jing and Sun, Linda Z},
+ journal = {Biometrical Journal},
+ volume = {64},
+ number = {7},
+ pages = {1219--1239},
+ year = {2022},
+ publisher = {Wiley Online Library}
+}
+
+@article{bretz2011graphical,
+ title = {Graphical approaches for multiple comparison procedures using weighted Bonferroni, Simes, or parametric tests},
+ author = {Bretz, Frank and Posch, Martin and Glimm, Ekkehard and Klinglmueller, Florian and Maurer, Willi and Rohmeyer, Kornelius},
+ journal = {Biometrical Journal},
+ volume = {53},
+ number = {6},
+ pages = {894--913},
+ year = {2011},
+ publisher = {Wiley Online Library}
+}
+
+@article{chen2021multiplicity,
+ title = {Multiplicity for a group sequential trial with biomarker subpopulations},
+ author = {Chen, Ting-Yu and Zhao, Jing and Sun, Linda and Anderson, Keaven M},
+ journal = {Contemporary Clinical Trials},
+ volume = {101},
+ pages = {106249},
+ year = {2021},
+ publisher = {Elsevier}
+}
+
+@article{maurer2013multiple,
+ title = {Multiple testing in group sequential trials using graphical approaches},
+ author = {Maurer, Willi and Bretz, Frank},
+ journal = {Statistics in Biopharmaceutical Research},
+ volume = {5},
+ number = {4},
+ pages = {311--320},
+ year = {2013},
+ publisher = {Taylor \& Francis}
+}
+
+@article{xi2017unified,
+ title = {A unified framework for weighted parametric multiple test procedures},
+ author = {Xi, Dong and Glimm, Ekkehard and Maurer, Willi and Bretz, Frank},
+ journal = {Biometrical Journal},
+ volume = {59},
+ number = {5},
+ pages = {918--931},
+ year = {2017},
+ publisher = {Wiley Online Library}
+}
\ No newline at end of file
diff --git a/wpgsd.Rcheck/wpgsd-Ex.R b/wpgsd.Rcheck/wpgsd-Ex.R
new file mode 100644
index 0000000..826a36c
--- /dev/null
+++ b/wpgsd.Rcheck/wpgsd-Ex.R
@@ -0,0 +1,298 @@
+pkgname <- "wpgsd"
+source(file.path(R.home("share"), "R", "examples-header.R"))
+options(warn = 1)
+library('wpgsd')
+
+base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
+base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
+cleanEx()
+nameEx("calc_seq_p")
+### * calc_seq_p
+
+flush(stderr()); flush(stdout())
+
+### Name: calc_seq_p
+### Title: Calculate sequential p-values for interaction/elementary
+### hypothesis
+### Aliases: calc_seq_p
+
+### ** Examples
+
+
+
+
+cleanEx()
+nameEx("closed_test")
+### * closed_test
+
+flush(stderr()); flush(stdout())
+
+### Name: closed_test
+### Title: Perform closed testing procedure
+### Aliases: closed_test
+
+### ** Examples
+
+p_obs <- dplyr::bind_rows(
+ tibble::tibble(Analysis = 1, H1 = 0.001, H2 = 0.001),
+ tibble::tibble(Analysis = 2, H1 = 0.001, H2 = 0.001)
+)
+bound <- tibble::tribble(
+ ~Analysis, ~Hypotheses, ~H1, ~H2,
+ 1, "H1", 0.02, NA,
+ 1, "H1, H2", 0.0001, 0.00001,
+ 1, "H2", NA, 0.003,
+ 2, "H1", 0.02, NA,
+ 2, "H1, H2", 0.02, 0.00001,
+ 2, "H2", NA, 0.003
+)
+
+closed_test <- closed_test(bound, p_obs)
+
+
+
+cleanEx()
+nameEx("find_astar")
+### * find_astar
+
+flush(stderr()); flush(stdout())
+
+### Name: find_astar
+### Title: Utility function for root-finding to compute crossing
+### probabilities with the overall alpha spending approach
+### Aliases: find_astar
+
+### ** Examples
+
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_astar(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ astar = 1,
+ w = c(0.5, 0.5),
+ sig = my_corr[
+ colnames(my_corr) %in% c("H1_A1", "H2_A1"),
+ colnames(my_corr) %in% c("H1_A1", "H2_A1")
+ ]
+)
+
+
+
+cleanEx()
+nameEx("find_xi")
+### * find_xi
+
+flush(stderr()); flush(stdout())
+
+### Name: find_xi
+### Title: Utility function for root-finding to compute inflation factor xi
+### with the separate alpha spending approach
+### Aliases: find_xi
+
+### ** Examples
+
+# Input event count of intersection of paired hypotheses - Table 2
+my_event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+my_corr <- generate_corr(my_event)
+
+# Find the inflation factor for H1, H2 at analysis 1
+find_xi(
+ a = 0.0008708433,
+ alpha_prev = NULL,
+ aprime = c(0.0004588644, 0.0004119789),
+ xi = 1,
+ sig = my_corr[
+ colnames(my_corr) %in% c("H1_A1", "H2_A1"),
+ colnames(my_corr) %in% c("H1_A1", "H2_A1")
+ ]
+)
+
+
+
+cleanEx()
+nameEx("generate_bounds")
+### * generate_bounds
+
+flush(stderr()); flush(stdout())
+
+### Name: generate_bounds
+### Title: Compute p-value boundaries of the parametric MTP method with
+### overall alpha spending for all hypotheses
+### Aliases: generate_bounds
+
+### ** Examples
+
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+
+# Initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input information fraction
+IF_IA <- c(155 / 305, 160 / 320, 165 / 335)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+
+# Generate bounds
+generate_bounds(
+ type = 3,
+ k = 2,
+ w = w,
+ m = m,
+ corr = gs_corr,
+ alpha = 0.025,
+ sf = list(gsDesign::sfLDOF, gsDesign::sfLDOF, gsDesign::sfLDOF),
+ sfparm = list(0, 0, 0),
+ t = list(c(IF_IA[1], 1), c(IF_IA[2], 1), c(IF_IA[3], 1))
+)
+
+
+
+cleanEx()
+nameEx("generate_corr")
+### * generate_corr
+
+flush(stderr()); flush(stdout())
+
+### Name: generate_corr
+### Title: Generate correlation matrix based on event counts
+### Aliases: generate_corr
+
+### ** Examples
+
+# Build the transition matrix
+m <- matrix(c(
+ 0, 0.5, 0.5,
+ 0.5, 0, 0.5,
+ 0.5, 0.5, 0
+), nrow = 3, byrow = TRUE)
+# initialize weights
+w <- c(1 / 3, 1 / 3, 1 / 3)
+
+# Input event count of intersection of paired hypotheses - Table 2
+event <- tibble::tribble(
+ ~H1, ~H2, ~Analysis, ~Event,
+ 1, 1, 1, 155,
+ 2, 2, 1, 160,
+ 3, 3, 1, 165,
+ 1, 2, 1, 85,
+ 1, 3, 1, 85,
+ 2, 3, 1, 85,
+ 1, 1, 2, 305,
+ 2, 2, 2, 320,
+ 3, 3, 2, 335,
+ 1, 2, 2, 170,
+ 1, 3, 2, 170,
+ 2, 3, 2, 170
+)
+
+# Generate correlation from events
+gs_corr <- generate_corr(event)
+
+
+
+cleanEx()
+nameEx("generate_event_table")
+### * generate_event_table
+
+flush(stderr()); flush(stdout())
+
+### Name: generate_event_table
+### Title: Generate table of event counts from ADSL and ADTTE datasets
+### Aliases: generate_event_table
+
+### ** Examples
+
+library(dplyr)
+
+paths <- system.file("extdata/", package = "wpgsd")
+
+# Selection criteria for each hypothesis
+h_select <- tibble::tribble(
+ ~Hypothesis, ~Crit,
+ 1, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline High Dose', 'Placebo')",
+ 2, "PARAMCD == 'OS' & TRT01P %in% c('Xanomeline Low Dose', 'Placebo')"
+)
+
+event <- generate_event_table(paths, h_select,
+ adsl_name = "adsl", adtte_name = "adtte",
+ key_var = "USUBJID", cnsr_var = "CNSR"
+)$event
+
+event %>%
+ gt::gt() %>%
+ gt::tab_header(title = "Event Count - Computed from SAS Datasets Example")
+
+
+
+### *