Merge pull request #45 from Merck/Event_Table

Event table update

Author: LittleBeannie

R/generate_event_cc.R

@@ -0,0 +1,80 @@
+#' This function generates a table of events for given experimental arms and a control group based on specified hypotheses.
+#'
+#' @param event A dataframe containing the following columns:
+#'   - `Population`: A character vector listing the population groups (e.g., experimental arms and control).
+#'   - `IA`: A numeric vector indicating the number of events observed in each group during interim analysis.
+#'   - `FA`: A numeric vector indicating the number of events observed in each group during final analysis.
+#'   The dataframe must contain at least these columns and can include additional analysis columns as needed.
+#' @param hypothesis A list containing hypotheses specifying comparisons between experimental arms and the control group,
+#'                   as well as comparisons among experimental arms.
+#'
+#' @return A dataframe with columns:
+#'   - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
+#'   - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
+#'   - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
+#'   - `common_events`: The calculated number of common events associated with the selected hypotheses.
+#'
+#' @examples
+#' #------------------------Example of IA and FA
+#' event <- data.frame(
+#'   Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
+#'   IA = c(70, 75, 80, 85), # Interim Analysis values indicating the number of events observed in each group
+#'   FA = c(135, 150, 165, 170)
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Experimental 1 vs. Control",
+#'   H2 = "Experimental 2 vs. Control",
+#'   H3 = "Experimental 1 vs. Experimental 2"
+#' )
+#'
+#' generate_event_table_cc(event, hypothesis)
+#'
+#' #----------------------Example of two IAs and FA
+#' event <- data.frame(
+#'   Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
+#'   IA1 = c(70, 75, 80, 85), # First Interim Analysis values indicating the number of events observed in each group
+#'   IA2 = c(90, 95, 100, 105), # Second Interim Analysis values indicating the number of events observed in each group
+#'   FA = c(135, 150, 165, 170)
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Experimental 1 vs. Control",
+#'   H2 = "Experimental 2 vs. Control",
+#'   H3 = "Experimental 1 vs. Experimental 2"
+#' )
+#'
+#' generate_event_table_cc(event, hypothesis)
+generate_event_table_cc <- function(event, hypothesis) {
+  result_df <- tibble(
+    one_hypothesis = integer(),
+    another_hypothesis = integer(),
+    analysis = integer(),
+    common_events = integer()
+  )
+
+  # Iterate through the input data to calculate the events
+  for (i in 1:length(hypothesis)) { # number of hypothesis
+    for (j in i:length(hypothesis)) {
+      for (k in 1:(ncol(event) - 1)) { # Iterate through the analyses
+        if (i != j) {
+          hyp_i <- unlist(strsplit(hypothesis[[i]], " vs. "))
+          hyp_j <- unlist(strsplit(hypothesis[[j]], " vs. "))
+          common_factor <- intersect(hyp_i, hyp_j)
+          eventn <- event[event$Population == common_factor, k + 1]
+        } else {
+          eventn <- event[i, k + 1] + event[event$Population == "Control", k + 1]
+        }
+
+        result_df <- rbind(result_df, tibble(
+          one_hypothesis = i,
+          another_hypothesis = j,
+          analysis = k,
+          common_events = eventn
+        ))
+        result_df <- result_df[order(result_df$analysis), ]
+      }
+    }
+  }
+  return(result_df)
+}

R/generate_event_ol.R

@@ -0,0 +1,94 @@
+#' This function generates a table of events for specified populations based on the provided hypotheses.
+#'
+#' @param event` dataframe should have the following structure:
+#'   - `Population`: A character vector indicating the population groups (e.g., "Population 1", "Population 2", "Population 1 Intersection 2", and "Overall population").
+#'   - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis.
+#'   - `FA`: Numeric vector indicating the number of events observed in each group during final analysis.
+#'   The dataframe must contain at least these columns and can include additional analysis columns as needed.
+#' @param hypothesis A list of strings where each item represents a hypothesis regarding efficacy, formatted as follows:
+#'                   - H1: "Efficacy in Population 1"
+#'                   - H2: "Efficacy in Population 2"
+#'                   - H3: "Efficacy in Overall population"
+#'                   Each hypothesis is used for comparisons in the generated event table.
+#'
+#' @return A dataframe with the following columns:
+#'   - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
+#'   - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
+#'   - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
+#'   - `common_events`: The calculated number of common events associated with the selected hypotheses.
+#'
+#' @export
+#'
+#' @examples
+#' #------------------------Example of IA and FA
+#' event <- data.frame(
+#'   Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
+#'   IA = c(100, 110, 80, 225), # Interim Analysis values indicating the number of events observed in each group
+#'   FA = c(200, 220, 160, 450)
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Efficacy in Population 1",
+#'   H2 = "Efficacy in Population 2",
+#'   H3 = "Efficacy in Overall population"
+#' )
+#'
+#' generate_event_table_ol(event, hypothesis)
+#'
+#' #----------------------Example of two IAs and FA
+#' event <- data.frame(
+#'   Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
+#'   IA1 = c(100, 110, 80, 225), # First Interim Analysis values indicating the number of events observed in each group
+#'   IA2 = c(120, 130, 90, 240), # Second Interim Analysis values indicating the number of events observed in each group
+#'   FA = c(200, 220, 160, 450)
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Efficacy in Population 1",
+#'   H2 = "Efficacy in Population 2",
+#'   H3 = "Efficacy in Overall population"
+#' )
+#'
+#' generate_event_table_ol(event, hypothesis)
+#'
+generate_event_table_ol <- function(event, hypothesis) {
+  result_df <- tibble(
+    one_hypothesis = integer(),
+    another_hypothesis = integer(),
+    analysis = integer(),
+    common_events = integer()
+  )
+
+  for (i in 1:length(hypothesis)) {
+    for (j in i:length(hypothesis)) {
+      for (k in 1:(ncol(event) - 1)) {
+        hyp_i <- unlist(strsplit(hypothesis[[i]], "Efficacy in "))[2]
+        hyp_j <- unlist(strsplit(hypothesis[[j]], "Efficacy in "))[2]
+
+        common_factor <- intersect(hyp_i, hyp_j)
+
+        if (length(common_factor) > 0) {
+          if ("Overall population" %in% c(hyp_i, hyp_j)) {
+            eventn <- event[event$Population == "Overall population", k + 1]
+          } else {
+            eventn <- event[i, k + 1]
+          }
+        } else if ("Overall population" %in% c(hyp_i, hyp_j)) {
+          eventn <- event[i, k + 1]
+        } else {
+          eventn <- event[event$Population == "Population 1 Intersection 2", k + 1]
+        }
+
+        result_df <- rbind(result_df, tibble(
+          one_hypothesis = i,
+          another_hypothesis = j,
+          analysis = k,
+          common_events = eventn
+        ))
+        result_df <- result_df[order(result_df$analysis), ]
+      }
+    }
+  }
+
+  return(result_df)
+}

R/generate_event_table_.R

@@ -0,0 +1,73 @@
+#' This function creates a table summarizing event counts based on specified hypotheses and user input data.
+#' It can handle two types of analysis: one comparing experimental groups to a common control and another analyzing the overlap of populations.
+#'
+#' @param event` dataframe should have the following structure:
+#'   - `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.
+#'   - `IA`: Numeric vector indicating the number of events observed in each group during interim analysis.
+#'   - `FA`: Numeric vector indicating the number of events observed in each group during final analysis.
+#'   The dataframe must contain at least these columns and can include additional analysis columns as needed.
+#' @param hypothesis A list containing hypotheses that specify the comparisons to be made between the groups:
+#'                   - For example:
+#'                     - "Experimental 1 vs. Control"
+#'                     - "Efficacy in Population 1"
+#'
+#' @param type A character string specifying the type of analysis to conduct. It should be one of the following:
+#'             - `"common_control"`: Analyze the event counts comparing experimental groups to common control.
+#'             - `"overlap_population"`: Analyze the event counts to assess overlap in populations.
+#'
+#' @return A dataframe with four columns:
+#'         - `one_hypothesis`: The index of the first selected hypothesis from the provided list.
+#'         - `another_hypothesis`: The index of the second selected hypothesis from the provided list.
+#'         - `analysis`: The index indicating which analysis is being performed (e.g., interim or final).
+#'         - `common_events`: The calculated number of common events associated with the selected hypotheses.
+#'
+#' @export
+#'
+#' @examples
+#' # ----------------------- Example of common control
+#' event <- data.frame(
+#'   Population = c("Experimental 1", "Experimental 2", "Experimental 3", "Control"),
+#'   IA = c(70, 75, 80, 85), # Interim analysis values indicating the number of events observed in each experimental group.
+#'   FA = c(135, 150, 165, 170) # Final analysis values indicating the cumulative number of events observed in each group.
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Experimental 1 vs. Control", # Hypothesis comparing Experimental 1 with Control.
+#'   H2 = "Experimental 2 vs. Control", # Hypothesis comparing Experimental 2 with Control.
+#'   H3 = "Experimental 1 vs. Experimental 2" # Hypothesis comparing Experimental 1 and Experimental 2.
+#' )
+#'
+#' generate_event_table_(event, hypothesis, type = "common_control")
+#'
+#' # ------------------------ Example of overall population
+#' event <- data.frame(
+#'   Population = c("Population 1", "Population 2", "Population 1 Intersection 2", "Overall population"),
+#'   IA = c(100, 110, 80, 225), # Interim analysis values for the overall population.
+#'   FA = c(200, 220, 160, 450) # Final analysis values for the overall population.
+#' )
+#'
+#' hypothesis <- list(
+#'   H1 = "Efficacy in Population 1", # Hypothesis assessing efficacy in Population 1.
+#'   H2 = "Efficacy in Population 2", # Hypothesis assessing efficacy in Population 2.
+#'   H3 = "Efficacy in Overall population" # Hypothesis assessing efficacy in the overall population.
+#' )
+#'
+#' generate_event_table_(event, hypothesis, type = "overlap_population")
+#'
+generate_event_table_ <- function(event, hypothesis, type = c("common_control", "overlap_population")) {
+  type <- match.arg(type)
+
+  result_df <- tibble(
+    one_hypothesis = integer(),
+    another_hypothesis = integer(),
+    analysis = integer(),
+    common_events = integer()
+  )
+
+  if (type == "common_control") {
+    result_df <- generate_event_table_cc(event, hypothesis) # see generate_event_cc.R
+  } else if (type == "overlap_population") {
+    result_df <- generate_event_table_ol(event, hypothesis) # see generate_event_ol.R
+  }
+  return(result_df)
+}

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)
+})

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)
+})