diff --git a/DESCRIPTION b/DESCRIPTION index 569114a7..43e6e35a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gsDesign2 Title: Group Sequential Design with Non-Constant Effect -Version: 1.1.2.13 +Version: 1.1.2.14 Authors@R: c( person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")), person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")), diff --git a/R/summary.R b/R/summary.R index 5c9971c3..55b24938 100644 --- a/R/summary.R +++ b/R/summary.R @@ -152,6 +152,9 @@ summary.fixed_design <- function(object, ...) { #' variables you want to be displayed differently than the defaults. #' @param col_vars The variables to be displayed. #' @param col_decimals The decimals to be displayed for the displayed variables in `col_vars`. +#' If the vector is unnamed, it must match the length of `col_vars`. If the +#' vector is named, you only have to specify the number of digits for the +#' columns you want to be displayed differently than the defaults. #' @param bound_names Names for bounds; default is `c("Efficacy", "Futility")`. #' #' @importFrom dplyr all_of @@ -240,6 +243,16 @@ summary.fixed_design <- function(object, ...) { #' #' # Customize the variables to be summarized for each analysis #' x_ahr %>% summary(analysis_vars = c("n", "event"), analysis_decimals = c(1, 1)) +#' +#' # Customize the digits for the columns +#' x_ahr %>% summary(col_decimals = c(z = 4)) +#' +#' # Customize the columns to display +#' x_ahr %>% summary(col_vars = c("z", "~hr at bound", "nominal p")) +#' +#' # Customize columns and digits +#' x_ahr %>% summary(col_vars = c("z", "~hr at bound", "nominal p"), +#' col_decimals = c(4, 2, 2)) #' } #' #' # Example 2 ---- @@ -315,60 +328,81 @@ summary.gs_design <- function(object, # Prepare the columns decimals ---- if (method == "ahr") { - if (is.null(col_vars) && is.null(col_decimals)) { - x_decimals <- tibble::tibble( - col_vars = c("analysis", "bound", "z", "~hr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"), - col_decimals = c(NA, NA, 2, 4, 4, 4, 4) - ) - } else { - x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) - } - } - - if (method == "wlr") { - if (is.null(col_vars) && is.null(col_decimals)) { - x_decimals <- tibble::tibble( - col_vars = c("analysis", "bound", "z", "~whr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"), - col_decimals = c(NA, NA, 2, 4, 4, 4, 4) - ) - } else { - x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) - } + col_vars_default <- c( + "analysis", "bound", "z", "~hr at bound", "nominal p", + "Alternate hypothesis", "Null hypothesis" + ) + col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) + } else if (method == "wlr") { + col_vars_default <- c( + "analysis", "bound", "z", "~whr at bound", "nominal p", + "Alternate hypothesis", "Null hypothesis" + ) + col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) + } else if (method == "combo") { + col_vars_default <- c( + "analysis", "bound", "z", "nominal p", + "Alternate hypothesis", "Null hypothesis" + ) + col_decimals_default <- c(NA, NA, 2, 4, 4, 4) + } else if (method == "rd") { + col_vars_default <- c( + "analysis", "bound", "z", "~risk difference at bound", + "nominal p", "Alternate hypothesis", "Null hypothesis" + ) + col_decimals_default <- c(NA, NA, 2, 4, 4, 4, 4) + } else { + stop("Invalid method: ", method) } - if (method == "combo") { - if (is.null(col_vars) && is.null(col_decimals)) { - x_decimals <- tibble::tibble( - col_vars = c("analysis", "bound", "z", "nominal p", "Alternate hypothesis", "Null hypothesis"), - col_decimals = c(NA, NA, 2, 4, 4, 4) - ) - } else { - x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + # Filter columns and update decimal places + names(col_decimals_default) <- col_vars_default + if (is.null(col_vars) && is.null(col_decimals)) { + # Use default values + col_vars <- col_vars_default + col_decimals <- col_decimals_default + } else if (!is.null(col_vars) && is.null(col_decimals)) { + # Only drop/rearrange variables + col_decimals <- col_decimals_default[ + match(col_vars, names(col_decimals_default)) + ] + } else if (is.null(col_vars) && !is.null(col_decimals)) { + # Only update decimals - must be named vector + if (is.null(names(col_decimals))) { + stop("summary: col_decimals must be a named vector if col_vars is not provided") } - } - - if (method == "rd") { - if (is.null(col_vars) && is.null(col_decimals)) { - x_decimals <- tibble::tibble( - col_vars = c( - "analysis", "bound", "z", "~risk difference at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ), - col_decimals = c(NA, NA, 2, 4, 4, 4, 4) - ) + col_vars <- col_vars_default + col_decimals_tmp <- col_decimals_default + col_decimals_tmp[names(col_decimals)] <- col_decimals + col_decimals <- col_decimals_tmp + } else if (!is.null(col_vars) && !is.null(col_decimals)) { + # Update variables and decimals + if (is.null(names(col_decimals))) { + # vectors must be same length if col_decimals is unnamed + if (length(col_vars) != length(col_decimals)) { + stop("summary: please input col_vars and col_decimals in pairs!") + } } else { - x_decimals <- tibble::tibble(col_vars = col_vars, col_decimals = col_decimals) + col_decimals_tmp <- col_decimals_default + col_decimals_tmp[names(col_decimals)] <- col_decimals + col_decimals <- col_decimals_tmp + col_decimals <- col_decimals[ + match(col_vars, names(col_decimals)) + ] } } # "bound" is a required column - if (!"bound" %in% x_decimals$col_vars) { - x_decimals <- rbind( - tibble::tibble(col_vars = "bound", col_decimals = NA), - x_decimals - ) + if (!"bound" %in% col_vars) { + col_vars <- c("bound", col_vars) + col_decimals <- c(NA, col_decimals) } + x_decimals <- tibble::tibble( + col_vars = col_vars, + col_decimals = col_decimals + ) + # Prepare the analysis summary row ---- # get the # (1) analysis variables to be displayed on the header diff --git a/man/summary.Rd b/man/summary.Rd index 0322b93d..5e814a0e 100644 --- a/man/summary.Rd +++ b/man/summary.Rd @@ -31,7 +31,10 @@ variables you want to be displayed differently than the defaults.} \item{col_vars}{The variables to be displayed.} -\item{col_decimals}{The decimals to be displayed for the displayed variables in \code{col_vars}.} +\item{col_decimals}{The decimals to be displayed for the displayed variables in \code{col_vars}. +If the vector is unnamed, it must match the length of \code{col_vars}. If the +vector is named, you only have to specify the number of digits for the +columns you want to be displayed differently than the defaults.} \item{bound_names}{Names for bounds; default is \code{c("Efficacy", "Futility")}.} } @@ -172,6 +175,16 @@ x_ahr \%>\% summary(bound_names = c("A is better", "B is better")) # Customize the variables to be summarized for each analysis x_ahr \%>\% summary(analysis_vars = c("n", "event"), analysis_decimals = c(1, 1)) + +# Customize the digits for the columns +x_ahr \%>\% summary(col_decimals = c(z = 4)) + +# Customize the columns to display +x_ahr \%>\% summary(col_vars = c("z", "~hr at bound", "nominal p")) + +# Customize columns and digits +x_ahr \%>\% summary(col_vars = c("z", "~hr at bound", "nominal p"), + col_decimals = c(4, 2, 2)) } # Example 2 ---- diff --git a/tests/testthat/test-developer-summary.R b/tests/testthat/test-developer-summary.R index fc0ace99..5c765ce9 100644 --- a/tests/testthat/test-developer-summary.R +++ b/tests/testthat/test-developer-summary.R @@ -150,7 +150,6 @@ test_that("The column 'Bound' is always included in summary.gs_design() output", expect_true("Bound" %in% colnames(observed)) }) - test_that("The full alpha is correctly carried over", { a_level <- 0.02 x <- gs_power_ahr( @@ -166,4 +165,125 @@ test_that("The full alpha is correctly carried over", { observed <- summary(x) expect_equal(attributes(observed)$full_alpha, a_level) -}) \ No newline at end of file +}) + +# Maintain previous behavior +test_that("summary.gs_design() accepts same-length vectors for col_vars and col_decimals", { + x <- gs_design_ahr() + + # default decimals + x_sum <- summary(x) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame( + Z = 1.96, + `~HR at bound` = 0.795, + `Nominal p` = 0.025, + `Alternate hypothesis` = 0.9, + `Null hypothesis` = 0.025, + check.names = FALSE + ) + expect_equal(observed, expected) + + # specify the decimals for each variable + x_sum <- summary( + x, + col_vars = c("z", "~hr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"), + col_decimals = c(0, 0, 0, 0, 0) + ) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame( + Z = 2, + `~HR at bound` = 1, + `Nominal p` = 0, + `Alternate hypothesis` = 1, + `Null hypothesis` = 0, + check.names = FALSE + ) + expect_equal(observed, expected) + + # Drop variables and also specify the decimals + x_sum <- summary( + x, + col_vars = c("nominal p", "Null hypothesis"), + col_decimals = c(0, 0) + ) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame(`Nominal p` = 0, `Null hypothesis` = 0, check.names = FALSE) + expect_equal(observed, expected) + + # Rearrange variables + x_sum <- summary( + x, + col_vars = c("Null hypothesis", "Alternate hypothesis", "nominal p", "~hr at bound", "z"), + col_decimals = c(0, 0, 0, 0, 0) + ) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame( + `Null hypothesis` = 0, + `Alternate hypothesis` = 1, + `Nominal p` = 0, + `~HR at bound` = 1, + Z = 2, + check.names = FALSE + ) + expect_equal(observed, expected) + + # Throw error if unnamed col_decimals does not match length of col_vars + expect_error( + summary( + x, + col_vars = c("Null hypothesis", "Alternate hypothesis", "nominal p"), + col_decimals = c(0, 0), + ), + "summary: please input col_vars and col_decimals in pairs!" + ) +}) + +test_that("summary.gs_design() accepts a named vector for col_decimals", { + x <- gs_design_ahr() + + # Specify decimals + x_sum <- summary(x, col_decimals = c(z = 0, `nominal p` = 0)) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame( + Z = 2, + `~HR at bound` = 0.795, + `Nominal p` = 0, + `Alternate hypothesis` = 0.9, + `Null hypothesis` = 0.025, + check.names = FALSE + ) + expect_equal(observed, expected) + + # Specify decimals and also drop some variables + x_sum <- summary( + x, + col_vars = c("z", "nominal p", "Null hypothesis"), + col_decimals = c(z = 0, `nominal p` = 0) + ) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame(Z = 2, `Nominal p` = 0, `Null hypothesis` = 0.025, check.names = FALSE) + expect_equal(observed, expected) + + # Specify decimals and rearrange some variables + x_sum <- summary( + x, + col_vars = c("Null hypothesis", "nominal p", "z"), + col_decimals = c(z = 0, `nominal p` = 0) + ) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame(`Null hypothesis` = 0.025, `Nominal p` = 0, Z = 2, check.names = FALSE) + expect_equal(observed, expected) + + # Only drop variables + x_sum <- summary(x, col_vars = c("z", "nominal p", "Null hypothesis")) + observed <- as.data.frame(x_sum)[, -1:-2] + expected <- data.frame(Z = 1.96, `Nominal p` = 0.025, `Null hypothesis` = 0.025, check.names = FALSE) + expect_equal(observed, expected) + + # Throw error is col_decimals is unnamed + expect_error( + summary(x, col_decimals = c(4, 4)), + "summary: col_decimals must be a named vector if col_vars is not provided" + ) +}) diff --git a/vignettes/articles/story-update-boundary.Rmd b/vignettes/articles/story-update-boundary.Rmd index 2a926f87..656ea529 100644 --- a/vignettes/articles/story-update-boundary.Rmd +++ b/vignettes/articles/story-update-boundary.Rmd @@ -131,13 +131,7 @@ gs_update_ahr( x = x, alpha = 0.025 ) |> - summary( - col_vars = c( - "analysis", "bound", "z", "~hr at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ), - col_decimals = c(NA, NA, 4, 4, 4, 4, 4) - ) |> + summary(col_decimals = c(z = 4)) |> as_gt(title = "Updated design", subtitle = "For alternate alpha = 0.025") ``` @@ -184,13 +178,7 @@ gs_update_ahr( ustime = ustime, observed_data = list(observed_data_ia, observed_data_fa) ) |> - summary( - col_vars = c( - "analysis", "bound", "z", "~hr at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ), - col_decimals = c(NA, NA, 4, 4, 4, 4, 4) - ) |> + summary(col_decimals = c(z = 4)) |> as_gt(title = "Updated design", subtitle = paste0("With observed ", sum(observed_data_ia$event), " events at IA and ", sum(observed_data_fa$event), @@ -267,13 +255,7 @@ gs_update_ahr( x = x, alpha = 0.025 ) |> - summary( - col_vars = c( - "analysis", "bound", "z", "~hr at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ), - col_decimals = c(NA, NA, 4, 4, 4, 4, 4) - ) |> + summary(col_decimals = c(z = 4)) |> as_gt(title = "Updated design", subtitle = "For alpha = 0.025") ``` @@ -294,13 +276,7 @@ gs_update_ahr( lstime = ustime, observed_data = list(observed_data_ia, observed_data_fa) ) |> - summary( - col_vars = c( - "analysis", "bound", "z", "~hr at bound", - "nominal p", "Alternate hypothesis", "Null hypothesis" - ), - col_decimals = c(NA, NA, 4, 4, 4, 4, 4) - ) |> + summary(col_decimals = c(z = 4)) |> as_gt(title = "Updated design", subtitle = paste0("With observed ", sum(observed_data_ia$event), " events at IA and ", sum(observed_data_fa$event),