From 4b4b32ac27030e996db44bf03019ec190a729235 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Tue, 17 Sep 2024 07:05:50 -0700 Subject: [PATCH] Added `tbl_ard_summary(overall)` argument (#1978) --- NEWS.md | 2 + R/tbl_ard_summary.R | 55 ++++++++++++++++++++++++++- man/tbl_ard_summary.Rd | 21 +++++++++- tests/testthat/test-tbl_ard_summary.R | 50 ++++++++++++++++++++++++ 4 files changed, 125 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index eb0bdb07d..1ae485b76 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ * Removed the `"tbl_summary-arg:statistic"` theme that was incorrectly added to `tbl_continuous()`. +* Added argument `tbl_ard_summary(overall)`. When `TRUE`, the ARD is parsed into primary ARD and the Overall ARD and we run `tbl_ard_summary() |> add_overall()`. (#1940) + * Added `add_stat_label.tbl_ard_summary()` method. (#1969) * Removed documentation for the `add_overall.tbl_ard_summary(digits)` argument, which was never meant to be a part of this function. (#1975) diff --git a/R/tbl_ard_summary.R b/R/tbl_ard_summary.R index b475389b9..0934e0fc6 100644 --- a/R/tbl_ard_summary.R +++ b/R/tbl_ard_summary.R @@ -29,6 +29,11 @@ #' categorical and dichotomous cannot be modified. #' @param include ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' Variables to include in the summary table. Default is `everything()` +#' @param overall (scalar `logical`)\cr +#' When `TRUE`, the `cards` input is parsed into two parts to run +#' `tbl_ard_summary(cards_by) |> add_overall(cards_overall)`. +#' Can only by used when `by` argument is specified. +#' Default is `FALSE`. #' @inheritParams tbl_summary #' #' @return a gtsummary table of class `"tbl_ard_summary"` @@ -57,6 +62,18 @@ #' .total_n = TRUE #' ) |> #' tbl_ard_summary(by = ARM) +#' +#' ard_stack( +#' data = ADSL, +#' .by = ARM, +#' ard_categorical(variables = "AGEGR1"), +#' ard_continuous(variables = "AGE"), +#' .attributes = TRUE, +#' .missing = TRUE, +#' .total_n = TRUE, +#' .overall = TRUE +#' ) |> +#' tbl_ard_summary(by = ARM, overall = TRUE) tbl_ard_summary <- function(cards, by = NULL, statistic = list( @@ -68,7 +85,8 @@ tbl_ard_summary <- function(cards, missing = c("no", "ifany", "always"), missing_text = "Unknown", missing_stat = "{N_miss}", - include = everything()) { + include = everything(), + overall = FALSE) { set_cli_abort_call() # data argument checks ------------------------------------------------------- check_not_missing(cards) @@ -91,6 +109,12 @@ tbl_ard_summary <- function(cards, cards::process_selectors(data, include = {{ include }}, by = {{ by }}) include <- setdiff(include, by) # remove by variable from list vars included check_scalar(by, allow_empty = TRUE) + check_scalar_logical(overall) + if (isTRUE(overall) && is_empty(by)) { + cli::cli_inform(c("Cannot use {.code overall=TRUE} when {.arg by} argment not specified.", + "*" = "Setting {.code overall=FALSE}.")) + overall <- FALSE + } # check structure of ARD input ----------------------------------------------- if (is_empty(by) && !is_empty(names(dplyr::select(cards, cards::all_ard_groups())))) { @@ -222,6 +246,20 @@ tbl_ard_summary <- function(cards, .quiet = TRUE ) + # if `overall=TRUE`, parse cards into primary and overall parts -------------- + if (isTRUE(overall)) { + cards_overall <- cards |> + # remove grouped summary statistics + dplyr::filter(is.na(.data$group1)) |> + # remove `by` variable univariate tabulation + dplyr::filter(!.data$variable %in% .env$by) |> + dplyr::select(-(cards::all_missing_columns() & cards::all_ard_groups())) + + cards <- cards |> + # remove univariate summary stats + dplyr::filter(!(is.na(.data$group1) & .data$variable %in% .env$include) | .data$context %in% "attributes") + } + # add the gtsummary column names to ARD data frame --------------------------- cards <- cards::eval_capture_conditions(.add_gts_column_to_cards_summary(cards, include, by)) |> @@ -236,6 +274,12 @@ tbl_ard_summary <- function(cards, tbl_ard_summary_inputs <- as.list(environment())[names(formals(tbl_ard_summary))] call <- match.call() + # if overall=TRUE, then remove overall items from inputs object + if (isTRUE(overall)) { + tbl_ard_summary_inputs$overall <- FALSE + tbl_ard_summary_inputs$cards_overall <- NULL + } + # fill NULL stats with NA cards <- cards::replace_null_statistic(cards) @@ -279,7 +323,14 @@ tbl_ard_summary <- function(cards, ) ) - # return tbl_ard_summary table ----------------------------------------------- + # add call list to tbl_ard_summary table ------------------------------------- x$call_list <- list(tbl_ard_summary = call) + + # if overall=TRUE, then run add_overall() ------------------------------------ + if (isTRUE(overall)) { + x <- add_overall(x, cards = cards_overall) + } + + # return tbl_ard_summary table ----------------------------------------------- x } diff --git a/man/tbl_ard_summary.Rd b/man/tbl_ard_summary.Rd index fd05dc47c..8edbc1e29 100644 --- a/man/tbl_ard_summary.Rd +++ b/man/tbl_ard_summary.Rd @@ -14,7 +14,8 @@ tbl_ard_summary( missing = c("no", "ifany", "always"), missing_text = "Unknown", missing_stat = "{N_miss}", - include = everything() + include = everything(), + overall = FALSE ) } \arguments{ @@ -53,6 +54,12 @@ Possible values are \code{N_miss}, \code{N_obs}, \code{N_nonmiss}, \code{p_miss} \item{include}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr Variables to include in the summary table. Default is \code{everything()}} + +\item{overall}{(scalar \code{logical})\cr +When \code{TRUE}, the \code{cards} input is parsed into two parts to run +\code{tbl_ard_summary(cards_by) |> add_overall(cards_overall)}. +Can only by used when \code{by} argument is specified. +Default is \code{FALSE}.} } \value{ a gtsummary table of class \code{"tbl_ard_summary"} @@ -86,4 +93,16 @@ ard_stack( .total_n = TRUE ) |> tbl_ard_summary(by = ARM) + +ard_stack( + data = ADSL, + .by = ARM, + ard_categorical(variables = "AGEGR1"), + ard_continuous(variables = "AGE"), + .attributes = TRUE, + .missing = TRUE, + .total_n = TRUE, + .overall = TRUE +) |> + tbl_ard_summary(by = ARM, overall = TRUE) } diff --git a/tests/testthat/test-tbl_ard_summary.R b/tests/testthat/test-tbl_ard_summary.R index 6f285d071..64939ec93 100644 --- a/tests/testthat/test-tbl_ard_summary.R +++ b/tests/testthat/test-tbl_ard_summary.R @@ -231,3 +231,53 @@ test_that("tbl_ard_summary(statistic) error messages", { tbl_ard_summary(by = ARM, statistic = list(AGE = c("{mean}", "{median}"))) ) }) + +test_that("tbl_ard_summary(overall)", { + # check no errors when using function as expected + expect_silent( + tbl <- + cards::ard_stack( + trial, + .by = trt, + cards::ard_continuous(variables = age), + cards::ard_categorical(variables = grade), + .missing = TRUE, + .attributes = TRUE, + .total_n = TRUE, + .overall = TRUE + ) |> + tbl_ard_summary(by = trt, overall = TRUE) + ) + + # check the parsed cards objects are the same when constructed separately + expect_equal( + tbl$cards$tbl_ard_summary |> + dplyr::select(-gts_column) |> + cards::tidy_ard_row_order(), + cards::ard_stack( + trial, + .by = trt, + cards::ard_continuous(variables = age), + cards::ard_categorical(variables = grade), + .missing = TRUE, + .attributes = TRUE, + .total_n = TRUE + ) |> + cards::tidy_ard_row_order() + ) + expect_equal( + tbl$cards$add_overall |> + dplyr::select(-gts_column) |> + cards::tidy_ard_row_order(), + cards::ard_stack( + trial, + cards::ard_continuous(variables = age), + cards::ard_categorical(variables = grade), + .missing = TRUE, + .attributes = TRUE, + .total_n = TRUE + ) |> + cards::tidy_ard_row_order() + ) +}) +