From f39a49d298a86f1a2cb3ae7f1d5d5017080fa67b Mon Sep 17 00:00:00 2001 From: keaven Date: Fri, 29 Aug 2025 17:19:35 -0400 Subject: [PATCH 01/18] Initial S7 class EventTable added using Sonnet 4 --- DESCRIPTION | 7 +- EventTable_README.md | 128 +++++++ NAMESPACE | 7 + R/generate_event_ol.R | 2 +- R/generate_event_table_.R | 6 +- R/s7_classes.R | 335 ++++++++++++++++++ examples/event_table_integration.R | 71 ++++ examples/test_event_table.R | 50 +++ examples/validation_demo.R | 70 ++++ .../compute_correlations_prompts.txt | 76 ++++ inst/aiprompts/s7 prompts.md | 101 ++++++ tests/testthat/test-s7-event-table.R | 227 ++++++++++++ wpgsd.Rcheck/wpgsd-Ex.R | 298 ++++++++++++++++ wpgsd.Rproj | 1 + 14 files changed, 1372 insertions(+), 7 deletions(-) create mode 100644 EventTable_README.md create mode 100644 R/s7_classes.R create mode 100644 examples/event_table_integration.R create mode 100644 examples/test_event_table.R create mode 100644 examples/validation_demo.R create mode 100644 inst/aiprompts/compute_correlations_prompts.txt create mode 100644 inst/aiprompts/s7 prompts.md create mode 100644 tests/testthat/test-s7-event-table.R create mode 100644 wpgsd.Rcheck/wpgsd-Ex.R diff --git a/DESCRIPTION b/DESCRIPTION index 79f6b09..2bc29c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: wpgsd Title: Weighted Parametric Group Sequential Design -Version: 0.1.0 +Version: 0.2.0 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = "aut"), person("Zifang", "Guo", email = "zifang.guo@merck.com", role = "aut"), @@ -24,7 +24,8 @@ URL: https://merck.github.io/wpgsd/, https://github.com/Merck/wpgsd BugReports: https://github.com/Merck/wpgsd/issues Encoding: UTF-8 Depends: - R (>= 3.6) + R (>= 3.6), + S7 Imports: dplyr, gMCPLite, @@ -48,4 +49,4 @@ VignetteBuilder: knitr Config/testthat/edition: 3 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 diff --git a/EventTable_README.md b/EventTable_README.md new file mode 100644 index 0000000..1552056 --- /dev/null +++ b/EventTable_README.md @@ -0,0 +1,128 @@ +# EventTable S7 Class Implementation + +## Overview + +The `EventTable` S7 class provides a type-safe, validated data structure for representing event count data used in the wpgsd package. This is the first step in converting the wpgsd package to use S7 classes throughout. + +## Features + +### Core Properties +- **data**: A tibble containing the event count data with required columns `H1`, `H2`, `Analysis`, `Event` +- **n_hypotheses**: Automatically calculated number of hypotheses +- **n_analyses**: Automatically calculated number of analyses + +### Validation +- Validates presence of required columns (`H1`, `H2`, `Analysis`, `Event`) +- Ensures proper data types (all numeric) +- Validates logical constraints: + - Hypothesis indices must be positive integers + - Analysis numbers must be positive integers + - Event counts must be non-negative +- Enforces mathematical consistency requirements: + - For a fixed H1, H2 pair, Event counts must be non-decreasing as Analysis increases + - For off-diagonal entries (H1 ≠ H2), diagonal entries must exist with Event ≥ off-diagonal Event for the same Analysis + - These constraints ensure proper mathematical properties for correlation matrix calculations + +### Methods +- **print()**: Clean formatted output showing key information +- **summary()**: Detailed summary including event count statistics +- **subset_event_table()**: Subset by analysis or hypotheses +- **as_event_table()**: Convert tibble to EventTable +- **validate_event_table_data()**: Validate data format before processing + +## Usage Examples + +### Basic Usage +```r +library(wpgsd) + +# Create 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 object +event_table <- EventTable(data = event_data) +print(event_table) +``` + +### Data Validation +```r +# The constructor automatically validates data +tryCatch({ + invalid_data <- tibble::tibble( + H1 = c(1, -2), # Invalid: negative hypothesis index + H2 = c(1, 2), + Analysis = c(1, 1), + Event = c(100, 200) + ) + EventTable(data = invalid_data) +}, error = function(e) { + cat("Validation error:", e$message) +}) +``` + +### Subsetting +```r +# Subset by analysis +analysis_1 <- subset_event_table(event_table, analysis = 1) + +# Subset by hypotheses +h1_h2 <- subset_event_table(event_table, hypotheses = c(1, 2)) +``` + +### Integration with Existing Functions +```r +# Use with existing wpgsd functions +correlation_matrix <- generate_corr(event_table@data) +``` + +## Files Created + +- `R/s7_classes.R`: Main S7 class definition +- `tests/testthat/test-s7-event-table.R`: Comprehensive unit tests +- `examples/test_event_table.R`: Basic usage examples +- `examples/event_table_integration.R`: Integration with existing functions + +## Dependencies + +- Added `S7` to package imports in `DESCRIPTION` +- Uses existing dependencies: `tibble`, `dplyr` + +## Benefits + +1. **Type Safety**: Prevents invalid data from being passed to wpgsd functions +2. **Validation**: Automatic validation of data format and constraints +3. **Documentation**: Self-documenting data structures +4. **Method Dispatch**: Extensible with specialized methods +5. **User Experience**: Clear error messages and helpful summaries + +## Next Steps + +This EventTable implementation provides the foundation for converting the wpgsd package to S7 classes. Future steps include: + +1. Create `CorrelationMatrix` S7 class for `generate_corr()` output +2. Create `Bounds` S7 class for `generate_bounds()` output +3. Update existing functions to accept/return S7 objects +4. Maintain backward compatibility with existing tibble/data.frame inputs + +## Testing + +Run the comprehensive test suite: +```r +testthat::test_file("tests/testthat/test-s7-event-table.R") +``` + +The tests cover: +- Object creation with valid data +- Validation of required columns +- Data type and value validation +- Print and summary methods +- Subsetting functionality +- Data conversion utilities diff --git a/NAMESPACE b/NAMESPACE index d451590..93d1697 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(":=") export(.data) +export(as_event_table) export(as_label) export(as_name) export(calc_seq_p) @@ -13,6 +14,12 @@ export(find_xi) export(generate_bounds) export(generate_corr) export(generate_event_table) +export(generate_event_table_) +export(generate_event_table_ol) +export(new_event_table) +export(subset_event_table) +export(validate_event_table_data) +import(S7) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,bind_rows) diff --git a/R/generate_event_ol.R b/R/generate_event_ol.R index dd39253..cf60af2 100644 --- a/R/generate_event_ol.R +++ b/R/generate_event_ol.R @@ -1,6 +1,6 @@ #' This function generates a table of events for specified populations based on the provided hypotheses. #' -#' @param event` dataframe should have the following structure: +#' @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. diff --git a/R/generate_event_table_.R b/R/generate_event_table_.R index 68b99a8..99fb94d 100644 --- a/R/generate_event_table_.R +++ b/R/generate_event_table_.R @@ -1,7 +1,7 @@ -#' 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. +#' 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: +#' @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. diff --git a/R/s7_classes.R b/R/s7_classes.R new file mode 100644 index 0000000..b413a2d --- /dev/null +++ b/R/s7_classes.R @@ -0,0 +1,335 @@ +# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. +# All rights reserved. +# +# This file is part of the wpgsd program. +# +# wpgsd is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# S7 Classes for wpgsd Package +# +# This file contains S7 class definitions for the wpgsd package. +# These classes provide type safety and method dispatch for the main +# data structures used in weighted parametric group sequential designs. + +#' @import S7 + +# Define the EventTable S7 class +EventTable <- S7::new_class( + "EventTable", + properties = list( + data = S7::class_data.frame, + n_hypotheses = S7::class_integer, + n_analyses = S7::class_integer + ), + constructor = function(data = tibble::tibble()) { + # Validate required columns + required_cols <- c("H1", "H2", "Analysis", "Event") + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("EventTable requires columns: ", paste(missing_cols, collapse = ", ")) + } + + # Calculate derived properties + n_hypotheses <- max(c(data$H1, data$H2), na.rm = TRUE) + n_analyses <- max(data$Analysis, na.rm = TRUE) + + S7::new_object( + EventTable, + data = data, + n_hypotheses = as.integer(n_hypotheses), + n_analyses = as.integer(n_analyses) + ) + }, + validator = function(self) { + # Validate data types + if (!is.numeric(self@data$H1) || !is.numeric(self@data$H2)) { + "@data$H1 and @data$H2 must be numeric" + } else if (!is.numeric(self@data$Analysis)) { + "@data$Analysis must be numeric" + } else if (!is.numeric(self@data$Event)) { + "@data$Event must be numeric" + } else if (any(self@data$H1 <= 0, na.rm = TRUE) || any(self@data$H2 <= 0, na.rm = TRUE)) { + "Hypothesis indices (H1, H2) must be positive integers" + } else if (any(self@data$Analysis <= 0, na.rm = TRUE)) { + "Analysis numbers must be positive integers" + } else if (any(self@data$Event < 0, na.rm = TRUE)) { + "Event counts must be non-negative" + } else { + # Additional validation requirements + data <- self@data + + # Requirement 1: For fixed H1, H2, Event must be non-decreasing as Analysis increases + for (h1 in unique(data$H1)) { + for (h2 in unique(data$H2)) { + subset_data <- data[data$H1 == h1 & data$H2 == h2, ] + if (nrow(subset_data) > 1) { + subset_data <- subset_data[order(subset_data$Analysis), ] + if (any(diff(subset_data$Event) < 0)) { + return(paste0("For H1=", h1, ", H2=", h2, ", Event counts must be non-decreasing across analyses")) + } + } + } + } + + # Requirement 2: For off-diagonal entries, diagonal entries must exist with >= Event counts + for (i in seq_len(nrow(data))) { + h1 <- data$H1[i] + h2 <- data$H2[i] + analysis <- data$Analysis[i] + event_val <- data$Event[i] + + # Skip if this is already a diagonal entry + if (h1 == h2) next + + # Check that diagonal H1=H1 entry exists with Event >= current Event + h1_diagonal <- data[data$H1 == h1 & data$H2 == h1 & data$Analysis == analysis, ] + if (nrow(h1_diagonal) == 0) { + return(paste0("Missing diagonal entry: H1=", h1, ", H2=", h1, ", Analysis=", analysis)) + } else if (h1_diagonal$Event[1] < event_val) { + return(paste0("Diagonal entry H1=", h1, ", H2=", h1, ", Analysis=", analysis, + " has Event (", h1_diagonal$Event[1], ") < off-diagonal Event (", event_val, ")")) + } + + # Check that diagonal H2=H2 entry exists with Event >= current Event + h2_diagonal <- data[data$H1 == h2 & data$H2 == h2 & data$Analysis == analysis, ] + if (nrow(h2_diagonal) == 0) { + return(paste0("Missing diagonal entry: H1=", h2, ", H2=", h2, ", Analysis=", analysis)) + } else if (h2_diagonal$Event[1] < event_val) { + return(paste0("Diagonal entry H1=", h2, ", H2=", h2, ", Analysis=", analysis, + " has Event (", h2_diagonal$Event[1], ") < off-diagonal Event (", event_val, ")")) + } + } + } + } +) + +# TODO: Add S7 method definitions later +# #' Print method for EventTable +# S7::method(show, EventTable) <- function(object) { ... } +# +# #' Summary method for EventTable +# S7::method(summary, EventTable) <- function(object, ...) { ... } + +#' Subset EventTable by Analysis or Hypotheses +#' +#' @description +#' Extract a subset of an EventTable object based on analysis numbers +#' or hypothesis indices. +#' +#' @param x An EventTable S7 object +#' @param analysis Optional vector of analysis numbers to include +#' @param hypotheses Optional vector of hypothesis indices to include +#' +#' @return A new EventTable object containing only the specified subset +#' +#' @examples +#' library(tibble) +#' +#' # Create sample data +#' event_data <- tibble( +#' H1 = c(1, 2, 3, 1, 2, 3), +#' H2 = c(1, 2, 3, 1, 2, 3), +#' Analysis = c(1, 1, 1, 2, 2, 2), +#' Event = c(155, 160, 165, 305, 320, 335) +#' ) +#' event_table <- EventTable(data = event_data) +#' +#' # Subset by analysis +#' analysis_1 <- subset_event_table(event_table, analysis = 1) +#' +#' # Subset by hypotheses +#' h1_h2_only <- subset_event_table(event_table, hypotheses = c(1, 2)) +#' +#' @export +subset_event_table <- function(x, analysis = NULL, hypotheses = NULL) { + if (!S7::S7_inherits(x, EventTable)) { + stop("x must be an EventTable object") + } + + data_subset <- x@data + + if (!is.null(analysis)) { + data_subset <- data_subset[data_subset$Analysis %in% analysis, ] + } + + if (!is.null(hypotheses)) { + data_subset <- data_subset[ + (data_subset$H1 %in% hypotheses) & (data_subset$H2 %in% hypotheses), + ] + } + + EventTable(data = data_subset) +} + +#' Convert Data to EventTable +#' +#' @description +#' Convert a tibble or data.frame to an EventTable S7 object, or return +#' the object unchanged if it's already an EventTable. +#' +#' @param data A tibble, data.frame, or EventTable object containing the +#' required columns (H1, H2, Analysis, Event) +#' +#' @return An EventTable S7 object +#' +#' @examples +#' library(tibble) +#' +#' # Convert tibble to EventTable +#' event_data <- tibble( +#' H1 = c(1, 2), +#' H2 = c(1, 2), +#' Analysis = c(1, 1), +#' Event = c(100, 200) +#' ) +#' +#' event_table <- as_event_table(event_data) +#' +#' # If already EventTable, returns unchanged +#' same_table <- as_event_table(event_table) +#' identical(event_table, same_table) # TRUE +#' +#' @export +as_event_table <- function(data) { + if (S7::S7_inherits(data, EventTable)) { + return(data) + } + EventTable(data = data) +} + +#' Validate EventTable Data Format +#' +#' @description +#' Validate that a data.frame or tibble has the correct structure and +#' data types required for creating an EventTable object. +#' +#' @param data A data.frame or tibble to validate +#' +#' @return `TRUE` if validation passes (invisible), otherwise stops with +#' descriptive error message +#' +#' @details +#' This function checks that: +#' - Required columns (H1, H2, Analysis, Event) are present +#' - All columns are numeric +#' - Hypothesis indices (H1, H2) are positive +#' - Analysis numbers are positive +#' - Event counts are non-negative +#' +#' @examples +#' library(tibble) +#' +#' # Valid data passes silently +#' valid_data <- tibble( +#' H1 = c(1, 2), +#' H2 = c(1, 2), +#' Analysis = c(1, 1), +#' Event = c(100, 200) +#' ) +#' validate_event_table_data(valid_data) # Returns TRUE +#' +#' # Invalid data throws error +#' \dontrun{ +#' invalid_data <- tibble(H1 = c(1, 2)) # Missing columns +#' validate_event_table_data(invalid_data) # Error +#' } +#' +#' @export +validate_event_table_data <- function(data) { + required_cols <- c("H1", "H2", "Analysis", "Event") + missing_cols <- setdiff(required_cols, names(data)) + + if (length(missing_cols) > 0) { + stop("Missing required columns: ", paste(missing_cols, collapse = ", ")) + } + + if (!is.numeric(data$H1) || !is.numeric(data$H2)) { + stop("H1 and H2 must be numeric") + } + + if (!is.numeric(data$Analysis)) { + stop("Analysis must be numeric") + } + + if (!is.numeric(data$Event)) { + stop("Event must be numeric") + } + + if (any(data$H1 <= 0, na.rm = TRUE) || any(data$H2 <= 0, na.rm = TRUE)) { + stop("Hypothesis indices (H1, H2) must be positive integers") + } + + if (any(data$Analysis <= 0, na.rm = TRUE)) { + stop("Analysis numbers must be positive integers") + } + + if (any(data$Event < 0, na.rm = TRUE)) { + stop("Event counts must be non-negative") + } + + TRUE +} + +#' Create EventTable S7 Object +#' +#' @description +#' Create a type-safe S7 EventTable object that represents event count data +#' structure used in `generate_corr()` and `generate_event_table()`. This class +#' provides validation and computed properties for hypothesis and analysis counts. +#' +#' @param data A tibble or data.frame containing the required columns: +#' - `H1`: First hypothesis index (numeric, positive integers) +#' - `H2`: Second hypothesis index (numeric, positive integers) +#' - `Analysis`: Analysis number (numeric, positive integers) +#' - `Event`: Event count (numeric, non-negative) +#' +#' @details +#' The EventTable class automatically validates the input data and computes: +#' - `n_hypotheses`: Maximum hypothesis index across H1 and H2 columns +#' - `n_analyses`: Maximum analysis number +#' +#' The class ensures data integrity by validating that: +#' - All required columns are present +#' - H1, H2, Analysis, and Event are numeric +#' - Hypothesis indices are positive integers +#' - Analysis numbers are positive integers +#' - Event counts are non-negative +#' +#' @return An EventTable S7 object with validated data and computed properties +#' +#' @examples +#' library(tibble) +#' +#' # Create sample event data +#' event_data <- tibble( +#' H1 = c(1, 2, 1, 1, 2, 1), +#' H2 = c(1, 2, 2, 1, 2, 2), +#' Analysis = c(1, 1, 1, 2, 2, 2), +#' Event = c(155, 160, 85, 305, 320, 170) +#' ) +#' +#' # Create EventTable object +#' event_table <- new_event_table(data = event_data) +#' +#' # Access properties +#' print(event_table@n_hypotheses) # Number of hypotheses +#' print(event_table@n_analyses) # Number of analyses +#' +#' # Use with existing wpgsd functions +#' correlation_matrix <- generate_corr(event_table@data) +#' +#' @export +new_event_table <- function(data = tibble::tibble()) { + EventTable(data = data) +} diff --git a/examples/event_table_integration.R b/examples/event_table_integration.R new file mode 100644 index 0000000..06fb2b6 --- /dev/null +++ b/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/examples/test_event_table.R b/examples/test_event_table.R new file mode 100644 index 0000000..d55ecbf --- /dev/null +++ b/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/examples/validation_demo.R b/examples/validation_demo.R new file mode 100644 index 0000000..79fb517 --- /dev/null +++ b/examples/validation_demo.R @@ -0,0 +1,70 @@ +#!/usr/bin/env Rscript + +# Demo of EventTable S7 class validation requirements +# Run this with: Rscript examples/validation_demo.R + +library(wpgsd) + +cat("=== EventTable S7 Class Validation Demo ===\n\n") + +# Example 1: Valid data that satisfies all requirements +cat("1. Creating valid EventTable:\n") +valid_data <- data.frame( + H1 = c(1, 1, 1, 1, 2, 2, 2, 2), + H2 = c(1, 1, 2, 2, 1, 1, 2, 2), + Analysis = c(1, 2, 1, 2, 1, 2, 1, 2), + Event = c(10, 15, 8, 12, 8, 12, 9, 14) # Non-decreasing and diagonals >= off-diagonals +) + +et <- new_event_table(valid_data) +print(et) +cat("\n") + +# Example 2: Invalid data - events decrease across analyses +cat("2. Attempting to create EventTable with decreasing events:\n") +invalid_data_1 <- data.frame( + H1 = c(1, 1, 1, 1), + H2 = c(1, 1, 2, 2), + Analysis = c(1, 2, 1, 2), + Event = c(10, 8, 5, 7) # H1=1, H2=1 decreases from 10 to 8 +) + +tryCatch({ + new_event_table(invalid_data_1) +}, error = function(e) { + cat("ERROR:", conditionMessage(e), "\n") +}) +cat("\n") + +# Example 3: Invalid data - diagonal elements less than off-diagonal +cat("3. Attempting to create EventTable with invalid diagonal constraint:\n") +invalid_data_2 <- data.frame( + H1 = c(1, 1, 2, 2), + H2 = c(1, 2, 1, 2), + Analysis = c(1, 1, 1, 1), + Event = c(5, 7, 6, 8) # H1=1,H2=1 (5) < H1=1,H2=2 (7) +) + +tryCatch({ + new_event_table(invalid_data_2) +}, error = function(e) { + cat("ERROR:", conditionMessage(e), "\n") +}) +cat("\n") + +# Example 4: Invalid data - missing diagonal entry +cat("4. Attempting to create EventTable with missing diagonal entry:\n") +incomplete_data <- data.frame( + H1 = c(1, 2, 2), + H2 = c(2, 1, 2), + Analysis = c(1, 1, 1), + Event = c(5, 6, 8) +) + +tryCatch({ + new_event_table(incomplete_data) +}, error = function(e) { + cat("ERROR:", conditionMessage(e), "\n") +}) + +cat("\nValidation requirements ensure mathematical consistency for correlation calculations!\n") diff --git a/inst/aiprompts/compute_correlations_prompts.txt b/inst/aiprompts/compute_correlations_prompts.txt new file mode 100644 index 0000000..6c9d599 --- /dev/null +++ b/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/inst/aiprompts/s7 prompts.md b/inst/aiprompts/s7 prompts.md new file mode 100644 index 0000000..69bae54 --- /dev/null +++ b/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/tests/testthat/test-s7-event-table.R b/tests/testthat/test-s7-event-table.R new file mode 100644 index 0000000..29184d7 --- /dev/null +++ b/tests/testthat/test-s7-event-table.R @@ -0,0 +1,227 @@ +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 basic functionality works", { + event_data <- tibble::tribble( + ~H1, ~H2, ~Analysis, ~Event, + 1, 1, 1, 155, + 2, 2, 1, 160 + ) + + event_table <- EventTable(data = event_data) + + # Test that object has correct properties + expect_true(S7::S7_inherits(event_table, EventTable)) + expect_equal(event_table@n_hypotheses, 2L) + expect_equal(event_table@n_analyses, 1L) + expect_equal(nrow(event_table@data), 2) +}) + +# Print method test removed for now as we're using default S7 print +# TODO: Add custom print method test when implemented + +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" + ) +}) + +test_that("EventTable validation - mathematical requirements", { + # Test 1: Event counts must be non-decreasing across analyses for fixed H1,H2 + invalid_data_1 <- data.frame( + H1 = c(1, 1, 1, 1), + H2 = c(1, 1, 2, 2), + Analysis = c(1, 2, 1, 2), + Event = c(10, 8, 5, 7) # H1=1, H2=1 decreases from 10 to 8 + ) + expect_error( + new_event_table(invalid_data_1), + "Event counts must be non-decreasing across analyses" + ) + + # Test 2: Diagonal elements must have Event >= off-diagonal elements + invalid_data_2 <- data.frame( + H1 = c(1, 1, 2, 2), + H2 = c(1, 2, 1, 2), + Analysis = c(1, 1, 1, 1), + Event = c(5, 7, 6, 8) # H1=1,H2=1 (5) < H1=1,H2=2 (7) at Analysis=1 + ) + expect_error( + new_event_table(invalid_data_2), + "Diagonal entry.*has Event.*< off-diagonal Event" + ) + + # Test 3: Valid data satisfying both requirements + valid_data <- data.frame( + H1 = c(1, 1, 1, 1, 2, 2, 2, 2), + H2 = c(1, 1, 2, 2, 1, 1, 2, 2), + Analysis = c(1, 2, 1, 2, 1, 2, 1, 2), + Event = c(10, 15, 8, 12, 8, 12, 9, 14) # Non-decreasing and diagonals >= off-diagonals + ) + et <- new_event_table(valid_data) + expect_true(S7::S7_inherits(et, EventTable)) + expect_equal(et@n_hypotheses, 2) + expect_equal(et@n_analyses, 2) +}) + +test_that("EventTable validation - missing diagonal entries", { + # Missing diagonal H1=1, H2=1 + incomplete_data <- data.frame( + H1 = c(1, 2, 2), + H2 = c(2, 1, 2), + Analysis = c(1, 1, 1), + Event = c(5, 6, 8) + ) + expect_error( + new_event_table(incomplete_data), + "Missing diagonal entry: H1=1, H2=1" + ) +}) 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") + + + +### *