Add get_ard_stat_string() to return formatted ARD statistics as a string

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)

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)

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()
+}

_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

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 <card>, 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.
+

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
+  )
+})