diff --git a/DESCRIPTION b/DESCRIPTION index a8397f3f..08917b70 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gsDesign2 Title: Group Sequential Design with Non-Constant Effect -Version: 1.1.2.7 +Version: 1.1.2.8 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 6eac7f5f..523ed517 100644 --- a/R/summary.R +++ b/R/summary.R @@ -147,6 +147,9 @@ summary.fixed_design <- function(object, ...) { #' #' @param analysis_vars The variables to be put at the summary header of each analysis. #' @param analysis_decimals The displayed number of digits of `analysis_vars`. +#' If the vector is unnamed, it must match the length of `analysis_vars`. If +#' the vector is named, you only have to specify the number of digits for the +#' 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`. #' @param bound_names Names for bounds; default is `c("Efficacy", "Futility")`. @@ -362,23 +365,54 @@ summary.gs_design <- function(object, # get the # (1) analysis variables to be displayed on the header # (2) decimals to be displayed for the analysis variables in (3) + if (method %in% c("ahr", "wlr")) { + analysis_vars_default <- c("time", "n", "event", "ahr", "info_frac") + analysis_decimals_default <- c(1, 1, 1, 2, 2) + } + if (method == "combo") { + analysis_vars_default <- c("time", "n", "event", "ahr", "event_frac") + analysis_decimals_default <- c(1, 1, 1, 2, 2) + } + if (method == "rd") { + analysis_vars_default <- c("n", "rd", "info_frac") + analysis_decimals_default <- c(1, 4, 2) + } + + # Filter analysis variables and update decimal places + names(analysis_decimals_default) <- analysis_vars_default if (is.null(analysis_vars) && is.null(analysis_decimals)) { - if (method %in% c("ahr", "wlr")) { - analysis_vars <- c("time", "n", "event", "ahr", "info_frac") - analysis_decimals <- c(1, 1, 1, 2, 2) - } - if (method == "combo") { - analysis_vars <- c("time", "n", "event", "ahr", "event_frac") - analysis_decimals <- c(1, 1, 1, 2, 2) + # Use default values + analysis_vars <- analysis_vars_default + analysis_decimals <- analysis_decimals_default + } else if (!is.null(analysis_vars) && is.null(analysis_decimals)) { + # Only drop/rearrange variables + analysis_decimals <- analysis_decimals_default[ + match(analysis_vars, names(analysis_decimals_default)) + ] + } else if (is.null(analysis_vars) && !is.null(analysis_decimals)) { + # Only update decimals - must be named vector + if (is.null(names(analysis_decimals))) { + stop("summary: analysis_decimals must be a named vector if analysis_vars is not provided") } - if (method == "rd") { - analysis_vars <- c("n", "rd", "info_frac") - analysis_decimals <- c(1, 4, 2) + analysis_vars <- analysis_vars_default + analysis_decimals_tmp <- analysis_decimals_default + analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals + analysis_decimals <- analysis_decimals_tmp + } else if (!is.null(analysis_vars) && !is.null(analysis_decimals)) { + # Update variables and decimals + if (is.null(names(analysis_decimals))) { + # vectors must be same length if analysis_decimals is unnamed + if (length(analysis_vars) != length(analysis_decimals)) { + stop("summary: please input analysis_vars and analysis_decimals in pairs!") + } + } else { + analysis_decimals_tmp <- analysis_decimals_default + analysis_decimals_tmp[names(analysis_decimals)] <- analysis_decimals + analysis_decimals <- analysis_decimals_tmp + analysis_decimals <- analysis_decimals[ + match(analysis_vars, names(analysis_decimals)) + ] } - } else if (is.null(analysis_vars) && !is.null(analysis_decimals)) { - stop("summary: please input analysis_vars and analysis_decimals in pairs!") - } else if (!is.null(analysis_vars) && is.null(analysis_decimals)) { - stop("summary: please input analysis_vars and analysis_decimals in pairs!") } # set the analysis summary header diff --git a/man/summary.Rd b/man/summary.Rd index 8fe360b6..0322b93d 100644 --- a/man/summary.Rd +++ b/man/summary.Rd @@ -24,7 +24,10 @@ \item{analysis_vars}{The variables to be put at the summary header of each analysis.} -\item{analysis_decimals}{The displayed number of digits of \code{analysis_vars}.} +\item{analysis_decimals}{The displayed number of digits of \code{analysis_vars}. +If the vector is unnamed, it must match the length of \code{analysis_vars}. If +the vector is named, you only have to specify the number of digits for the +variables you want to be displayed differently than the defaults.} \item{col_vars}{The variables to be displayed.} diff --git a/tests/testthat/helper-developer-summary.R b/tests/testthat/helper-developer-summary.R new file mode 100644 index 00000000..de7e06bc --- /dev/null +++ b/tests/testthat/helper-developer-summary.R @@ -0,0 +1,3 @@ +# Helper functions used by test-developer-summary.R + +extract_summary_analysis <- function(x) x[["Analysis"]][1] diff --git a/tests/testthat/test-developer-summary.R b/tests/testthat/test-developer-summary.R new file mode 100644 index 00000000..59fe6a4e --- /dev/null +++ b/tests/testthat/test-developer-summary.R @@ -0,0 +1,123 @@ +# See helper functions in helper-developer-summary.R + +# Maintain previous behavior +test_that("summary.gs_design() accepts same-length vectors for analysis_vars and analysis_decimals", { + x <- gs_design_ahr(analysis_time = c(12, 24)) + + # default decimals + observed <- x |> + summary() |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Time: 12 N: 707.3 Event: 160.4 AHR: 0.81 Information fraction: 0.42" + ) + + # specify the decimals for each variable + observed <- x |> + summary( + analysis_vars = c("time", "n", "event", "ahr", "info_frac"), + analysis_decimals = c(2, 0, 0, 4, 4) + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Time: 12 N: 707 Event: 160 AHR: 0.8108 Information fraction: 0.4191" + ) + + # Drop variables and also specify the decimals + observed <- x |> + summary( + analysis_vars = c("ahr", "info_frac"), + analysis_decimals = c(4, 4) + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 AHR: 0.8108 Information fraction: 0.4191" + ) + + # Rearrange variables + observed <- x |> + summary( + analysis_vars = c("info_frac", "ahr", "event", "n", "time"), + analysis_decimals = c(4, 4, 0, 0, 2) + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Information fraction: 0.4191 AHR: 0.8108 Event: 160 N: 707 Time: 12" + ) + + # Throw error if unnamed analysis_decimals does not match length of analysis_vars + expect_error( + summary( + x, + analysis_vars = c("info_frac", "ahr", "event", "n", "time"), + analysis_decimals = c(4, 4), + ), + "summary: please input analysis_vars and analysis_decimals in pairs!" + ) +}) + +test_that("summary.gs_design() accepts a named vector for analysis_decimals", { + x <- gs_design_ahr(analysis_time = c(12, 24)) + + # Specify decimals + observed <- x |> + summary(analysis_decimals = c(ahr = 4, info_frac = 4)) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Time: 12 N: 707.3 Event: 160.4 AHR: 0.8108 Information fraction: 0.4191" + ) + + # Specify decimals and also drop some variables + observed <- x |> + summary( + analysis_vars = c("event", "ahr", "info_frac"), + analysis_decimals = c(ahr = 4, info_frac = 4) + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Event: 160.4 AHR: 0.8108 Information fraction: 0.4191" + ) + + # Specify decimals and rearrange some variables + observed <- x |> + summary( + analysis_vars = c("info_frac", "ahr", "event"), + analysis_decimals = c(ahr = 4, info_frac = 4) + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Information fraction: 0.4191 AHR: 0.8108 Event: 160.4" + ) + + # Only drop variables + observed <- x |> + summary( + analysis_vars = c("info_frac", "ahr", "event") + ) |> + attr("groups") |> + extract_summary_analysis() + expect_identical( + observed, + "Analysis: 1 Information fraction: 0.42 AHR: 0.81 Event: 160.4" + ) + + # Throw error is analysis_decimals is unnamed + expect_error( + summary(x, analysis_decimals = c(4, 4)), + "summary: analysis_decimals must be a named vector if analysis_vars is not provided" + ) +})