Skip to content

Commit 8839951

Browse files
LittleBeannieLittleBeannie
authored
Merge pull request #45 from Merck/Event_Table
Event table update
2 parents 06db2e7 + b9fd0eb commit 8839951

5 files changed

Lines changed: 293 additions & 0 deletions

‎R/generate_event_cc.R‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
#' This function generates a table of events for given experimental arms and a control group based on specified hypotheses.
2+
#'
3+
#' @param event A dataframe containing the following columns:
4+
#' - `Population`: A character vector listing the population groups (e.g., experimental arms and control).
5+
#' - `IA`: A numeric vector indicating the number of events observed in each group during interim analysis.
6+
#' - `FA`: A numeric vector indicating the number of events observed in each group during final analysis.
7+
#' The dataframe must contain at least these columns and can include additional analysis columns as needed.
8+
#' @param hypothesis A list containing hypotheses specifying comparisons between experimental arms and the control group,
9+
#' as well as comparisons among experimental arms.
10+
#'
11+
#' @return A dataframe with columns:
12+
#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
13+
#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
14+
#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
15+
#' - `common_events`: The calculated number of common events associated with the selected hypotheses.
16+
#'
17+
#' @examples
18+
#' #------------------------Example of IA and FA
19+
#' event <- data.frame(
20+
#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
21+
#' IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group
22+
#' FA = c(135, 150, 165, 170)
23+
#' )
24+
#'
25+
#' hypothesis <- list(
26+
#' H1 = "Experimental 1 vs. Control",
27+
#' H2 = "Experimental 2 vs. Control",
28+
#' H3 = "Experimental 1 vs. Experimental 2"
29+
#' )
30+
#'
31+
#' generate_event_table_cc(event, hypothesis)
32+
#'
33+
#' #----------------------Example of two IAs and FA
34+
#' event <- data.frame(
35+
#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
36+
#' IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group
37+
#' IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group
38+
#' FA = c(135, 150, 165, 170)
39+
#' )
40+
#'
41+
#' hypothesis <- list(
42+
#' H1 = "Experimental 1 vs. Control",
43+
#' H2 = "Experimental 2 vs. Control",
44+
#' H3 = "Experimental 1 vs. Experimental 2"
45+
#' )
46+
#'
47+
#' generate_event_table_cc(event, hypothesis)
48+
generate_event_table_cc <- function(event, hypothesis) {
49+
result_df <- tibble(
50+
one_hypothesis = integer(),
51+
another_hypothesis = integer(),
52+
analysis = integer(),
53+
common_events = integer()
54+
)
55+
56+
# Iterate through the input data to calculate the events
57+
for (i in 1:length(hypothesis)) { # number of hypothesis
58+
for (j in i:length(hypothesis)) {
59+
for (k in 1:(ncol(event) - 1)) { # Iterate through the analyses
60+
if (i != j) {
61+
hyp_i <- unlist(strsplit(hypothesis[[i]], " vs. "))
62+
hyp_j <- unlist(strsplit(hypothesis[[j]], " vs. "))
63+
common_factor <- intersect(hyp_i, hyp_j)
64+
eventn <- event[event$Population == common_factor, k + 1]
65+
} else {
66+
eventn <- event[i, k + 1] + event[event$Population == "Control", k + 1]
67+
}
68+
69+
result_df <- rbind(result_df, tibble(
70+
one_hypothesis = i,
71+
another_hypothesis = j,
72+
analysis = k,
73+
common_events = eventn
74+
))
75+
result_df <- result_df[order(result_df$analysis), ]
76+
}
77+
}
78+
}
79+
return(result_df)
80+
}

‎R/generate_event_ol.R‎

Lines changed: 94 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
#' This function generates a table of events for specified populations based on the provided hypotheses.
2+
#'
3+
#' @param event` dataframe should have the following structure:
4+
#' - `Population`: A character vector indicating the population groups (e.g., "Population 1", "Population 2", "Population 1 Intersection 2", and "Overall population").
5+
#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis.
6+
#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis.
7+
#' The dataframe must contain at least these columns and can include additional analysis columns as needed.
8+
#' @param hypothesis A list of strings where each item represents a hypothesis regarding efficacy, formatted as follows:
9+
#' - H1: "Efficacy in Population 1"
10+
#' - H2: "Efficacy in Population 2"
11+
#' - H3: "Efficacy in Overall population"
12+
#' Each hypothesis is used for comparisons in the generated event table.
13+
#'
14+
#' @return A dataframe with the following columns:
15+
#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
16+
#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
17+
#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
18+
#' - `common_events`: The calculated number of common events associated with the selected hypotheses.
19+
#'
20+
#' @export
21+
#'
22+
#' @examples
23+
#' #------------------------Example of IA and FA
24+
#' event <- data.frame(
25+
#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
26+
#' IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group
27+
#' FA = c(200, 220, 160, 450)
28+
#' )
29+
#'
30+
#' hypothesis <- list(
31+
#' H1 = "Efficacy in Population 1",
32+
#' H2 = "Efficacy in Population 2",
33+
#' H3 = "Efficacy in Overall population"
34+
#' )
35+
#'
36+
#' generate_event_table_ol(event, hypothesis)
37+
#'
38+
#' #----------------------Example of two IAs and FA
39+
#' event <- data.frame(
40+
#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
41+
#' IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group
42+
#' IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group
43+
#' FA = c(200, 220, 160, 450)
44+
#' )
45+
#'
46+
#' hypothesis <- list(
47+
#' H1 = "Efficacy in Population 1",
48+
#' H2 = "Efficacy in Population 2",
49+
#' H3 = "Efficacy in Overall population"
50+
#' )
51+
#'
52+
#' generate_event_table_ol(event, hypothesis)
53+
#'
54+
generate_event_table_ol <- function(event, hypothesis) {
55+
result_df <- tibble(
56+
one_hypothesis = integer(),
57+
another_hypothesis = integer(),
58+
analysis = integer(),
59+
common_events = integer()
60+
)
61+
62+
for (i in 1:length(hypothesis)) {
63+
for (j in i:length(hypothesis)) {
64+
for (k in 1:(ncol(event) - 1)) {
65+
hyp_i <- unlist(strsplit(hypothesis[[i]], "Efficacy in "))[2]
66+
hyp_j <- unlist(strsplit(hypothesis[[j]], "Efficacy in "))[2]
67+
68+
common_factor <- intersect(hyp_i, hyp_j)
69+
70+
if (length(common_factor) > 0) {
71+
if ("Overall population" %in% c(hyp_i, hyp_j)) {
72+
eventn <- event[event$Population == "Overall population", k + 1]
73+
} else {
74+
eventn <- event[i, k + 1]
75+
}
76+
} else if ("Overall population" %in% c(hyp_i, hyp_j)) {
77+
eventn <- event[i, k + 1]
78+
} else {
79+
eventn <- event[event$Population == "Population 1 Intersection 2", k + 1]
80+
}
81+
82+
result_df <- rbind(result_df, tibble(
83+
one_hypothesis = i,
84+
another_hypothesis = j,
85+
analysis = k,
86+
common_events = eventn
87+
))
88+
result_df <- result_df[order(result_df$analysis), ]
89+
}
90+
}
91+
}
92+
93+
return(result_df)
94+
}

‎R/generate_event_table_.R‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
#' This function creates a table summarizing event counts based on specified hypotheses and user input data.
2+
#' It can handle two types of analysis: one comparing experimental groups to a common control and another analyzing the overlap of populations.
3+
#'
4+
#' @param event` dataframe should have the following structure:
5+
#' - `Population`: A character vector indicating the population groups. For example, "Population 1", "Population 2", "Overall population" in overlap population situation; or experimental arms and control in common control situation.
6+
#' - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis.
7+
#' - `FA`: Numeric vector indicating the number of events observed in each group during final analysis.
8+
#' The dataframe must contain at least these columns and can include additional analysis columns as needed.
9+
#' @param hypothesis A list containing hypotheses that specify the comparisons to be made between the groups:
10+
#' - For example:
11+
#' - "Experimental 1 vs. Control"
12+
#' - "Efficacy in Population 1"
13+
#'
14+
#' @param type A character string specifying the type of analysis to conduct. It should be one of the following:
15+
#' - `"common_control"`: Analyze the event counts comparing experimental groups to common control.
16+
#' - `"overlap_population"`: Analyze the event counts to assess overlap in populations.
17+
#'
18+
#' @return A dataframe with four columns:
19+
#' - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
20+
#' - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
21+
#' - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
22+
#' - `common_events`: The calculated number of common events associated with the selected hypotheses.
23+
#'
24+
#' @export
25+
#'
26+
#' @examples
27+
#' # ----------------------- Example of common control
28+
#' event <- data.frame(
29+
#' Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
30+
#' IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group.
31+
#' FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group.
32+
#' )
33+
#'
34+
#' hypothesis <- list(
35+
#' H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control.
36+
#' H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control.
37+
#' H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2.
38+
#' )
39+
#'
40+
#' generate_event_table_(event, hypothesis, type = "common_control")
41+
#'
42+
#' # ------------------------ Example of overall population
43+
#' event <- data.frame(
44+
#' Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
45+
#' IA = c(100, 110, 80, 225), # Interim analysis values for the overall population.
46+
#' FA = c(200, 220, 160, 450) # Final analysis values for the overall population.
47+
#' )
48+
#'
49+
#' hypothesis <- list(
50+
#' H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1.
51+
#' H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2.
52+
#' H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population.
53+
#' )
54+
#'
55+
#' generate_event_table_(event, hypothesis, type = "overlap_population")
56+
#'
57+
generate_event_table_ <- function(event, hypothesis, type = c("common_control", "overlap_population")) {
58+
type <- match.arg(type)
59+
60+
result_df <- tibble(
61+
one_hypothesis = integer(),
62+
another_hypothesis = integer(),
63+
analysis = integer(),
64+
common_events = integer()
65+
)
66+
67+
if (type == "common_control") {
68+
result_df <- generate_event_table_cc(event, hypothesis) # see generate_event_cc.R
69+
} else if (type == "overlap_population") {
70+
result_df <- generate_event_table_ol(event, hypothesis) # see generate_event_ol.R
71+
}
72+
return(result_df)
73+
}

‎tests/testthat/test-developer-generate_event_commoncontrol_addhypo.R‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
test_that("Generate event table returns the expected sorted data", {
2+
expected_data <- tibble(
3+
one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
4+
another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
5+
analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
6+
common_events = c(155, 85, 70, 160, 75, 165, 305, 170, 135, 320, 150, 335)
7+
)
8+
9+
event <- data.frame(
10+
Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
11+
IA = c(70, 75, 80, 85),
12+
FA = c(135, 150, 165, 170)
13+
)
14+
15+
hypothesis <- list(
16+
H1 = "Experimental 1 vs. Control",
17+
H2 = "Experimental 2 vs. Control",
18+
H3 = "Experimental 1 vs. Experimental 2"
19+
)
20+
21+
result_table <- generate_event_table_cc(event, hypothesis)
22+
expect_identical(result_table, expected_data)
23+
})

‎tests/testthat/test-developer-generate_event_population_addhypo.R‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
test_that("Generate event table ol returns the expected sorted data", {
2+
expected_data <- tibble(
3+
one_hypothesis = as.integer(c(1, 1, 1, 2, 2, 3, 1, 1, 1, 2, 2, 3)),
4+
another_hypothesis = as.integer(c(1, 2, 3, 2, 3, 3, 1, 2, 3, 2, 3, 3)),
5+
analysis = as.integer(c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)),
6+
common_events = c(100, 80, 100, 110, 110, 225, 200, 160, 200, 220, 220, 450)
7+
)
8+
9+
event <- data.frame(
10+
Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
11+
IA = c(100, 110, 80, 225),
12+
FA = c(200, 220, 160, 450)
13+
)
14+
15+
hypothesis <- list(
16+
H1 = "Efficacy in Population 1",
17+
H2 = "Efficacy in Population 2",
18+
H3 = "Efficacy in Overall population"
19+
)
20+
21+
result_table <- generate_event_table_ol(event, hypothesis)
22+
expect_identical(result_table, expected_data)
23+
})

0 commit comments

Comments
 (0)