diff --git a/NAMESPACE b/NAMESPACE index d5c5c5ed3..59b96e0de 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,6 +76,7 @@ export(eval_capture_conditions) export(everything) export(fill_formula_selectors) export(filter_ard_hierarchical) +export(get_ard_stat_string) export(get_ard_statistics) export(get_cards_fn_stat_names) export(is_ard_equal) diff --git a/NEWS.md b/NEWS.md index e3d349f78..73b25b4fc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # cards 0.9.0.9002 +## New Features and Functions + +* Added function `get_ard_stat_string()` to return formatted statistics from an ARD combined into a single string, e.g. `"42 / 86 (48.8%)"`. The statistics are inserted into a glue `pattern` such as `"{n} / {N} ({p}%)"`. (#452) + ## Bug Fixes * Fixed a bug in `print.compare_ard()` where the rows present in `x` but not in `y` were announced and then not printed. (#605, @malanbos) diff --git a/R/get_ard_stat_string.R b/R/get_ard_stat_string.R new file mode 100644 index 000000000..fa5e89eb2 --- /dev/null +++ b/R/get_ard_stat_string.R @@ -0,0 +1,106 @@ +#' ARD Statistics as String +#' +#' Returns formatted statistics from an ARD, combined into a single string. +#' The formatted statistics (the `"stat_fmt"` column, see [apply_fmt_fun()]) +#' are inserted into `pattern` using glue syntax, +#' where each `{stat_name}` is replaced by the corresponding formatted statistic. +#' +#' @param x (`data.frame`)\cr +#' an ARD data frame of class 'card' +#' @param ... ([`dynamic-dots`][rlang::dyn-dots])\cr +#' arguments indicating the rows of the ARD to subset. +#' For example, to return only rows where the column `"AGEGR1"` is `"65-80"`, +#' pass `AGEGR1 %in% "65-80"`. +#' After subsetting, each statistic named in `pattern` must appear in exactly one row. +#' @param pattern (`string`)\cr +#' a string with the statistics to include in glue syntax, +#' e.g. `"{n} / {N} ({p}%)"`. +#' The names in the curly brackets must be values of the `"stat_name"` column. +#' @param missing (`string`)\cr +#' string returned when all statistics in `pattern` are missing. +#' Default is `""`. +#' +#' @return a string +#' @export +#' +#' @examples +#' ard <- ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1") +#' +#' get_ard_stat_string( +#' ard, +#' group1_level %in% "Placebo", +#' variable_level %in% "65-80", +#' pattern = "{n} / {N} ({p}%)" +#' ) +get_ard_stat_string <- function(x, + ..., + pattern, + missing = "") { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_class(x, cls = "card") + check_string(pattern) + check_string(missing) + + stat_names <- .extract_stat_names(pattern) + if (length(stat_names) == 0L) { + cli::cli_abort( + "The {.arg pattern} argument must reference at least one statistic + in curly brackets, e.g. {.val {{n}} ({{p}}%)}.", + call = get_cli_abort_call() + ) + } + + # subset the ARD and apply the formatting functions -------------------------- + ard_subset <- x |> + apply_fmt_fun() |> + dplyr::filter(...) + + # each statistic in the pattern must be in exactly one row ------------------- + n_rows <- vapply(stat_names, function(nm) sum(ard_subset$stat_name %in% nm), integer(1L)) + not_found <- names(n_rows)[n_rows == 0L] + duplicated <- names(n_rows)[n_rows > 1L] + if (length(not_found) > 0L || length(duplicated) > 0L) { + msg <- "Each statistic in {.arg pattern} must appear in exactly one row of the subset ARD." + if (length(not_found) > 0L) { + msg <- c(msg, x = "Statistic{?s} {.val {not_found}} not found.") + } + if (length(duplicated) > 0L) { + msg <- c(msg, x = "Statistic{?s} {.val {duplicated}} found in more than one row.") + } + cli::cli_abort(msg, call = get_cli_abort_call()) + } + + # insert the formatted statistics into the pattern --------------------------- + stat_fmt <- + stat_names |> + lapply(function(nm) { + fmt <- ard_subset$stat_fmt[[which(ard_subset$stat_name == nm)]] + # a NULL statistic has a zero-length formatted value + if (length(fmt) == 0L) NA_character_ else as.character(fmt) + }) |> + stats::setNames(stat_names) + + if (all(is.na(stat_fmt))) { + return(missing) + } + + glue::glue_data(stat_fmt, pattern) |> + as.character() +} + +#' Extract Statistic Names from Pattern +#' +#' @param pattern (`string`)\cr +#' a glue pattern, e.g. `"{n} ({p}%)"` +#' +#' @return a character vector of the unique names inside curly brackets +#' @keywords internal +#' +#' @examples +#' cards:::.extract_stat_names("{n} / {N} ({p}%)") +.extract_stat_names <- function(pattern) { + regmatches(pattern, gregexpr("(?<=\\{)[^{}]+(?=\\})", pattern, perl = TRUE))[[1]] |> + unique() +} diff --git a/_pkgdown.yml b/_pkgdown.yml index d7487c9bd..10272b40e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -89,6 +89,7 @@ reference: - shuffle_ard - as_nested_list - get_ard_statistics + - get_ard_stat_string - replace_null_statistic - rename_ard_groups - compare_ard diff --git a/man/dot-extract_stat_names.Rd b/man/dot-extract_stat_names.Rd new file mode 100644 index 000000000..e9aeb9505 --- /dev/null +++ b/man/dot-extract_stat_names.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_ard_stat_string.R +\name{.extract_stat_names} +\alias{.extract_stat_names} +\title{Extract Statistic Names from Pattern} +\usage{ +.extract_stat_names(pattern) +} +\arguments{ +\item{pattern}{(\code{string})\cr +a glue pattern, e.g. \code{"{n} ({p}\%)"}} +} +\value{ +a character vector of the unique names inside curly brackets +} +\description{ +Extract Statistic Names from Pattern +} +\examples{ +cards:::.extract_stat_names("{n} / {N} ({p}\%)") +} +\keyword{internal} diff --git a/man/get_ard_stat_string.Rd b/man/get_ard_stat_string.Rd new file mode 100644 index 000000000..d1bd085e2 --- /dev/null +++ b/man/get_ard_stat_string.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_ard_stat_string.R +\name{get_ard_stat_string} +\alias{get_ard_stat_string} +\title{ARD Statistics as String} +\usage{ +get_ard_stat_string(x, ..., pattern, missing = "") +} +\arguments{ +\item{x}{(\code{data.frame})\cr +an ARD data frame of class 'card'} + +\item{...}{(\code{\link[rlang:dyn-dots]{dynamic-dots}})\cr +arguments indicating the rows of the ARD to subset. +For example, to return only rows where the column \code{"AGEGR1"} is \code{"65-80"}, +pass \code{AGEGR1 \%in\% "65-80"}. +After subsetting, each statistic named in \code{pattern} must appear in exactly one row.} + +\item{pattern}{(\code{string})\cr +a string with the statistics to include in glue syntax, +e.g. \code{"{n} / {N} ({p}\%)"}. +The names in the curly brackets must be values of the \code{"stat_name"} column.} + +\item{missing}{(\code{string})\cr +string returned when all statistics in \code{pattern} are missing. +Default is \code{""}.} +} +\value{ +a string +} +\description{ +Returns formatted statistics from an ARD, combined into a single string. +The formatted statistics (the \code{"stat_fmt"} column, see \code{\link[=apply_fmt_fun]{apply_fmt_fun()}}) +are inserted into \code{pattern} using glue syntax, +where each \code{{stat_name}} is replaced by the corresponding formatted statistic. +} +\examples{ +ard <- ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1") + +get_ard_stat_string( + ard, + group1_level \%in\% "Placebo", + variable_level \%in\% "65-80", + pattern = "{n} / {N} ({p}\%)" +) +} diff --git a/tests/testthat/_snaps/get_ard_stat_string.md b/tests/testthat/_snaps/get_ard_stat_string.md new file mode 100644 index 000000000..c14073c1d --- /dev/null +++ b/tests/testthat/_snaps/get_ard_stat_string.md @@ -0,0 +1,43 @@ +# get_ard_stat_string() errors with bad inputs + + Code + get_ard_stat_string(mtcars, pattern = "{n}") + Condition + Error in `get_ard_stat_string()`: + ! The `x` argument must be class , not a data frame. + +--- + + Code + get_ard_stat_string(ard, pattern = 1L) + Condition + Error in `get_ard_stat_string()`: + ! The `pattern` argument must be a string, not an integer. + +--- + + Code + get_ard_stat_string(ard, pattern = "no stats") + Condition + Error in `get_ard_stat_string()`: + ! The `pattern` argument must reference at least one statistic in curly brackets, e.g. "{n} ({p}%)". + +--- + + Code + get_ard_stat_string(ard, group1_level %in% "Placebo", variable_level %in% + "65-80", pattern = "{n} ({not_a_stat})") + Condition + Error in `get_ard_stat_string()`: + ! Each statistic in `pattern` must appear in exactly one row of the subset ARD. + x Statistic "not_a_stat" not found. + +--- + + Code + get_ard_stat_string(ard, variable_level %in% "65-80", pattern = "{n} / {N}") + Condition + Error in `get_ard_stat_string()`: + ! Each statistic in `pattern` must appear in exactly one row of the subset ARD. + x Statistics "n" and "N" found in more than one row. + diff --git a/tests/testthat/test-get_ard_stat_string.R b/tests/testthat/test-get_ard_stat_string.R new file mode 100644 index 000000000..2f24b1c20 --- /dev/null +++ b/tests/testthat/test-get_ard_stat_string.R @@ -0,0 +1,102 @@ +test_that("get_ard_stat_string() works", { + ard <- ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1") + + expect_equal( + get_ard_stat_string( + ard, + group1_level %in% "Placebo", + variable_level %in% "65-80", + pattern = "{n} / {N} ({p}%)" + ), + "42 / 86 (48.8%)" + ) + + # statistics can be in any order, and repeated + expect_equal( + get_ard_stat_string( + ard, + group1_level %in% "Placebo", + variable_level %in% "65-80", + pattern = "{p}% ({n}/{N}), n = {n}" + ), + "48.8% (42/86), n = 42" + ) + + # custom formatting functions are used + ard_fmt <- ard_summary( + ADSL, + variables = "AGE", + statistic = ~ continuous_summary_fns(c("mean", "sd")), + fmt_fun = list(AGE = list(mean = 3, sd = 1)) + ) + expect_equal( + get_ard_stat_string(ard_fmt, pattern = "{mean} ({sd})"), + "75.087 (8.2)" + ) + + # `missing` is returned when all statistics are missing + ard_miss <- ard + ard_miss$stat[ard_miss$stat_name %in% c("n", "N")] <- list(NULL) + expect_equal( + get_ard_stat_string( + ard_miss, + group1_level %in% "Placebo", + variable_level %in% "65-80", + pattern = "{n} / {N}" + ), + "" + ) + expect_equal( + get_ard_stat_string( + ard_miss, + group1_level %in% "Placebo", + variable_level %in% "65-80", + pattern = "{n} / {N}", + missing = "--" + ), + "--" + ) +}) + +test_that("get_ard_stat_string() errors with bad inputs", { + ard <- ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1") + + # not an ARD + expect_snapshot( + get_ard_stat_string(mtcars, pattern = "{n}"), + error = TRUE + ) + + # pattern is not a string + expect_snapshot( + get_ard_stat_string(ard, pattern = 1L), + error = TRUE + ) + + # pattern does not reference any statistic + expect_snapshot( + get_ard_stat_string(ard, pattern = "no stats"), + error = TRUE + ) + + # statistic not in the subset ARD + expect_snapshot( + get_ard_stat_string( + ard, + group1_level %in% "Placebo", + variable_level %in% "65-80", + pattern = "{n} ({not_a_stat})" + ), + error = TRUE + ) + + # statistic appears in more than one row + expect_snapshot( + get_ard_stat_string( + ard, + variable_level %in% "65-80", + pattern = "{n} / {N}" + ), + error = TRUE + ) +})