From 0e366807e11385e743ed689a1a8ea4f1cc819d3e Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Mon, 24 Aug 2026 14:55:34 +0000 Subject: [PATCH 01/10] Add add_hierarchical_zero_rows() for unobserved hierarchical levels Stacked hierarchical ARDs include only observed levels because the tabulation routes through the strata (observed-only) branch, so predefined categories such as SMQ/CQ baskets, SOCs, and preferred terms disappear instead of showing a zero count. add_hierarchical_zero_rows() appends zero-count rows for unobserved levels using a mapping of the expected level universe. A single mapping argument (named list or data.frame) covers both an unobserved top-level category and an unobserved child of an observed parent, and preserves the by structure and denominators so percentages remain correct. --- NEWS.md | 2 + R/add_hierarchical_zero_rows.R | 249 ++++++++++++++++++ man/add_hierarchical_zero_rows.Rd | 96 +++++++ .../test-add_hierarchical_zero_rows.R | 141 ++++++++++ 4 files changed, 488 insertions(+) create mode 100644 R/add_hierarchical_zero_rows.R create mode 100644 man/add_hierarchical_zero_rows.Rd create mode 100644 tests/testthat/test-add_hierarchical_zero_rows.R diff --git a/NEWS.md b/NEWS.md index f40bd8e4a..b50a0296a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # cards 0.9.0.9000 +* Added `add_hierarchical_zero_rows()` to append zero-count rows for unobserved hierarchical levels (top-level categories and nested children) to a stacked hierarchical ARD, using a `mapping` of the expected level universe. (#602) + # cards 0.9.0 ## Performance diff --git a/R/add_hierarchical_zero_rows.R b/R/add_hierarchical_zero_rows.R new file mode 100644 index 000000000..fe7253227 --- /dev/null +++ b/R/add_hierarchical_zero_rows.R @@ -0,0 +1,249 @@ +#' Add Zero-Count Rows for Unobserved Hierarchical Levels +#' +#' @description `r lifecycle::badge('experimental')`\cr +#' +#' Stacked hierarchical ARDs created with [ard_stack_hierarchical()] include only +#' the levels observed in the data, because the underlying tabulation routes +#' through the `strata` (observed-only) branch of the engine. Predefined +#' categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore +#' disappear from the ARD instead of appearing with a count of zero. +#' +#' `add_hierarchical_zero_rows()` restores those rows. A single `mapping` +#' argument describes the expected universe of levels and covers both scenarios +#' that arise in practice: +#' +#' - a **top-level** category that is never observed (e.g. an SOC with no events), +#' - a **nested** child that is never observed under an otherwise present parent +#' (e.g. a preferred term with no events within an observed SOC). +#' +#' A nested child has no unambiguous parent when it is absent, so the expected +#' parent/child structure must be supplied explicitly through `mapping` rather +#' than inferred from factor levels. +#' +#' @param x (`card`)\cr +#' a stacked hierarchical ARD of class `'card'` created with +#' [ard_stack_hierarchical()] or [ard_stack_hierarchical_count()]. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' the hierarchical variables used to create `x`, in the same order. The first +#' variable is the top level; the second, when present, is the nested child. +#' @param mapping (named `list` or `data.frame`)\cr +#' the expected universe of levels. Either +#' - a **named list** mapping each parent level to a character vector of its +#' expected child levels, e.g. +#' `list("SOC A" = c("PT1", "PT2"), "SOC B" = "PT3")`, or +#' - a **two-column data frame** whose columns are named after the first two +#' `variables`, e.g. `data.frame(AESOC = ..., AEDECOD = ...)`, listing every +#' valid parent/child combination. +#' +#' Parents present in `mapping` but absent from `x` are added as top-level +#' zero-rows together with their mapped children. Children present in `mapping` +#' but absent under an observed parent are added as nested zero-rows. +#' @param statistic (`character`)\cr +#' the statistics to set to zero on the added rows. Statistics not listed are +#' carried over from a matching observed row (so denominators such as `N` +#' remain correct). Defaults to `c("n", "p", "n_cum", "p_cum")`. +#' +#' @return an ARD data frame of class 'card' +#' @seealso [ard_stack_hierarchical()], [sort_ard_hierarchical()] +#' @name add_hierarchical_zero_rows +#' +#' @examples +#' set.seed(1) +#' adae <- data.frame( +#' USUBJID = sprintf("S%03d", 1:20), +#' SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), +#' PT = sample(c("PT1", "PT2"), 20, TRUE) +#' ) +#' +#' ard <- ard_stack_hierarchical( +#' adae, +#' variables = c(SOC, PT), +#' id = USUBJID, +#' denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) +#' ) +#' +#' # add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +#' ard |> +#' add_hierarchical_zero_rows( +#' variables = c(SOC, PT), +#' mapping = list( +#' Cardiac = c("PT1", "PT2", "PT3"), +#' GI = c("PT1", "PT2"), +#' Vascular = "PTX" +#' ) +#' ) +NULL + +#' @rdname add_hierarchical_zero_rows +#' @export +add_hierarchical_zero_rows <- function(x, + variables, + mapping, + statistic = c("n", "p", "n_cum", "p_cum")) { + set_cli_abort_call() + + # process inputs ------------------------------------------------------------- + check_not_missing(x) + check_not_missing(variables) + check_not_missing(mapping) + check_class(x, "card") + check_class(x, "ard_stack_hierarchical") + if (!is.character(statistic)) { + cli::cli_abort( + "The {.arg statistic} argument must be a {.cls character} vector.", + call = get_cli_abort_call() + ) + } + + # `variables` is tidy-selected against the ARD's own variable column so the + # helper accepts the same style of input as ard_stack_hierarchical() + var_universe <- unique(x[["variable"]]) + scaffold <- as.data.frame( + stats::setNames(rep(list(logical(0)), length(var_universe)), var_universe) + ) + process_selectors(scaffold, variables = {{ variables }}) + + if (!is.list(mapping) && !is.data.frame(mapping)) { + cli::cli_abort( + "The {.arg mapping} argument must be a named {.cls list} or a {.cls data.frame}.", + call = get_cli_abort_call() + ) + } + + top_var <- variables[1L] + child_var <- if (length(variables) >= 2L) variables[2L] else NA_character_ + + # helper: first level value from a list-column (`variable_level`, `groupN_level`) + level_chr <- function(col) { + vapply( + col, + function(z) { + z <- as.character(z) + if (length(z)) z[[1L]] else NA_character_ + }, + character(1L) + ) + } + + # the hierarchical parent of a nested variable is stored in the last populated + # `groupN` column: without a `by` the top variable has no group columns and the + # child's parent is `group1`; with a `by` the arm occupies `group1` and the + # parent shifts to `group2`. Detect the child's parent group column from data. + child_rows <- if (!is.na(child_var)) x[x[["variable"]] == child_var, ] else x[0, ] + parent_group_col <- NA_character_ + if (nrow(child_rows) > 0L) { + group_cols <- grep("^group[0-9]+$", names(x), value = TRUE) + for (gc in group_cols) { + if (any(as.character(child_rows[[gc]]) == top_var, na.rm = TRUE)) { + parent_group_col <- gc + break + } + } + } + parent_level_col <- if (!is.na(parent_group_col)) paste0(parent_group_col, "_level") else NA_character_ + + # build a zero-row block from an observed template, overriding the variable and + # its level, optionally setting the hierarchical parent, and zeroing statistics + build_block <- function(template, parent_level, variable, level) { + if (nrow(template) == 0L) { + return(template) + } + template[["variable"]] <- variable + template[["variable_level"]] <- rep(list(level), nrow(template)) + if (!is.null(parent_level) && !is.na(parent_group_col)) { + template[[parent_group_col]] <- top_var + template[[parent_level_col]] <- rep(list(parent_level), nrow(template)) + } + is_zero <- template[["stat_name"]] %in% statistic + template[["stat"]][is_zero] <- as.list(rep(0, sum(is_zero))) + if ("warning" %in% names(template)) template[["warning"]] <- rep(list(NULL), nrow(template)) + if ("error" %in% names(template)) template[["error"]] <- rep(list(NULL), nrow(template)) + template + } + + # observed top-level values and the expected universe from `mapping` + observed_top <- unique(level_chr(x[["variable_level"]][x[["variable"]] == top_var])) + expected_top <- .zero_rows_expected_top(mapping, top_var) + missing_top <- setdiff(expected_top, observed_top) + + # blueprint rows carry the correct stat structure (n/N/p, by-groups, fmt_fun). + # one blueprint per `by`-group is preserved by taking all rows of one level. + blueprint_top <- x[x[["variable"]] == top_var & level_chr(x[["variable_level"]]) == observed_top[1L], ] + # a child blueprint spans one child level under one parent, across all + # `by`-groups; the parent level is overwritten per added row + blueprint_child <- if (nrow(child_rows) > 0L) { + first_child <- level_chr(child_rows[["variable_level"]])[1L] + child_one <- child_rows[level_chr(child_rows[["variable_level"]]) == first_child, ] + if (!is.na(parent_level_col)) { + first_parent <- level_chr(child_one[[parent_level_col]])[1L] + child_one[level_chr(child_one[[parent_level_col]]) == first_parent, ] + } else { + child_one + } + } else { + x[0, ] + } + + new_blocks <- list() + + # top-level completion plus the children of any missing parent + for (lvl in missing_top) { + new_blocks <- c(new_blocks, list(build_block(blueprint_top, NULL, top_var, lvl))) + if (!is.na(child_var)) { + for (kid in .zero_rows_children(mapping, lvl, top_var, child_var)) { + new_blocks <- c(new_blocks, list(build_block(blueprint_child, lvl, child_var, kid))) + } + } + } + + # nested completion: observed parent, unobserved child + if (!is.na(child_var) && !is.na(parent_level_col)) { + for (parent in observed_top) { + expected_kids <- .zero_rows_children(mapping, parent, top_var, child_var) + observed_kids <- unique(level_chr( + child_rows[["variable_level"]][level_chr(child_rows[[parent_level_col]]) == parent] + )) + for (kid in setdiff(expected_kids, observed_kids)) { + new_blocks <- c(new_blocks, list(build_block(blueprint_child, parent, child_var, kid))) + } + } + } + + if (length(new_blocks) == 0L) { + return(x) + } + + out <- dplyr::bind_rows(x, dplyr::bind_rows(new_blocks)) + class(out) <- class(x) + out +} + +# expected top-level values from a list (its names) or data.frame (first column) +.zero_rows_expected_top <- function(mapping, top_var) { + if (is.data.frame(mapping)) { + if (!top_var %in% names(mapping)) { + cli::cli_abort( + "A {.cls data.frame} {.arg mapping} must contain a column named {.val {top_var}}.", + call = get_cli_abort_call() + ) + } + unique(as.character(mapping[[top_var]])) + } else { + names(mapping) + } +} + +# expected child levels for a parent from a list or data.frame mapping +.zero_rows_children <- function(mapping, parent, top_var, child_var) { + if (is.data.frame(mapping)) { + if (!child_var %in% names(mapping)) { + cli::cli_abort( + "A {.cls data.frame} {.arg mapping} must contain a column named {.val {child_var}}.", + call = get_cli_abort_call() + ) + } + as.character(unique(mapping[[child_var]][as.character(mapping[[top_var]]) == parent])) + } else { + as.character(mapping[[parent]] %||% character(0L)) + } +} diff --git a/man/add_hierarchical_zero_rows.Rd b/man/add_hierarchical_zero_rows.Rd new file mode 100644 index 000000000..b4736629d --- /dev/null +++ b/man/add_hierarchical_zero_rows.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_hierarchical_zero_rows.R +\name{add_hierarchical_zero_rows} +\alias{add_hierarchical_zero_rows} +\title{Add Zero-Count Rows for Unobserved Hierarchical Levels} +\usage{ +add_hierarchical_zero_rows( + x, + variables, + mapping, + statistic = c("n", "p", "n_cum", "p_cum") +) +} +\arguments{ +\item{x}{(\code{card})\cr +a stacked hierarchical ARD of class \code{'card'} created with +\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} or \code{\link[=ard_stack_hierarchical_count]{ard_stack_hierarchical_count()}}.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +the hierarchical variables used to create \code{x}, in the same order. The first +variable is the top level; the second, when present, is the nested child.} + +\item{mapping}{(named \code{list} or \code{data.frame})\cr +the expected universe of levels. Either +\itemize{ +\item a \strong{named list} mapping each parent level to a character vector of its +expected child levels, e.g. +\code{list("SOC A" = c("PT1", "PT2"), "SOC B" = "PT3")}, or +\item a \strong{two-column data frame} whose columns are named after the first two +\code{variables}, e.g. \code{data.frame(AESOC = ..., AEDECOD = ...)}, listing every +valid parent/child combination. +} + +Parents present in \code{mapping} but absent from \code{x} are added as top-level +zero-rows together with their mapped children. Children present in \code{mapping} +but absent under an observed parent are added as nested zero-rows.} + +\item{statistic}{(\code{character})\cr +the statistics to set to zero on the added rows. Statistics not listed are +carried over from a matching observed row (so denominators such as \code{N} +remain correct). Defaults to \code{c("n", "p", "n_cum", "p_cum")}.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}\cr + +Stacked hierarchical ARDs created with \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} include only +the levels observed in the data, because the underlying tabulation routes +through the \code{strata} (observed-only) branch of the engine. Predefined +categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore +disappear from the ARD instead of appearing with a count of zero. + +\code{add_hierarchical_zero_rows()} restores those rows. A single \code{mapping} +argument describes the expected universe of levels and covers both scenarios +that arise in practice: +\itemize{ +\item a \strong{top-level} category that is never observed (e.g. an SOC with no events), +\item a \strong{nested} child that is never observed under an otherwise present parent +(e.g. a preferred term with no events within an observed SOC). +} + +A nested child has no unambiguous parent when it is absent, so the expected +parent/child structure must be supplied explicitly through \code{mapping} rather +than inferred from factor levels. +} +\examples{ +set.seed(1) +adae <- data.frame( + USUBJID = sprintf("S\%03d", 1:20), + SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), + PT = sample(c("PT1", "PT2"), 20, TRUE) +) + +ard <- ard_stack_hierarchical( + adae, + variables = c(SOC, PT), + id = USUBJID, + denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) +) + +# add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +ard |> + add_hierarchical_zero_rows( + variables = c(SOC, PT), + mapping = list( + Cardiac = c("PT1", "PT2", "PT3"), + GI = c("PT1", "PT2"), + Vascular = "PTX" + ) + ) +} +\seealso{ +\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}, \code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} +} diff --git a/tests/testthat/test-add_hierarchical_zero_rows.R b/tests/testthat/test-add_hierarchical_zero_rows.R new file mode 100644 index 000000000..33431f3fd --- /dev/null +++ b/tests/testthat/test-add_hierarchical_zero_rows.R @@ -0,0 +1,141 @@ +skip_on_cran() + +# a small hierarchical ARD where "Vascular" is a declared but unobserved SOC and +# each SOC has a known preferred-term universe +make_ard <- function(by = FALSE) { + set.seed(1) + adae <- data.frame( + USUBJID = sprintf("S%03d", 1:20), + SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), + PT = sample(c("PT1", "PT2"), 20, TRUE), + TRT = factor(rep(c("A", "B"), 10)) + ) + denom <- data.frame(USUBJID = sprintf("S%03d", 1:30), TRT = factor(rep(c("A", "B"), 15))) + if (by) { + ard_stack_hierarchical(adae, variables = c(SOC, PT), by = TRT, id = USUBJID, denominator = denom) + } else { + ard_stack_hierarchical(adae, variables = c(SOC, PT), id = USUBJID, denominator = denom) + } +} + +# first level value from a list-column +lvl1 <- function(col) { + vapply(col, function(z) { + z <- as.character(z) + if (length(z)) z[[1L]] else NA_character_ + }, character(1L)) +} + +test_that("add_hierarchical_zero_rows() adds a missing top-level category", { + ard <- make_ard() + out <- add_hierarchical_zero_rows( + ard, + variables = c(SOC, PT), + mapping = list(Cardiac = c("PT1", "PT2"), GI = c("PT1", "PT2"), Vascular = character(0)) + ) + + expect_s3_class(out, "ard_stack_hierarchical") + expect_setequal( + unique(lvl1(out$variable_level[out$variable == "SOC"])), + c("Cardiac", "GI", "Vascular") + ) + # the added row has n = 0 and carries a real denominator N + expect_equal( + out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n"][[1L]], + 0 + ) + expect_equal( + out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "N"][[1L]], + 30 + ) +}) + +test_that("add_hierarchical_zero_rows() adds children of a missing parent", { + ard <- make_ard() + out <- add_hierarchical_zero_rows( + ard, + variables = c(SOC, PT), + mapping = list(Vascular = c("PTX", "PTY")) + ) + + kids <- out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"] + expect_setequal(unique(lvl1(kids)), c("PTX", "PTY")) + expect_true(all( + unlist(out$stat[out$variable == "PT" & lvl1(out$group1_level) == "Vascular" & out$stat_name == "n"]) == 0 + )) +}) + +test_that("add_hierarchical_zero_rows() adds a missing child of an observed parent", { + ard <- make_ard() + out <- add_hierarchical_zero_rows( + ard, + variables = c(SOC, PT), + mapping = list(Cardiac = c("PT1", "PT2", "PT3")) + ) + + expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) + expect_equal( + out$stat[out$variable == "PT" & lvl1(out$variable_level) == "PT3" & + lvl1(out$group1_level) == "Cardiac" & out$stat_name == "n"][[1L]], + 0 + ) +}) + +test_that("add_hierarchical_zero_rows() accepts a data.frame mapping", { + ard <- make_ard() + mapping <- data.frame( + SOC = c("Vascular", "Vascular", "Cardiac"), + PT = c("PTX", "PTY", "PT3") + ) + out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = mapping) + + expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) + expect_setequal( + unique(lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"])), + c("PTX", "PTY") + ) + expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) +}) + +test_that("add_hierarchical_zero_rows() preserves the by structure", { + ard <- make_ard(by = TRUE) + out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + + # one Vascular SOC row per by-group, with the arm retained in group1 + vasc_soc <- out[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n", ] + expect_equal(nrow(vasc_soc), 2L) + expect_setequal(lvl1(vasc_soc$group1_level), c("A", "B")) + + # one Vascular > PTX row per by-group, with the parent SOC in group2 + vasc_pt <- out[out$variable == "PT" & lvl1(out$variable_level) == "PTX" & out$stat_name == "n", ] + expect_equal(nrow(vasc_pt), 2L) + expect_setequal(lvl1(vasc_pt$group2_level), c("Vascular")) +}) + +test_that("add_hierarchical_zero_rows() is a no-op when nothing is missing", { + ard <- make_ard() + out <- add_hierarchical_zero_rows( + ard, + variables = c(SOC, PT), + mapping = list(Cardiac = c("PT1", "PT2"), GI = c("PT1", "PT2")) + ) + expect_equal(nrow(out), nrow(ard)) +}) + +test_that("add_hierarchical_zero_rows() input checks", { + ard <- make_ard() + expect_error( + add_hierarchical_zero_rows(data.frame(a = 1), variables = a, mapping = list()), + class = "check_class" + ) + expect_error( + add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = "not a mapping"), + "must be a named" + ) +}) + +test_that("add_hierarchical_zero_rows() output remains a valid ARD", { + ard <- make_ard() + out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + expect_no_error(sort_ard_hierarchical(out)) +}) From 339dc9c92f88fae602e1a008b4804d1d4a1aa255 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Mon, 24 Aug 2026 15:18:27 +0000 Subject: [PATCH 02/10] Add top-level-only example to add_hierarchical_zero_rows() --- R/add_hierarchical_zero_rows.R | 14 +++++++++++++- man/add_hierarchical_zero_rows.Rd | 14 +++++++++++++- 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/R/add_hierarchical_zero_rows.R b/R/add_hierarchical_zero_rows.R index fe7253227..328529a3b 100644 --- a/R/add_hierarchical_zero_rows.R +++ b/R/add_hierarchical_zero_rows.R @@ -62,7 +62,19 @@ #' denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) #' ) #' -#' # add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +#' # top level only: add the unobserved SOC "Vascular" as a zero-row. +#' # each parent maps to `character(0)` because no child rows are needed. +#' ard |> +#' add_hierarchical_zero_rows( +#' variables = c(SOC, PT), +#' mapping = list( +#' Cardiac = character(0), +#' GI = character(0), +#' Vascular = character(0) +#' ) +#' ) +#' +#' # nested: add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" #' ard |> #' add_hierarchical_zero_rows( #' variables = c(SOC, PT), diff --git a/man/add_hierarchical_zero_rows.Rd b/man/add_hierarchical_zero_rows.Rd index b4736629d..614a7c5c5 100644 --- a/man/add_hierarchical_zero_rows.Rd +++ b/man/add_hierarchical_zero_rows.Rd @@ -80,7 +80,19 @@ ard <- ard_stack_hierarchical( denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) ) -# add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +# top level only: add the unobserved SOC "Vascular" as a zero-row. +# each parent maps to `character(0)` because no child rows are needed. +ard |> + add_hierarchical_zero_rows( + variables = c(SOC, PT), + mapping = list( + Cardiac = character(0), + GI = character(0), + Vascular = character(0) + ) + ) + +# nested: add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" ard |> add_hierarchical_zero_rows( variables = c(SOC, PT), From c2f770d363b8a989729703235dd141609bd70744 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Tue, 25 Aug 2026 09:11:19 +0000 Subject: [PATCH 03/10] Simplify add_hierarchical_zero_rows() to a variables-driven API Read the expected level universe from the factor levels the ARD already carries, so top-level and nested completion need only `variables`. `mapping` becomes optional and additive, used only for children of an unobserved parent or a bespoke universe that factor levels cannot express. --- NAMESPACE | 1 + R/add_hierarchical_zero_rows.R | 111 ++++++++++++------ man/add_hierarchical_zero_rows.Rd | 63 +++++----- .../test-add_hierarchical_zero_rows.R | 57 ++++++--- 4 files changed, 146 insertions(+), 86 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d5c5c5ed3..437a50106 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ S3method(process_selectors,data.frame) S3method(tibble::tbl_sum,card) export("%>%") export(add_calculated_row) +export(add_hierarchical_zero_rows) export(alias_as_fmt_fn) export(alias_as_fmt_fun) export(all_ard_group_n) diff --git a/R/add_hierarchical_zero_rows.R b/R/add_hierarchical_zero_rows.R index 328529a3b..363035c43 100644 --- a/R/add_hierarchical_zero_rows.R +++ b/R/add_hierarchical_zero_rows.R @@ -8,17 +8,20 @@ #' categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore #' disappear from the ARD instead of appearing with a count of zero. #' -#' `add_hierarchical_zero_rows()` restores those rows. A single `mapping` -#' argument describes the expected universe of levels and covers both scenarios -#' that arise in practice: +#' `add_hierarchical_zero_rows()` restores those rows. The expected universe of +#' levels is read from the factor `levels()` that the ARD already carries, so the +#' common cases need nothing beyond `variables`: #' -#' - a **top-level** category that is never observed (e.g. an SOC with no events), +#' - a **top-level** category that is never observed (e.g. an SOC with no events) +#' is recovered from the top variable's factor levels, #' - a **nested** child that is never observed under an otherwise present parent -#' (e.g. a preferred term with no events within an observed SOC). +#' (e.g. a preferred term with no events within an observed SOC) is recovered +#' from the child variable's factor levels. #' -#' A nested child has no unambiguous parent when it is absent, so the expected -#' parent/child structure must be supplied explicitly through `mapping` rather -#' than inferred from factor levels. +#' `mapping` is optional and only needed when factor levels cannot express the +#' expected structure: children of an *unobserved* parent (there is no basis in +#' the factor levels to know which children belong under it), or a bespoke +#' parent/child universe that differs from the data's factor levels. #' #' @param x (`card`)\cr #' a stacked hierarchical ARD of class `'card'` created with @@ -26,8 +29,12 @@ #' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' the hierarchical variables used to create `x`, in the same order. The first #' variable is the top level; the second, when present, is the nested child. +#' Pass a single variable (e.g. `variables = SOC`) to complete the top level +#' only. #' @param mapping (named `list` or `data.frame`)\cr -#' the expected universe of levels. Either +#' optional. The expected universe of levels, used only when factor levels are +#' insufficient (children of an unobserved parent, or a custom universe). +#' Either #' - a **named list** mapping each parent level to a character vector of its #' expected child levels, e.g. #' `list("SOC A" = c("PT1", "PT2"), "SOC B" = "PT3")`, or @@ -36,8 +43,8 @@ #' valid parent/child combination. #' #' Parents present in `mapping` but absent from `x` are added as top-level -#' zero-rows together with their mapped children. Children present in `mapping` -#' but absent under an observed parent are added as nested zero-rows. +#' zero-rows together with their mapped children. When `mapping` is `NULL` +#' (default) the expected levels come from the ARD's factor levels. #' @param statistic (`character`)\cr #' the statistics to set to zero on the added rows. Statistics not listed are #' carried over from a matching observed row (so denominators such as `N` @@ -51,8 +58,8 @@ #' set.seed(1) #' adae <- data.frame( #' USUBJID = sprintf("S%03d", 1:20), -#' SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), -#' PT = sample(c("PT1", "PT2"), 20, TRUE) +#' SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), +#' PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) #' ) #' #' ard <- ard_stack_hierarchical( @@ -62,27 +69,21 @@ #' denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) #' ) #' -#' # top level only: add the unobserved SOC "Vascular" as a zero-row. -#' # each parent maps to `character(0)` because no child rows are needed. +#' # top level only: recover the unobserved SOC "Vascular" from its factor levels #' ard |> -#' add_hierarchical_zero_rows( -#' variables = c(SOC, PT), -#' mapping = list( -#' Cardiac = character(0), -#' GI = character(0), -#' Vascular = character(0) -#' ) -#' ) +#' add_hierarchical_zero_rows(variables = SOC) +#' +#' # nested: also fill the missing PT ("PT3") under each observed SOC, +#' # all from the variables' factor levels -- no `mapping` needed +#' ard |> +#' add_hierarchical_zero_rows(variables = c(SOC, PT)) #' -#' # nested: add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +#' # `mapping` for a case factor levels cannot express: children of the +#' # unobserved parent "Vascular" #' ard |> #' add_hierarchical_zero_rows( #' variables = c(SOC, PT), -#' mapping = list( -#' Cardiac = c("PT1", "PT2", "PT3"), -#' GI = c("PT1", "PT2"), -#' Vascular = "PTX" -#' ) +#' mapping = list(Vascular = c("PTX", "PTY")) #' ) NULL @@ -90,14 +91,13 @@ NULL #' @export add_hierarchical_zero_rows <- function(x, variables, - mapping, + mapping = NULL, statistic = c("n", "p", "n_cum", "p_cum")) { set_cli_abort_call() # process inputs ------------------------------------------------------------- check_not_missing(x) check_not_missing(variables) - check_not_missing(mapping) check_class(x, "card") check_class(x, "ard_stack_hierarchical") if (!is.character(statistic)) { @@ -115,9 +115,9 @@ add_hierarchical_zero_rows <- function(x, ) process_selectors(scaffold, variables = {{ variables }}) - if (!is.list(mapping) && !is.data.frame(mapping)) { + if (!is.null(mapping) && !is.list(mapping) && !is.data.frame(mapping)) { cli::cli_abort( - "The {.arg mapping} argument must be a named {.cls list} or a {.cls data.frame}.", + "The {.arg mapping} argument must be {.code NULL}, a named {.cls list}, or a {.cls data.frame}.", call = get_cli_abort_call() ) } @@ -137,6 +137,18 @@ add_hierarchical_zero_rows <- function(x, ) } + # helper: the factor levels stored in a list-column, if any. The ARD keeps the + # full factor (including unobserved levels) inside each list element, so the + # expected universe can be recovered without the original data. + level_universe <- function(col) { + for (z in col) { + if (is.factor(z)) { + return(levels(z)) + } + } + NULL + } + # the hierarchical parent of a nested variable is stored in the last populated # `groupN` column: without a `by` the top variable has no group columns and the # child's parent is `group1`; with a `by` the arm occupies `group1` and the @@ -173,11 +185,25 @@ add_hierarchical_zero_rows <- function(x, template } - # observed top-level values and the expected universe from `mapping` + # observed top-level values and the expected universe. Without a `mapping` the + # universe is the top variable's factor levels stored in the ARD; a `mapping` + # overrides that (and can introduce parents the factor levels do not contain). observed_top <- unique(level_chr(x[["variable_level"]][x[["variable"]] == top_var])) - expected_top <- .zero_rows_expected_top(mapping, top_var) + top_factor_levels <- level_universe(x[["variable_level"]][x[["variable"]] == top_var]) + expected_top <- if (is.null(mapping)) { + top_factor_levels %||% observed_top + } else { + union(.zero_rows_expected_top(mapping, top_var), observed_top) + } missing_top <- setdiff(expected_top, observed_top) + # child factor levels stored in the ARD, used when `mapping` is NULL + child_factor_levels <- if (!is.na(child_var)) { + level_universe(child_rows[["variable_level"]]) + } else { + NULL + } + # blueprint rows carry the correct stat structure (n/N/p, by-groups, fmt_fun). # one blueprint per `by`-group is preserved by taking all rows of one level. blueprint_top <- x[x[["variable"]] == top_var & level_chr(x[["variable_level"]]) == observed_top[1L], ] @@ -198,20 +224,27 @@ add_hierarchical_zero_rows <- function(x, new_blocks <- list() - # top-level completion plus the children of any missing parent + # top-level completion plus the children of any missing parent. Without a + # `mapping`, factor levels cannot say which children belong under an unobserved + # parent, so such a parent is added at the top level only. for (lvl in missing_top) { new_blocks <- c(new_blocks, list(build_block(blueprint_top, NULL, top_var, lvl))) - if (!is.na(child_var)) { + if (!is.na(child_var) && !is.null(mapping)) { for (kid in .zero_rows_children(mapping, lvl, top_var, child_var)) { new_blocks <- c(new_blocks, list(build_block(blueprint_child, lvl, child_var, kid))) } } } - # nested completion: observed parent, unobserved child + # nested completion: observed parent, unobserved child. Expected children come + # from `mapping` when supplied, otherwise from the child's factor levels. if (!is.na(child_var) && !is.na(parent_level_col)) { for (parent in observed_top) { - expected_kids <- .zero_rows_children(mapping, parent, top_var, child_var) + expected_kids <- if (is.null(mapping)) { + child_factor_levels %||% character(0L) + } else { + .zero_rows_children(mapping, parent, top_var, child_var) + } observed_kids <- unique(level_chr( child_rows[["variable_level"]][level_chr(child_rows[[parent_level_col]]) == parent] )) diff --git a/man/add_hierarchical_zero_rows.Rd b/man/add_hierarchical_zero_rows.Rd index 614a7c5c5..4ab778044 100644 --- a/man/add_hierarchical_zero_rows.Rd +++ b/man/add_hierarchical_zero_rows.Rd @@ -7,7 +7,7 @@ add_hierarchical_zero_rows( x, variables, - mapping, + mapping = NULL, statistic = c("n", "p", "n_cum", "p_cum") ) } @@ -18,10 +18,14 @@ a stacked hierarchical ARD of class \code{'card'} created with \item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr the hierarchical variables used to create \code{x}, in the same order. The first -variable is the top level; the second, when present, is the nested child.} +variable is the top level; the second, when present, is the nested child. +Pass a single variable (e.g. \code{variables = SOC}) to complete the top level +only.} \item{mapping}{(named \code{list} or \code{data.frame})\cr -the expected universe of levels. Either +optional. The expected universe of levels, used only when factor levels are +insufficient (children of an unobserved parent, or a custom universe). +Either \itemize{ \item a \strong{named list} mapping each parent level to a character vector of its expected child levels, e.g. @@ -32,8 +36,8 @@ valid parent/child combination. } Parents present in \code{mapping} but absent from \code{x} are added as top-level -zero-rows together with their mapped children. Children present in \code{mapping} -but absent under an observed parent are added as nested zero-rows.} +zero-rows together with their mapped children. When \code{mapping} is \code{NULL} +(default) the expected levels come from the ARD's factor levels.} \item{statistic}{(\code{character})\cr the statistics to set to zero on the added rows. Statistics not listed are @@ -52,25 +56,28 @@ through the \code{strata} (observed-only) branch of the engine. Predefined categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore disappear from the ARD instead of appearing with a count of zero. -\code{add_hierarchical_zero_rows()} restores those rows. A single \code{mapping} -argument describes the expected universe of levels and covers both scenarios -that arise in practice: +\code{add_hierarchical_zero_rows()} restores those rows. The expected universe of +levels is read from the factor \code{levels()} that the ARD already carries, so the +common cases need nothing beyond \code{variables}: \itemize{ -\item a \strong{top-level} category that is never observed (e.g. an SOC with no events), +\item a \strong{top-level} category that is never observed (e.g. an SOC with no events) +is recovered from the top variable's factor levels, \item a \strong{nested} child that is never observed under an otherwise present parent -(e.g. a preferred term with no events within an observed SOC). +(e.g. a preferred term with no events within an observed SOC) is recovered +from the child variable's factor levels. } -A nested child has no unambiguous parent when it is absent, so the expected -parent/child structure must be supplied explicitly through \code{mapping} rather -than inferred from factor levels. +\code{mapping} is optional and only needed when factor levels cannot express the +expected structure: children of an \emph{unobserved} parent (there is no basis in +the factor levels to know which children belong under it), or a bespoke +parent/child universe that differs from the data's factor levels. } \examples{ set.seed(1) adae <- data.frame( USUBJID = sprintf("S\%03d", 1:20), - SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), - PT = sample(c("PT1", "PT2"), 20, TRUE) + SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), + PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) ) ard <- ard_stack_hierarchical( @@ -80,27 +87,21 @@ ard <- ard_stack_hierarchical( denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) ) -# top level only: add the unobserved SOC "Vascular" as a zero-row. -# each parent maps to `character(0)` because no child rows are needed. +# top level only: recover the unobserved SOC "Vascular" from its factor levels ard |> - add_hierarchical_zero_rows( - variables = c(SOC, PT), - mapping = list( - Cardiac = character(0), - GI = character(0), - Vascular = character(0) - ) - ) + add_hierarchical_zero_rows(variables = SOC) + +# nested: also fill the missing PT ("PT3") under each observed SOC, +# all from the variables' factor levels -- no `mapping` needed +ard |> + add_hierarchical_zero_rows(variables = c(SOC, PT)) -# nested: add an unobserved SOC ("Vascular") and an unobserved PT under "Cardiac" +# `mapping` for a case factor levels cannot express: children of the +# unobserved parent "Vascular" ard |> add_hierarchical_zero_rows( variables = c(SOC, PT), - mapping = list( - Cardiac = c("PT1", "PT2", "PT3"), - GI = c("PT1", "PT2"), - Vascular = "PTX" - ) + mapping = list(Vascular = c("PTX", "PTY")) ) } \seealso{ diff --git a/tests/testthat/test-add_hierarchical_zero_rows.R b/tests/testthat/test-add_hierarchical_zero_rows.R index 33431f3fd..302afe738 100644 --- a/tests/testthat/test-add_hierarchical_zero_rows.R +++ b/tests/testthat/test-add_hierarchical_zero_rows.R @@ -1,13 +1,14 @@ skip_on_cran() # a small hierarchical ARD where "Vascular" is a declared but unobserved SOC and -# each SOC has a known preferred-term universe +# "PT3" is a declared but unobserved preferred term. Both are carried as factor +# levels so the expected universe is recoverable from the ARD alone. make_ard <- function(by = FALSE) { set.seed(1) adae <- data.frame( USUBJID = sprintf("S%03d", 1:20), - SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), - PT = sample(c("PT1", "PT2"), 20, TRUE), + SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), + PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")), TRT = factor(rep(c("A", "B"), 10)) ) denom <- data.frame(USUBJID = sprintf("S%03d", 1:30), TRT = factor(rep(c("A", "B"), 15))) @@ -26,19 +27,17 @@ lvl1 <- function(col) { }, character(1L)) } -test_that("add_hierarchical_zero_rows() adds a missing top-level category", { +test_that("add_hierarchical_zero_rows(variables = SOC) completes the top level from factor levels", { ard <- make_ard() - out <- add_hierarchical_zero_rows( - ard, - variables = c(SOC, PT), - mapping = list(Cardiac = c("PT1", "PT2"), GI = c("PT1", "PT2"), Vascular = character(0)) - ) + out <- add_hierarchical_zero_rows(ard, variables = SOC) expect_s3_class(out, "ard_stack_hierarchical") expect_setequal( unique(lvl1(out$variable_level[out$variable == "SOC"])), c("Cardiac", "GI", "Vascular") ) + # top-level only: no PT rows are invented under the unobserved parent + expect_false(any(lvl1(out$group1_level[out$variable == "PT"]) == "Vascular")) # the added row has n = 0 and carries a real denominator N expect_equal( out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n"][[1L]], @@ -50,6 +49,25 @@ test_that("add_hierarchical_zero_rows() adds a missing top-level category", { ) }) +test_that("add_hierarchical_zero_rows(variables = c(SOC, PT)) completes nested levels from factor levels", { + ard <- make_ard() + out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT)) + + # top level recovered + expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) + # the unobserved PT3 is filled under each observed parent from PT's factor levels + for (parent in c("Cardiac", "GI")) { + expect_true( + "PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == parent]) + ) + } + # no children invented under the unobserved parent without a mapping + expect_length( + unique(lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"])), + 0L + ) +}) + test_that("add_hierarchical_zero_rows() adds children of a missing parent", { ard <- make_ard() out <- add_hierarchical_zero_rows( @@ -113,24 +131,31 @@ test_that("add_hierarchical_zero_rows() preserves the by structure", { }) test_that("add_hierarchical_zero_rows() is a no-op when nothing is missing", { - ard <- make_ard() - out <- add_hierarchical_zero_rows( - ard, - variables = c(SOC, PT), - mapping = list(Cardiac = c("PT1", "PT2"), GI = c("PT1", "PT2")) + # an ARD whose factor levels are all observed leaves the input untouched + set.seed(1) + adae <- data.frame( + USUBJID = sprintf("S%03d", 1:20), + SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), + PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2")) + ) + ard <- ard_stack_hierarchical( + adae, + variables = c(SOC, PT), id = USUBJID, + denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) ) + out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT)) expect_equal(nrow(out), nrow(ard)) }) test_that("add_hierarchical_zero_rows() input checks", { ard <- make_ard() expect_error( - add_hierarchical_zero_rows(data.frame(a = 1), variables = a, mapping = list()), + add_hierarchical_zero_rows(data.frame(a = 1), variables = a), class = "check_class" ) expect_error( add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = "not a mapping"), - "must be a named" + "must be" ) }) From c8c420926085731eedf168228dc08ee4a1302590 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Tue, 25 Aug 2026 09:26:53 +0000 Subject: [PATCH 04/10] Address review: rename to add_hierarchical_unobserved_levels(), simplify Rename the function (and its file/tests/docs) to add_hierarchical_unobserved_levels(), matching the intent of adding unobserved factor levels rather than raw zero-rows. Drop the user-facing `statistic` argument; the count-style stats are zeroed internally while denominators carry over, so callers no longer manage that detail. Rewrite the documentation to lead with the single-variable case and cross-link gtsummary::tbl_hierarchical() so users can discover it. --- NAMESPACE | 2 +- NEWS.md | 2 +- ...R => add_hierarchical_unobserved_levels.R} | 112 +++++++----------- man/add_hierarchical_unobserved_levels.Rd | 73 ++++++++++++ man/add_hierarchical_zero_rows.Rd | 109 ----------------- ...test-add_hierarchical_unobserved_levels.R} | 38 +++--- 6 files changed, 134 insertions(+), 202 deletions(-) rename R/{add_hierarchical_zero_rows.R => add_hierarchical_unobserved_levels.R} (65%) create mode 100644 man/add_hierarchical_unobserved_levels.Rd delete mode 100644 man/add_hierarchical_zero_rows.Rd rename tests/testthat/{test-add_hierarchical_zero_rows.R => test-add_hierarchical_unobserved_levels.R} (75%) diff --git a/NAMESPACE b/NAMESPACE index 437a50106..754fff04c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,7 @@ S3method(process_selectors,data.frame) S3method(tibble::tbl_sum,card) export("%>%") export(add_calculated_row) -export(add_hierarchical_zero_rows) +export(add_hierarchical_unobserved_levels) export(alias_as_fmt_fn) export(alias_as_fmt_fun) export(all_ard_group_n) diff --git a/NEWS.md b/NEWS.md index b50a0296a..88cc7b4a7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # cards 0.9.0.9000 -* Added `add_hierarchical_zero_rows()` to append zero-count rows for unobserved hierarchical levels (top-level categories and nested children) to a stacked hierarchical ARD, using a `mapping` of the expected level universe. (#602) +* Added `add_hierarchical_unobserved_levels()` to add zero-count rows for unobserved levels (top-level categories and nested children) to a stacked hierarchical ARD. Expected levels are read from the variables' factor levels. (#602) # cards 0.9.0 diff --git a/R/add_hierarchical_zero_rows.R b/R/add_hierarchical_unobserved_levels.R similarity index 65% rename from R/add_hierarchical_zero_rows.R rename to R/add_hierarchical_unobserved_levels.R index 363035c43..47c94a509 100644 --- a/R/add_hierarchical_zero_rows.R +++ b/R/add_hierarchical_unobserved_levels.R @@ -1,98 +1,72 @@ -#' Add Zero-Count Rows for Unobserved Hierarchical Levels +#' Add Unobserved Levels to Hierarchical ARDs #' #' @description `r lifecycle::badge('experimental')`\cr #' -#' Stacked hierarchical ARDs created with [ard_stack_hierarchical()] include only -#' the levels observed in the data, because the underlying tabulation routes -#' through the `strata` (observed-only) branch of the engine. Predefined -#' categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore -#' disappear from the ARD instead of appearing with a count of zero. +#' A stacked hierarchical ARD keeps only the levels seen in the data, so a +#' category that never occurs (an SOC with no events, a preferred term absent +#' under an observed SOC, an unused grade) simply drops out instead of showing +#' up with a count of zero. #' -#' `add_hierarchical_zero_rows()` restores those rows. The expected universe of -#' levels is read from the factor `levels()` that the ARD already carries, so the -#' common cases need nothing beyond `variables`: -#' -#' - a **top-level** category that is never observed (e.g. an SOC with no events) -#' is recovered from the top variable's factor levels, -#' - a **nested** child that is never observed under an otherwise present parent -#' (e.g. a preferred term with no events within an observed SOC) is recovered -#' from the child variable's factor levels. -#' -#' `mapping` is optional and only needed when factor levels cannot express the -#' expected structure: children of an *unobserved* parent (there is no basis in -#' the factor levels to know which children belong under it), or a bespoke -#' parent/child universe that differs from the data's factor levels. +#' `add_hierarchical_unobserved_levels()` puts those rows back. Name the +#' hierarchical variable(s) to complete and the missing levels are added with a +#' count of zero. The expected levels are taken from the variable's factor +#' `levels()`, which the ARD already stores, so no reference data is needed. #' #' @param x (`card`)\cr -#' a stacked hierarchical ARD of class `'card'` created with -#' [ard_stack_hierarchical()] or [ard_stack_hierarchical_count()]. +#' a stacked hierarchical ARD created with [ard_stack_hierarchical()]. #' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' the hierarchical variables used to create `x`, in the same order. The first -#' variable is the top level; the second, when present, is the nested child. -#' Pass a single variable (e.g. `variables = SOC`) to complete the top level -#' only. +#' hierarchical variable(s) to complete, in hierarchy order. Use a single +#' variable (e.g. `variables = AESOC`) to complete the top level, or the full +#' set (e.g. `variables = c(AESOC, AEDECOD)`) to also fill missing children +#' under each observed parent. #' @param mapping (named `list` or `data.frame`)\cr -#' optional. The expected universe of levels, used only when factor levels are -#' insufficient (children of an unobserved parent, or a custom universe). -#' Either -#' - a **named list** mapping each parent level to a character vector of its -#' expected child levels, e.g. -#' `list("SOC A" = c("PT1", "PT2"), "SOC B" = "PT3")`, or -#' - a **two-column data frame** whose columns are named after the first two -#' `variables`, e.g. `data.frame(AESOC = ..., AEDECOD = ...)`, listing every -#' valid parent/child combination. +#' optional. Only needed to add children under a parent that is itself +#' unobserved -- factor levels cannot say which children belong there. Supply +#' either a named list, `list("SOC A" = c("PT1", "PT2"))`, or a two-column data +#' frame whose columns are named after the parent and child variables. #' -#' Parents present in `mapping` but absent from `x` are added as top-level -#' zero-rows together with their mapped children. When `mapping` is `NULL` -#' (default) the expected levels come from the ARD's factor levels. -#' @param statistic (`character`)\cr -#' the statistics to set to zero on the added rows. Statistics not listed are -#' carried over from a matching observed row (so denominators such as `N` -#' remain correct). Defaults to `c("n", "p", "n_cum", "p_cum")`. -#' -#' @return an ARD data frame of class 'card' -#' @seealso [ard_stack_hierarchical()], [sort_ard_hierarchical()] -#' @name add_hierarchical_zero_rows +#' @return a stacked hierarchical ARD +#' @seealso [gtsummary::tbl_hierarchical()], [ard_stack_hierarchical()], [sort_ard_hierarchical()] +#' @name add_hierarchical_unobserved_levels #' #' @examples #' set.seed(1) #' adae <- data.frame( #' USUBJID = sprintf("S%03d", 1:20), -#' SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), -#' PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) +#' AESOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), +#' AEDECOD = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) #' ) #' #' ard <- ard_stack_hierarchical( #' adae, -#' variables = c(SOC, PT), +#' variables = c(AESOC, AEDECOD), #' id = USUBJID, #' denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) #' ) #' -#' # top level only: recover the unobserved SOC "Vascular" from its factor levels +#' # complete the top level: the unobserved SOC "Vascular" is added as a zero-row #' ard |> -#' add_hierarchical_zero_rows(variables = SOC) +#' add_hierarchical_unobserved_levels(variables = AESOC) #' -#' # nested: also fill the missing PT ("PT3") under each observed SOC, -#' # all from the variables' factor levels -- no `mapping` needed +#' # complete both levels: also fill the missing PT ("PT3") under each observed SOC #' ard |> -#' add_hierarchical_zero_rows(variables = c(SOC, PT)) +#' add_hierarchical_unobserved_levels(variables = c(AESOC, AEDECOD)) #' -#' # `mapping` for a case factor levels cannot express: children of the -#' # unobserved parent "Vascular" +#' # `mapping` names the children to add under the unobserved parent "Vascular" #' ard |> -#' add_hierarchical_zero_rows( -#' variables = c(SOC, PT), -#' mapping = list(Vascular = c("PTX", "PTY")) +#' add_hierarchical_unobserved_levels( +#' variables = c(AESOC, AEDECOD), +#' mapping = list(Vascular = c("PT1", "PT2")) #' ) NULL -#' @rdname add_hierarchical_zero_rows +# statistics zeroed on an added level (the count-style stats; a denominator such +# as `N` is carried over from an observed row so proportions stay well defined) +.hierarchical_zero_stats <- c("n", "p", "n_cum", "p_cum") + +#' @rdname add_hierarchical_unobserved_levels #' @export -add_hierarchical_zero_rows <- function(x, - variables, - mapping = NULL, - statistic = c("n", "p", "n_cum", "p_cum")) { +add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { set_cli_abort_call() # process inputs ------------------------------------------------------------- @@ -100,12 +74,6 @@ add_hierarchical_zero_rows <- function(x, check_not_missing(variables) check_class(x, "card") check_class(x, "ard_stack_hierarchical") - if (!is.character(statistic)) { - cli::cli_abort( - "The {.arg statistic} argument must be a {.cls character} vector.", - call = get_cli_abort_call() - ) - } # `variables` is tidy-selected against the ARD's own variable column so the # helper accepts the same style of input as ard_stack_hierarchical() @@ -167,7 +135,7 @@ add_hierarchical_zero_rows <- function(x, parent_level_col <- if (!is.na(parent_group_col)) paste0(parent_group_col, "_level") else NA_character_ # build a zero-row block from an observed template, overriding the variable and - # its level, optionally setting the hierarchical parent, and zeroing statistics + # its level, optionally setting the hierarchical parent, and zeroing counts build_block <- function(template, parent_level, variable, level) { if (nrow(template) == 0L) { return(template) @@ -178,7 +146,7 @@ add_hierarchical_zero_rows <- function(x, template[[parent_group_col]] <- top_var template[[parent_level_col]] <- rep(list(parent_level), nrow(template)) } - is_zero <- template[["stat_name"]] %in% statistic + is_zero <- template[["stat_name"]] %in% .hierarchical_zero_stats template[["stat"]][is_zero] <- as.list(rep(0, sum(is_zero))) if ("warning" %in% names(template)) template[["warning"]] <- rep(list(NULL), nrow(template)) if ("error" %in% names(template)) template[["error"]] <- rep(list(NULL), nrow(template)) diff --git a/man/add_hierarchical_unobserved_levels.Rd b/man/add_hierarchical_unobserved_levels.Rd new file mode 100644 index 000000000..36c33f2fe --- /dev/null +++ b/man/add_hierarchical_unobserved_levels.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_hierarchical_unobserved_levels.R +\name{add_hierarchical_unobserved_levels} +\alias{add_hierarchical_unobserved_levels} +\title{Add Unobserved Levels to Hierarchical ARDs} +\usage{ +add_hierarchical_unobserved_levels(x, variables, mapping = NULL) +} +\arguments{ +\item{x}{(\code{card})\cr +a stacked hierarchical ARD created with \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +hierarchical variable(s) to complete, in hierarchy order. Use a single +variable (e.g. \code{variables = AESOC}) to complete the top level, or the full +set (e.g. \code{variables = c(AESOC, AEDECOD)}) to also fill missing children +under each observed parent.} + +\item{mapping}{(named \code{list} or \code{data.frame})\cr +optional. Only needed to add children under a parent that is itself +unobserved -- factor levels cannot say which children belong there. Supply +either a named list, \code{list("SOC A" = c("PT1", "PT2"))}, or a two-column data +frame whose columns are named after the parent and child variables.} +} +\value{ +a stacked hierarchical ARD +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}\cr + +A stacked hierarchical ARD keeps only the levels seen in the data, so a +category that never occurs (an SOC with no events, a preferred term absent +under an observed SOC, an unused grade) simply drops out instead of showing +up with a count of zero. + +\code{add_hierarchical_unobserved_levels()} puts those rows back. Name the +hierarchical variable(s) to complete and the missing levels are added with a +count of zero. The expected levels are taken from the variable's factor +\code{levels()}, which the ARD already stores, so no reference data is needed. +} +\examples{ +set.seed(1) +adae <- data.frame( + USUBJID = sprintf("S\%03d", 1:20), + AESOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), + AEDECOD = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) +) + +ard <- ard_stack_hierarchical( + adae, + variables = c(AESOC, AEDECOD), + id = USUBJID, + denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) +) + +# complete the top level: the unobserved SOC "Vascular" is added as a zero-row +ard |> + add_hierarchical_unobserved_levels(variables = AESOC) + +# complete both levels: also fill the missing PT ("PT3") under each observed SOC +ard |> + add_hierarchical_unobserved_levels(variables = c(AESOC, AEDECOD)) + +# `mapping` names the children to add under the unobserved parent "Vascular" +ard |> + add_hierarchical_unobserved_levels( + variables = c(AESOC, AEDECOD), + mapping = list(Vascular = c("PT1", "PT2")) + ) +} +\seealso{ +\code{\link[gtsummary:tbl_hierarchical]{gtsummary::tbl_hierarchical()}}, \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}, \code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} +} diff --git a/man/add_hierarchical_zero_rows.Rd b/man/add_hierarchical_zero_rows.Rd deleted file mode 100644 index 4ab778044..000000000 --- a/man/add_hierarchical_zero_rows.Rd +++ /dev/null @@ -1,109 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_hierarchical_zero_rows.R -\name{add_hierarchical_zero_rows} -\alias{add_hierarchical_zero_rows} -\title{Add Zero-Count Rows for Unobserved Hierarchical Levels} -\usage{ -add_hierarchical_zero_rows( - x, - variables, - mapping = NULL, - statistic = c("n", "p", "n_cum", "p_cum") -) -} -\arguments{ -\item{x}{(\code{card})\cr -a stacked hierarchical ARD of class \code{'card'} created with -\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} or \code{\link[=ard_stack_hierarchical_count]{ard_stack_hierarchical_count()}}.} - -\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -the hierarchical variables used to create \code{x}, in the same order. The first -variable is the top level; the second, when present, is the nested child. -Pass a single variable (e.g. \code{variables = SOC}) to complete the top level -only.} - -\item{mapping}{(named \code{list} or \code{data.frame})\cr -optional. The expected universe of levels, used only when factor levels are -insufficient (children of an unobserved parent, or a custom universe). -Either -\itemize{ -\item a \strong{named list} mapping each parent level to a character vector of its -expected child levels, e.g. -\code{list("SOC A" = c("PT1", "PT2"), "SOC B" = "PT3")}, or -\item a \strong{two-column data frame} whose columns are named after the first two -\code{variables}, e.g. \code{data.frame(AESOC = ..., AEDECOD = ...)}, listing every -valid parent/child combination. -} - -Parents present in \code{mapping} but absent from \code{x} are added as top-level -zero-rows together with their mapped children. When \code{mapping} is \code{NULL} -(default) the expected levels come from the ARD's factor levels.} - -\item{statistic}{(\code{character})\cr -the statistics to set to zero on the added rows. Statistics not listed are -carried over from a matching observed row (so denominators such as \code{N} -remain correct). Defaults to \code{c("n", "p", "n_cum", "p_cum")}.} -} -\value{ -an ARD data frame of class 'card' -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}\cr - -Stacked hierarchical ARDs created with \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} include only -the levels observed in the data, because the underlying tabulation routes -through the \code{strata} (observed-only) branch of the engine. Predefined -categories -- SMQ/CQ baskets, SOCs, preferred terms, grade scales -- therefore -disappear from the ARD instead of appearing with a count of zero. - -\code{add_hierarchical_zero_rows()} restores those rows. The expected universe of -levels is read from the factor \code{levels()} that the ARD already carries, so the -common cases need nothing beyond \code{variables}: -\itemize{ -\item a \strong{top-level} category that is never observed (e.g. an SOC with no events) -is recovered from the top variable's factor levels, -\item a \strong{nested} child that is never observed under an otherwise present parent -(e.g. a preferred term with no events within an observed SOC) is recovered -from the child variable's factor levels. -} - -\code{mapping} is optional and only needed when factor levels cannot express the -expected structure: children of an \emph{unobserved} parent (there is no basis in -the factor levels to know which children belong under it), or a bespoke -parent/child universe that differs from the data's factor levels. -} -\examples{ -set.seed(1) -adae <- data.frame( - USUBJID = sprintf("S\%03d", 1:20), - SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), - PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) -) - -ard <- ard_stack_hierarchical( - adae, - variables = c(SOC, PT), - id = USUBJID, - denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) -) - -# top level only: recover the unobserved SOC "Vascular" from its factor levels -ard |> - add_hierarchical_zero_rows(variables = SOC) - -# nested: also fill the missing PT ("PT3") under each observed SOC, -# all from the variables' factor levels -- no `mapping` needed -ard |> - add_hierarchical_zero_rows(variables = c(SOC, PT)) - -# `mapping` for a case factor levels cannot express: children of the -# unobserved parent "Vascular" -ard |> - add_hierarchical_zero_rows( - variables = c(SOC, PT), - mapping = list(Vascular = c("PTX", "PTY")) - ) -} -\seealso{ -\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}, \code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} -} diff --git a/tests/testthat/test-add_hierarchical_zero_rows.R b/tests/testthat/test-add_hierarchical_unobserved_levels.R similarity index 75% rename from tests/testthat/test-add_hierarchical_zero_rows.R rename to tests/testthat/test-add_hierarchical_unobserved_levels.R index 302afe738..6157b5c9d 100644 --- a/tests/testthat/test-add_hierarchical_zero_rows.R +++ b/tests/testthat/test-add_hierarchical_unobserved_levels.R @@ -27,9 +27,9 @@ lvl1 <- function(col) { }, character(1L)) } -test_that("add_hierarchical_zero_rows(variables = SOC) completes the top level from factor levels", { +test_that("add_hierarchical_unobserved_levels(variables = SOC) completes the top level from factor levels", { ard <- make_ard() - out <- add_hierarchical_zero_rows(ard, variables = SOC) + out <- add_hierarchical_unobserved_levels(ard, variables = SOC) expect_s3_class(out, "ard_stack_hierarchical") expect_setequal( @@ -49,9 +49,9 @@ test_that("add_hierarchical_zero_rows(variables = SOC) completes the top level f ) }) -test_that("add_hierarchical_zero_rows(variables = c(SOC, PT)) completes nested levels from factor levels", { +test_that("add_hierarchical_unobserved_levels(variables = c(SOC, PT)) completes nested levels from factor levels", { ard <- make_ard() - out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT)) + out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT)) # top level recovered expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) @@ -68,9 +68,9 @@ test_that("add_hierarchical_zero_rows(variables = c(SOC, PT)) completes nested l ) }) -test_that("add_hierarchical_zero_rows() adds children of a missing parent", { +test_that("add_hierarchical_unobserved_levels() adds children of a missing parent", { ard <- make_ard() - out <- add_hierarchical_zero_rows( + out <- add_hierarchical_unobserved_levels( ard, variables = c(SOC, PT), mapping = list(Vascular = c("PTX", "PTY")) @@ -83,9 +83,9 @@ test_that("add_hierarchical_zero_rows() adds children of a missing parent", { )) }) -test_that("add_hierarchical_zero_rows() adds a missing child of an observed parent", { +test_that("add_hierarchical_unobserved_levels() adds a missing child of an observed parent", { ard <- make_ard() - out <- add_hierarchical_zero_rows( + out <- add_hierarchical_unobserved_levels( ard, variables = c(SOC, PT), mapping = list(Cardiac = c("PT1", "PT2", "PT3")) @@ -99,13 +99,13 @@ test_that("add_hierarchical_zero_rows() adds a missing child of an observed pare ) }) -test_that("add_hierarchical_zero_rows() accepts a data.frame mapping", { +test_that("add_hierarchical_unobserved_levels() accepts a data.frame mapping", { ard <- make_ard() mapping <- data.frame( SOC = c("Vascular", "Vascular", "Cardiac"), PT = c("PTX", "PTY", "PT3") ) - out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = mapping) + out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = mapping) expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) expect_setequal( @@ -115,9 +115,9 @@ test_that("add_hierarchical_zero_rows() accepts a data.frame mapping", { expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) }) -test_that("add_hierarchical_zero_rows() preserves the by structure", { +test_that("add_hierarchical_unobserved_levels() preserves the by structure", { ard <- make_ard(by = TRUE) - out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) # one Vascular SOC row per by-group, with the arm retained in group1 vasc_soc <- out[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n", ] @@ -130,7 +130,7 @@ test_that("add_hierarchical_zero_rows() preserves the by structure", { expect_setequal(lvl1(vasc_pt$group2_level), c("Vascular")) }) -test_that("add_hierarchical_zero_rows() is a no-op when nothing is missing", { +test_that("add_hierarchical_unobserved_levels() is a no-op when nothing is missing", { # an ARD whose factor levels are all observed leaves the input untouched set.seed(1) adae <- data.frame( @@ -143,24 +143,24 @@ test_that("add_hierarchical_zero_rows() is a no-op when nothing is missing", { variables = c(SOC, PT), id = USUBJID, denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) ) - out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT)) + out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT)) expect_equal(nrow(out), nrow(ard)) }) -test_that("add_hierarchical_zero_rows() input checks", { +test_that("add_hierarchical_unobserved_levels() input checks", { ard <- make_ard() expect_error( - add_hierarchical_zero_rows(data.frame(a = 1), variables = a), + add_hierarchical_unobserved_levels(data.frame(a = 1), variables = a), class = "check_class" ) expect_error( - add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = "not a mapping"), + add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = "not a mapping"), "must be" ) }) -test_that("add_hierarchical_zero_rows() output remains a valid ARD", { +test_that("add_hierarchical_unobserved_levels() output remains a valid ARD", { ard <- make_ard() - out <- add_hierarchical_zero_rows(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) expect_no_error(sort_ard_hierarchical(out)) }) From 4e7285f7a565bf3793d1ab30bd17f199c384f086 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 26 Aug 2026 09:04:49 +0000 Subject: [PATCH 05/10] Leave proportions as NaN on added unobserved levels A never-observed level has no one at risk, so its proportion is 0 / 0 -- undefined, not zero. Set only the counts (n, n_cum) to zero and leave p/p_cum as NaN, letting the display layer recode them rather than asserting zero in the ARD. --- R/add_hierarchical_unobserved_levels.R | 17 ++++++++++++----- man/add_hierarchical_unobserved_levels.Rd | 7 +++++-- .../test-add_hierarchical_unobserved_levels.R | 4 ++++ 3 files changed, 21 insertions(+), 7 deletions(-) diff --git a/R/add_hierarchical_unobserved_levels.R b/R/add_hierarchical_unobserved_levels.R index 47c94a509..03764fbac 100644 --- a/R/add_hierarchical_unobserved_levels.R +++ b/R/add_hierarchical_unobserved_levels.R @@ -9,8 +9,11 @@ #' #' `add_hierarchical_unobserved_levels()` puts those rows back. Name the #' hierarchical variable(s) to complete and the missing levels are added with a -#' count of zero. The expected levels are taken from the variable's factor -#' `levels()`, which the ARD already stores, so no reference data is needed. +#' count of zero; proportions are left as `NaN`, since a never-observed level has +#' no one at risk (`0 / 0` is undefined) and should be recoded for display rather +#' than asserted as zero here. The expected levels are taken from the variable's +#' factor `levels()`, which the ARD already stores, so no reference data is +#' needed. #' #' @param x (`card`)\cr #' a stacked hierarchical ARD created with [ard_stack_hierarchical()]. @@ -60,9 +63,11 @@ #' ) NULL -# statistics zeroed on an added level (the count-style stats; a denominator such -# as `N` is carried over from an observed row so proportions stay well defined) -.hierarchical_zero_stats <- c("n", "p", "n_cum", "p_cum") +# count statistics set to zero on an added level. Proportions are left as `NaN` +# (a never-observed level has no one at risk, so `0 / 0` is undefined) and are +# recoded for display downstream rather than being asserted as zero here +.hierarchical_zero_stats <- c("n", "n_cum") +.hierarchical_nan_stats <- c("p", "p_cum") #' @rdname add_hierarchical_unobserved_levels #' @export @@ -148,6 +153,8 @@ add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { } is_zero <- template[["stat_name"]] %in% .hierarchical_zero_stats template[["stat"]][is_zero] <- as.list(rep(0, sum(is_zero))) + is_nan <- template[["stat_name"]] %in% .hierarchical_nan_stats + template[["stat"]][is_nan] <- as.list(rep(NaN, sum(is_nan))) if ("warning" %in% names(template)) template[["warning"]] <- rep(list(NULL), nrow(template)) if ("error" %in% names(template)) template[["error"]] <- rep(list(NULL), nrow(template)) template diff --git a/man/add_hierarchical_unobserved_levels.Rd b/man/add_hierarchical_unobserved_levels.Rd index 36c33f2fe..8c8555e22 100644 --- a/man/add_hierarchical_unobserved_levels.Rd +++ b/man/add_hierarchical_unobserved_levels.Rd @@ -35,8 +35,11 @@ up with a count of zero. \code{add_hierarchical_unobserved_levels()} puts those rows back. Name the hierarchical variable(s) to complete and the missing levels are added with a -count of zero. The expected levels are taken from the variable's factor -\code{levels()}, which the ARD already stores, so no reference data is needed. +count of zero; proportions are left as \code{NaN}, since a never-observed level has +no one at risk (\code{0 / 0} is undefined) and should be recoded for display rather +than asserted as zero here. The expected levels are taken from the variable's +factor \code{levels()}, which the ARD already stores, so no reference data is +needed. } \examples{ set.seed(1) diff --git a/tests/testthat/test-add_hierarchical_unobserved_levels.R b/tests/testthat/test-add_hierarchical_unobserved_levels.R index 6157b5c9d..77581f9bf 100644 --- a/tests/testthat/test-add_hierarchical_unobserved_levels.R +++ b/tests/testthat/test-add_hierarchical_unobserved_levels.R @@ -47,6 +47,10 @@ test_that("add_hierarchical_unobserved_levels(variables = SOC) completes the top out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "N"][[1L]], 30 ) + # proportion is left as NaN (0 / 0 is undefined), not asserted as zero + expect_true( + is.nan(out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "p"][[1L]]) + ) }) test_that("add_hierarchical_unobserved_levels(variables = c(SOC, PT)) completes nested levels from factor levels", { From 40f81945fdd9f868fbb6da4b92500663e855ed67 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Tue, 8 Sep 2026 14:44:25 +0000 Subject: [PATCH 06/10] Refactor add_hierarchical_unobserved_levels() to a data frame API Replace the factor-level reading and the named-list mapping with a single levels data frame whose columns are named after the hierarchical variables. This removes the positional matching, drops the reliance on factor levels, and treats every level of the hierarchy the same way: a newly added parent gets its full child set through the same code path as an observed parent. --- NEWS.md | 2 +- R/add_hierarchical_unobserved_levels.R | 171 ++++++------------ man/add_hierarchical_unobserved_levels.Rd | 52 +++--- .../test-add_hierarchical_unobserved_levels.R | 96 +++++----- 4 files changed, 130 insertions(+), 191 deletions(-) diff --git a/NEWS.md b/NEWS.md index 83d645716..4e8fd5d89 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,7 @@ * `compare_ard()` now compares the `columns` the two ARDs have in common, rather than throwing an error when the selection resolves to a different set in each. Comparing a formatted ARD against one that has not been formatted, for example, previously failed on the default `columns` because `apply_fmt_fun()` adds `stat_fmt`; the shared columns are now compared and a message reports those that were skipped. An error is still thrown when the two selections have nothing in common, and `keys` must still resolve to the same columns in both ARDs. (#606) -* Added `add_hierarchical_unobserved_levels()` to add zero-count rows for unobserved levels (top-level categories and nested children) to a stacked hierarchical ARD. Expected levels are read from the variables' factor levels. (#602) +* Added `add_hierarchical_unobserved_levels()` to add zero-count rows for unobserved levels (top-level categories and nested children) to a stacked hierarchical ARD. The expected level combinations are supplied as a data frame whose columns are named after the hierarchical variables. (#602, @Melkiades) # cards 0.9.0 diff --git a/R/add_hierarchical_unobserved_levels.R b/R/add_hierarchical_unobserved_levels.R index 03764fbac..ccb752177 100644 --- a/R/add_hierarchical_unobserved_levels.R +++ b/R/add_hierarchical_unobserved_levels.R @@ -7,26 +7,21 @@ #' under an observed SOC, an unused grade) simply drops out instead of showing #' up with a count of zero. #' -#' `add_hierarchical_unobserved_levels()` puts those rows back. Name the -#' hierarchical variable(s) to complete and the missing levels are added with a -#' count of zero; proportions are left as `NaN`, since a never-observed level has -#' no one at risk (`0 / 0` is undefined) and should be recoded for display rather -#' than asserted as zero here. The expected levels are taken from the variable's -#' factor `levels()`, which the ARD already stores, so no reference data is -#' needed. +#' `add_hierarchical_unobserved_levels()` puts those rows back. Supply a data +#' frame of the level combinations you expect to see, and any that are missing +#' are added with a count of zero; proportions are left as `NaN`, since a +#' never-observed level has no one at risk (`0 / 0` is undefined) and should be +#' recoded for display rather than asserted as zero here. #' #' @param x (`card`)\cr #' a stacked hierarchical ARD created with [ard_stack_hierarchical()]. -#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' hierarchical variable(s) to complete, in hierarchy order. Use a single -#' variable (e.g. `variables = AESOC`) to complete the top level, or the full -#' set (e.g. `variables = c(AESOC, AEDECOD)`) to also fill missing children -#' under each observed parent. -#' @param mapping (named `list` or `data.frame`)\cr -#' optional. Only needed to add children under a parent that is itself -#' unobserved -- factor levels cannot say which children belong there. Supply -#' either a named list, `list("SOC A" = c("PT1", "PT2"))`, or a two-column data -#' frame whose columns are named after the parent and child variables. +#' @param levels (`data.frame`)\cr +#' the expected level combinations. Its columns are named after the +#' hierarchical variables to complete, in hierarchy order (e.g. columns +#' `AESOC` and `AEDECOD`), matching the `variables`/`include` of the original +#' [ard_stack_hierarchical()] call. Each row is a combination that should be +#' present: any combination not already in `x` is added as a zero-count row. +#' Use a single column (e.g. just `AESOC`) to complete only the top level. #' #' @return a stacked hierarchical ARD #' @seealso [gtsummary::tbl_hierarchical()], [ard_stack_hierarchical()], [sort_ard_hierarchical()] @@ -36,8 +31,8 @@ #' set.seed(1) #' adae <- data.frame( #' USUBJID = sprintf("S%03d", 1:20), -#' AESOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), -#' AEDECOD = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) +#' AESOC = sample(c("Cardiac", "GI"), 20, TRUE), +#' AEDECOD = sample(c("PT1", "PT2"), 20, TRUE) #' ) #' #' ard <- ard_stack_hierarchical( @@ -49,17 +44,17 @@ #' #' # complete the top level: the unobserved SOC "Vascular" is added as a zero-row #' ard |> -#' add_hierarchical_unobserved_levels(variables = AESOC) -#' -#' # complete both levels: also fill the missing PT ("PT3") under each observed SOC -#' ard |> -#' add_hierarchical_unobserved_levels(variables = c(AESOC, AEDECOD)) +#' add_hierarchical_unobserved_levels( +#' levels = data.frame(AESOC = c("Cardiac", "GI", "Vascular")) +#' ) #' -#' # `mapping` names the children to add under the unobserved parent "Vascular" +#' # complete both levels, including children of the unobserved parent "Vascular" #' ard |> #' add_hierarchical_unobserved_levels( -#' variables = c(AESOC, AEDECOD), -#' mapping = list(Vascular = c("PT1", "PT2")) +#' levels = data.frame( +#' AESOC = c("Cardiac", "Cardiac", "GI", "GI", "Vascular", "Vascular"), +#' AEDECOD = c("PT1", "PT2", "PT1", "PT2", "PTX", "PTY") +#' ) #' ) NULL @@ -71,32 +66,38 @@ NULL #' @rdname add_hierarchical_unobserved_levels #' @export -add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { +add_hierarchical_unobserved_levels <- function(x, levels) { set_cli_abort_call() # process inputs ------------------------------------------------------------- check_not_missing(x) - check_not_missing(variables) + check_not_missing(levels) check_class(x, "card") check_class(x, "ard_stack_hierarchical") + check_data_frame(levels) - # `variables` is tidy-selected against the ARD's own variable column so the - # helper accepts the same style of input as ard_stack_hierarchical() + # the columns of `levels` name the hierarchical variables to complete, in + # hierarchy order, and must exist in the ARD's own variable column + vars <- names(levels) var_universe <- unique(x[["variable"]]) - scaffold <- as.data.frame( - stats::setNames(rep(list(logical(0)), length(var_universe)), var_universe) - ) - process_selectors(scaffold, variables = {{ variables }}) - - if (!is.null(mapping) && !is.list(mapping) && !is.data.frame(mapping)) { + unknown <- setdiff(vars, var_universe) + if (length(unknown) > 0L) { cli::cli_abort( - "The {.arg mapping} argument must be {.code NULL}, a named {.cls list}, or a {.cls data.frame}.", + c( + "Columns of {.arg levels} must name hierarchical variables present in {.arg x}.", + "i" = "Unknown column{?s}: {.val {unknown}}.", + "i" = "Available variable{?s}: {.val {var_universe}}." + ), call = get_cli_abort_call() ) } - top_var <- variables[1L] - child_var <- if (length(variables) >= 2L) variables[2L] else NA_character_ + # a level column that is a factor could reintroduce the very NA-from-bad-level + # problem we are fixing, so compare as character throughout + levels[] <- lapply(levels, as.character) + + top_var <- vars[1L] + child_var <- if (length(vars) >= 2L) vars[2L] else NA_character_ # helper: first level value from a list-column (`variable_level`, `groupN_level`) level_chr <- function(col) { @@ -110,18 +111,6 @@ add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { ) } - # helper: the factor levels stored in a list-column, if any. The ARD keeps the - # full factor (including unobserved levels) inside each list element, so the - # expected universe can be recovered without the original data. - level_universe <- function(col) { - for (z in col) { - if (is.factor(z)) { - return(levels(z)) - } - } - NULL - } - # the hierarchical parent of a nested variable is stored in the last populated # `groupN` column: without a `by` the top variable has no group columns and the # child's parent is `group1`; with a `by` the arm occupies `group1` and the @@ -160,27 +149,9 @@ add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { template } - # observed top-level values and the expected universe. Without a `mapping` the - # universe is the top variable's factor levels stored in the ARD; a `mapping` - # overrides that (and can introduce parents the factor levels do not contain). - observed_top <- unique(level_chr(x[["variable_level"]][x[["variable"]] == top_var])) - top_factor_levels <- level_universe(x[["variable_level"]][x[["variable"]] == top_var]) - expected_top <- if (is.null(mapping)) { - top_factor_levels %||% observed_top - } else { - union(.zero_rows_expected_top(mapping, top_var), observed_top) - } - missing_top <- setdiff(expected_top, observed_top) - - # child factor levels stored in the ARD, used when `mapping` is NULL - child_factor_levels <- if (!is.na(child_var)) { - level_universe(child_rows[["variable_level"]]) - } else { - NULL - } - # blueprint rows carry the correct stat structure (n/N/p, by-groups, fmt_fun). # one blueprint per `by`-group is preserved by taking all rows of one level. + observed_top <- unique(level_chr(x[["variable_level"]][x[["variable"]] == top_var])) blueprint_top <- x[x[["variable"]] == top_var & level_chr(x[["variable_level"]]) == observed_top[1L], ] # a child blueprint spans one child level under one parent, across all # `by`-groups; the parent level is overwritten per added row @@ -199,27 +170,21 @@ add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { new_blocks <- list() - # top-level completion plus the children of any missing parent. Without a - # `mapping`, factor levels cannot say which children belong under an unobserved - # parent, so such a parent is added at the top level only. - for (lvl in missing_top) { + # top-level completion: add every expected top value not already observed + expected_top <- unique(levels[[top_var]]) + expected_top <- expected_top[!is.na(expected_top)] + for (lvl in setdiff(expected_top, observed_top)) { new_blocks <- c(new_blocks, list(build_block(blueprint_top, NULL, top_var, lvl))) - if (!is.na(child_var) && !is.null(mapping)) { - for (kid in .zero_rows_children(mapping, lvl, top_var, child_var)) { - new_blocks <- c(new_blocks, list(build_block(blueprint_child, lvl, child_var, kid))) - } - } } - # nested completion: observed parent, unobserved child. Expected children come - # from `mapping` when supplied, otherwise from the child's factor levels. + # child completion: for every expected parent, add the children listed in + # `levels` that are not already observed under it. A newly added (unobserved) + # parent has no observed children, so its full child set is added -- the same + # code path as an observed parent, giving consistent behaviour for all levels. if (!is.na(child_var) && !is.na(parent_level_col)) { - for (parent in observed_top) { - expected_kids <- if (is.null(mapping)) { - child_factor_levels %||% character(0L) - } else { - .zero_rows_children(mapping, parent, top_var, child_var) - } + for (parent in expected_top) { + expected_kids <- unique(levels[[child_var]][levels[[top_var]] == parent]) + expected_kids <- expected_kids[!is.na(expected_kids)] observed_kids <- unique(level_chr( child_rows[["variable_level"]][level_chr(child_rows[[parent_level_col]]) == parent] )) @@ -237,33 +202,3 @@ add_hierarchical_unobserved_levels <- function(x, variables, mapping = NULL) { class(out) <- class(x) out } - -# expected top-level values from a list (its names) or data.frame (first column) -.zero_rows_expected_top <- function(mapping, top_var) { - if (is.data.frame(mapping)) { - if (!top_var %in% names(mapping)) { - cli::cli_abort( - "A {.cls data.frame} {.arg mapping} must contain a column named {.val {top_var}}.", - call = get_cli_abort_call() - ) - } - unique(as.character(mapping[[top_var]])) - } else { - names(mapping) - } -} - -# expected child levels for a parent from a list or data.frame mapping -.zero_rows_children <- function(mapping, parent, top_var, child_var) { - if (is.data.frame(mapping)) { - if (!child_var %in% names(mapping)) { - cli::cli_abort( - "A {.cls data.frame} {.arg mapping} must contain a column named {.val {child_var}}.", - call = get_cli_abort_call() - ) - } - as.character(unique(mapping[[child_var]][as.character(mapping[[top_var]]) == parent])) - } else { - as.character(mapping[[parent]] %||% character(0L)) - } -} diff --git a/man/add_hierarchical_unobserved_levels.Rd b/man/add_hierarchical_unobserved_levels.Rd index 8c8555e22..bee610e7b 100644 --- a/man/add_hierarchical_unobserved_levels.Rd +++ b/man/add_hierarchical_unobserved_levels.Rd @@ -4,23 +4,19 @@ \alias{add_hierarchical_unobserved_levels} \title{Add Unobserved Levels to Hierarchical ARDs} \usage{ -add_hierarchical_unobserved_levels(x, variables, mapping = NULL) +add_hierarchical_unobserved_levels(x, levels) } \arguments{ \item{x}{(\code{card})\cr a stacked hierarchical ARD created with \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}.} -\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -hierarchical variable(s) to complete, in hierarchy order. Use a single -variable (e.g. \code{variables = AESOC}) to complete the top level, or the full -set (e.g. \code{variables = c(AESOC, AEDECOD)}) to also fill missing children -under each observed parent.} - -\item{mapping}{(named \code{list} or \code{data.frame})\cr -optional. Only needed to add children under a parent that is itself -unobserved -- factor levels cannot say which children belong there. Supply -either a named list, \code{list("SOC A" = c("PT1", "PT2"))}, or a two-column data -frame whose columns are named after the parent and child variables.} +\item{levels}{(\code{data.frame})\cr +the expected level combinations. Its columns are named after the +hierarchical variables to complete, in hierarchy order (e.g. columns +\code{AESOC} and \code{AEDECOD}), matching the \code{variables}/\code{include} of the original +\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} call. Each row is a combination that should be +present: any combination not already in \code{x} is added as a zero-count row. +Use a single column (e.g. just \code{AESOC}) to complete only the top level.} } \value{ a stacked hierarchical ARD @@ -33,20 +29,18 @@ category that never occurs (an SOC with no events, a preferred term absent under an observed SOC, an unused grade) simply drops out instead of showing up with a count of zero. -\code{add_hierarchical_unobserved_levels()} puts those rows back. Name the -hierarchical variable(s) to complete and the missing levels are added with a -count of zero; proportions are left as \code{NaN}, since a never-observed level has -no one at risk (\code{0 / 0} is undefined) and should be recoded for display rather -than asserted as zero here. The expected levels are taken from the variable's -factor \code{levels()}, which the ARD already stores, so no reference data is -needed. +\code{add_hierarchical_unobserved_levels()} puts those rows back. Supply a data +frame of the level combinations you expect to see, and any that are missing +are added with a count of zero; proportions are left as \code{NaN}, since a +never-observed level has no one at risk (\code{0 / 0} is undefined) and should be +recoded for display rather than asserted as zero here. } \examples{ set.seed(1) adae <- data.frame( USUBJID = sprintf("S\%03d", 1:20), - AESOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), - AEDECOD = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")) + AESOC = sample(c("Cardiac", "GI"), 20, TRUE), + AEDECOD = sample(c("PT1", "PT2"), 20, TRUE) ) ard <- ard_stack_hierarchical( @@ -58,17 +52,17 @@ ard <- ard_stack_hierarchical( # complete the top level: the unobserved SOC "Vascular" is added as a zero-row ard |> - add_hierarchical_unobserved_levels(variables = AESOC) - -# complete both levels: also fill the missing PT ("PT3") under each observed SOC -ard |> - add_hierarchical_unobserved_levels(variables = c(AESOC, AEDECOD)) + add_hierarchical_unobserved_levels( + levels = data.frame(AESOC = c("Cardiac", "GI", "Vascular")) + ) -# `mapping` names the children to add under the unobserved parent "Vascular" +# complete both levels, including children of the unobserved parent "Vascular" ard |> add_hierarchical_unobserved_levels( - variables = c(AESOC, AEDECOD), - mapping = list(Vascular = c("PT1", "PT2")) + levels = data.frame( + AESOC = c("Cardiac", "Cardiac", "GI", "GI", "Vascular", "Vascular"), + AEDECOD = c("PT1", "PT2", "PT1", "PT2", "PTX", "PTY") + ) ) } \seealso{ diff --git a/tests/testthat/test-add_hierarchical_unobserved_levels.R b/tests/testthat/test-add_hierarchical_unobserved_levels.R index 77581f9bf..b008d1b87 100644 --- a/tests/testthat/test-add_hierarchical_unobserved_levels.R +++ b/tests/testthat/test-add_hierarchical_unobserved_levels.R @@ -1,17 +1,17 @@ skip_on_cran() -# a small hierarchical ARD where "Vascular" is a declared but unobserved SOC and -# "PT3" is a declared but unobserved preferred term. Both are carried as factor -# levels so the expected universe is recoverable from the ARD alone. +# a small hierarchical ARD where "Vascular" and "PT3" never occur in the data. +# The expected universe is supplied by the caller via the `levels` data frame, +# so the source columns need not be factors. make_ard <- function(by = FALSE) { set.seed(1) adae <- data.frame( USUBJID = sprintf("S%03d", 1:20), - SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI", "Vascular")), - PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2", "PT3")), - TRT = factor(rep(c("A", "B"), 10)) + SOC = sample(c("Cardiac", "GI"), 20, TRUE), + PT = sample(c("PT1", "PT2"), 20, TRUE), + TRT = rep(c("A", "B"), 10) ) - denom <- data.frame(USUBJID = sprintf("S%03d", 1:30), TRT = factor(rep(c("A", "B"), 15))) + denom <- data.frame(USUBJID = sprintf("S%03d", 1:30), TRT = rep(c("A", "B"), 15)) if (by) { ard_stack_hierarchical(adae, variables = c(SOC, PT), by = TRT, id = USUBJID, denominator = denom) } else { @@ -27,9 +27,12 @@ lvl1 <- function(col) { }, character(1L)) } -test_that("add_hierarchical_unobserved_levels(variables = SOC) completes the top level from factor levels", { +test_that("add_hierarchical_unobserved_levels() completes the top level from a one-column data frame", { ard <- make_ard() - out <- add_hierarchical_unobserved_levels(ard, variables = SOC) + out <- add_hierarchical_unobserved_levels( + ard, + levels = data.frame(SOC = c("Cardiac", "GI", "Vascular")) + ) expect_s3_class(out, "ard_stack_hierarchical") expect_setequal( @@ -53,33 +56,34 @@ test_that("add_hierarchical_unobserved_levels(variables = SOC) completes the top ) }) -test_that("add_hierarchical_unobserved_levels(variables = c(SOC, PT)) completes nested levels from factor levels", { +test_that("add_hierarchical_unobserved_levels() completes nested levels under observed parents", { ard <- make_ard() - out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT)) + out <- add_hierarchical_unobserved_levels( + ard, + levels = data.frame( + SOC = c("Cardiac", "Cardiac", "Cardiac", "GI", "GI", "GI"), + PT = c("PT1", "PT2", "PT3", "PT1", "PT2", "PT3") + ) + ) - # top level recovered - expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) - # the unobserved PT3 is filled under each observed parent from PT's factor levels + # the unobserved PT3 is filled under each observed parent for (parent in c("Cardiac", "GI")) { expect_true( "PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == parent]) ) } - # no children invented under the unobserved parent without a mapping - expect_length( - unique(lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"])), - 0L - ) }) test_that("add_hierarchical_unobserved_levels() adds children of a missing parent", { ard <- make_ard() out <- add_hierarchical_unobserved_levels( ard, - variables = c(SOC, PT), - mapping = list(Vascular = c("PTX", "PTY")) + levels = data.frame(SOC = c("Vascular", "Vascular"), PT = c("PTX", "PTY")) ) + # the unobserved parent is added at the top level + expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) + # and its children are added underneath it kids <- out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"] expect_setequal(unique(lvl1(kids)), c("PTX", "PTY")) expect_true(all( @@ -91,8 +95,7 @@ test_that("add_hierarchical_unobserved_levels() adds a missing child of an obser ard <- make_ard() out <- add_hierarchical_unobserved_levels( ard, - variables = c(SOC, PT), - mapping = list(Cardiac = c("PT1", "PT2", "PT3")) + levels = data.frame(SOC = c("Cardiac", "Cardiac", "Cardiac"), PT = c("PT1", "PT2", "PT3")) ) expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) @@ -103,13 +106,13 @@ test_that("add_hierarchical_unobserved_levels() adds a missing child of an obser ) }) -test_that("add_hierarchical_unobserved_levels() accepts a data.frame mapping", { +test_that("add_hierarchical_unobserved_levels() completes parents and children in one call", { ard <- make_ard() - mapping <- data.frame( + levels <- data.frame( SOC = c("Vascular", "Vascular", "Cardiac"), PT = c("PTX", "PTY", "PT3") ) - out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = mapping) + out <- add_hierarchical_unobserved_levels(ard, levels = levels) expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) expect_setequal( @@ -121,7 +124,10 @@ test_that("add_hierarchical_unobserved_levels() accepts a data.frame mapping", { test_that("add_hierarchical_unobserved_levels() preserves the by structure", { ard <- make_ard(by = TRUE) - out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + out <- add_hierarchical_unobserved_levels( + ard, + levels = data.frame(SOC = "Vascular", PT = "PTX") + ) # one Vascular SOC row per by-group, with the arm retained in group1 vasc_soc <- out[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n", ] @@ -135,36 +141,40 @@ test_that("add_hierarchical_unobserved_levels() preserves the by structure", { }) test_that("add_hierarchical_unobserved_levels() is a no-op when nothing is missing", { - # an ARD whose factor levels are all observed leaves the input untouched - set.seed(1) - adae <- data.frame( - USUBJID = sprintf("S%03d", 1:20), - SOC = factor(sample(c("Cardiac", "GI"), 20, TRUE), levels = c("Cardiac", "GI")), - PT = factor(sample(c("PT1", "PT2"), 20, TRUE), levels = c("PT1", "PT2")) - ) - ard <- ard_stack_hierarchical( - adae, - variables = c(SOC, PT), id = USUBJID, - denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) + ard <- make_ard() + # every combination in `levels` is already observed, so the input is unchanged + out <- add_hierarchical_unobserved_levels( + ard, + levels = data.frame( + SOC = c("Cardiac", "Cardiac", "GI", "GI"), + PT = c("PT1", "PT2", "PT1", "PT2") + ) ) - out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT)) expect_equal(nrow(out), nrow(ard)) }) test_that("add_hierarchical_unobserved_levels() input checks", { ard <- make_ard() expect_error( - add_hierarchical_unobserved_levels(data.frame(a = 1), variables = a), + add_hierarchical_unobserved_levels(data.frame(a = 1), levels = data.frame(SOC = "X")), class = "check_class" ) expect_error( - add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = "not a mapping"), - "must be" + add_hierarchical_unobserved_levels(ard, levels = "not a data frame"), + class = "check_data_frame" + ) + # a column that is not a hierarchical variable in the ARD is rejected + expect_error( + add_hierarchical_unobserved_levels(ard, levels = data.frame(NOTAVAR = "X")), + "Unknown column" ) }) test_that("add_hierarchical_unobserved_levels() output remains a valid ARD", { ard <- make_ard() - out <- add_hierarchical_unobserved_levels(ard, variables = c(SOC, PT), mapping = list(Vascular = "PTX")) + out <- add_hierarchical_unobserved_levels( + ard, + levels = data.frame(SOC = "Vascular", PT = "PTX") + ) expect_no_error(sort_ard_hierarchical(out)) }) From 4c7470df59ed2515d46f24103bcc83d6c8fa024d Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Tue, 8 Sep 2026 15:38:25 +0000 Subject: [PATCH 07/10] Add add_hierarchical_unobserved_levels() to pkgdown reference index pkgdown requires every exported topic to be indexed; the new function was missing from _pkgdown.yml, failing the docs build. --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index d7487c9bd..58f68c99a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -83,6 +83,7 @@ reference: - as_cards_fn - subtitle: "Wrangle ARD" contents: + - add_hierarchical_unobserved_levels - diff_ard_hierarchical - filter_ard_hierarchical - sort_ard_hierarchical From 31f26363cbbb9bc979dba77d6c395384b8ad184d Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Mon, 26 Oct 2026 15:22:42 +0000 Subject: [PATCH 08/10] Fix `add_hierarchical_unobserved_levels()` for `include`, `overall` and counts * Read the hierarchy from the ARD, so the columns of `levels` can come in any order, any depth is completed, and ARDs built with `include` or `overall` get correct rows. * Accept `ard_stack_hierarchical_count()` results. * Set `p` to 0 for an added level (`NaN` only in an empty `by` group, as elsewhere in the ARD) and drop the cumulative statistics, which a stacked hierarchical ARD cannot have. * Keep factor levels as factors, refresh `stat_fmt` when present, and sort the result so each added level sits under its parent. * Error on missing values in `levels`, on levels of the wrong type, and on statistics with no known value for an unobserved level. * Examples and tests use `ADAE` and `ADSL`. Drop the `tbl_hierarchical()` and `ard_stack_hierarchical()` see-also links, and move the NEWS entry to New Features and Functions. --- NEWS.md | 6 +- R/add_hierarchical_unobserved_levels.R | 309 ++++++++------- man/add_hierarchical_unobserved_levels.Rd | 82 ++-- .../add_hierarchical_unobserved_levels.md | 70 ++++ .../test-add_hierarchical_unobserved_levels.R | 358 +++++++++++------- 5 files changed, 484 insertions(+), 341 deletions(-) create mode 100644 tests/testthat/_snaps/add_hierarchical_unobserved_levels.md diff --git a/NEWS.md b/NEWS.md index 4e8fd5d89..db53f896c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # cards 0.9.0.9002 +## New Features and Functions + +* Added `add_hierarchical_unobserved_levels()` to add zero-count rows to `ard_stack_hierarchical()` and `ard_stack_hierarchical_count()` results for the level combinations that do not occur in the data, e.g. an SOC with no events. The expected combinations are passed as a data frame with columns named after the hierarchy variables. (#602, @Melkiades) + ## 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) @@ -10,8 +14,6 @@ * `compare_ard()` now compares the `columns` the two ARDs have in common, rather than throwing an error when the selection resolves to a different set in each. Comparing a formatted ARD against one that has not been formatted, for example, previously failed on the default `columns` because `apply_fmt_fun()` adds `stat_fmt`; the shared columns are now compared and a message reports those that were skipped. An error is still thrown when the two selections have nothing in common, and `keys` must still resolve to the same columns in both ARDs. (#606) -* Added `add_hierarchical_unobserved_levels()` to add zero-count rows for unobserved levels (top-level categories and nested children) to a stacked hierarchical ARD. The expected level combinations are supplied as a data frame whose columns are named after the hierarchical variables. (#602, @Melkiades) - # cards 0.9.0 ## Performance diff --git a/R/add_hierarchical_unobserved_levels.R b/R/add_hierarchical_unobserved_levels.R index ccb752177..f27cb136f 100644 --- a/R/add_hierarchical_unobserved_levels.R +++ b/R/add_hierarchical_unobserved_levels.R @@ -2,203 +2,198 @@ #' #' @description `r lifecycle::badge('experimental')`\cr #' -#' A stacked hierarchical ARD keeps only the levels seen in the data, so a -#' category that never occurs (an SOC with no events, a preferred term absent -#' under an observed SOC, an unused grade) simply drops out instead of showing -#' up with a count of zero. +#' A stacked hierarchical ARD only has rows for the levels observed in the data: +#' an SOC with no events, or an AE never reported under an SOC, has no rows. #' -#' `add_hierarchical_unobserved_levels()` puts those rows back. Supply a data -#' frame of the level combinations you expect to see, and any that are missing -#' are added with a count of zero; proportions are left as `NaN`, since a -#' never-observed level has no one at risk (`0 / 0` is undefined) and should be -#' recoded for display rather than asserted as zero here. +#' `add_hierarchical_unobserved_levels()` adds these rows. Pass the level +#' combinations you expect in `levels`: each combination missing from `x` is +#' added with `n = 0`, the denominator `N` of its `by` group, and `p = 0`. As in +#' the rest of the ARD, `p` is `NaN` only when the `by` group is empty (`N = 0`). #' #' @param x (`card`)\cr -#' a stacked hierarchical ARD created with [ard_stack_hierarchical()]. +#' a stacked hierarchical ARD of class `'card'` created using [ard_stack_hierarchical()] or +#' [ard_stack_hierarchical_count()]. #' @param levels (`data.frame`)\cr -#' the expected level combinations. Its columns are named after the -#' hierarchical variables to complete, in hierarchy order (e.g. columns -#' `AESOC` and `AEDECOD`), matching the `variables`/`include` of the original -#' [ard_stack_hierarchical()] call. Each row is a combination that should be -#' present: any combination not already in `x` is added as a zero-count row. -#' Use a single column (e.g. just `AESOC`) to complete only the top level. +#' the expected level combinations, one per row. The columns are named after the +#' hierarchy variables of `x` and start from the top of the hierarchy, e.g. `AESOC` +#' alone, or `AESOC` and `AEDECOD`. Their order does not matter. #' -#' @return a stacked hierarchical ARD -#' @seealso [gtsummary::tbl_hierarchical()], [ard_stack_hierarchical()], [sort_ard_hierarchical()] -#' @name add_hierarchical_unobserved_levels +#' @details +#' Rows are only added for the variables with summary rows in `x` (see the +#' `include` argument of [ard_stack_hierarchical()]). #' -#' @examples -#' set.seed(1) -#' adae <- data.frame( -#' USUBJID = sprintf("S%03d", 1:20), -#' AESOC = sample(c("Cardiac", "GI"), 20, TRUE), -#' AEDECOD = sample(c("PT1", "PT2"), 20, TRUE) -#' ) +#' The result is sorted alphanumerically, as returned by [ard_stack_hierarchical()], +#' so that each added level sits under its parent. Use [sort_ard_hierarchical()] +#' afterwards for a different order. #' -#' ard <- ard_stack_hierarchical( -#' adae, -#' variables = c(AESOC, AEDECOD), -#' id = USUBJID, -#' denominator = data.frame(USUBJID = sprintf("S%03d", 1:30)) -#' ) +#' @return an ARD data frame of class 'card' +#' @seealso [sort_ard_hierarchical()] +#' @name add_hierarchical_unobserved_levels #' -#' # complete the top level: the unobserved SOC "Vascular" is added as a zero-row -#' ard |> -#' add_hierarchical_unobserved_levels( -#' levels = data.frame(AESOC = c("Cardiac", "GI", "Vascular")) -#' ) +#' @examplesIf (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) +#' # AEs of two SOCs: no severe AE is reported for EYE DISORDERS, +#' # and only some of the CARDIAC DISORDERS AEs are severe +#' adae <- ADAE |> +#' dplyr::filter(AESOC %in% c("CARDIAC DISORDERS", "EYE DISORDERS")) #' -#' # complete both levels, including children of the unobserved parent "Vascular" -#' ard |> -#' add_hierarchical_unobserved_levels( -#' levels = data.frame( -#' AESOC = c("Cardiac", "Cardiac", "GI", "GI", "Vascular", "Vascular"), -#' AEDECOD = c("PT1", "PT2", "PT1", "PT2", "PTX", "PTY") -#' ) +#' ard <- adae |> +#' dplyr::filter(AESEV == "SEVERE") |> +#' ard_stack_hierarchical( +#' variables = c(AESOC, AEDECOD), +#' by = TRTA, +#' denominator = ADSL, +#' id = USUBJID #' ) +#' +#' # add the SOC with no severe AEs +#' add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC)) +#' +#' # add every SOC/AE combination of the two SOCs +#' add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) NULL -# count statistics set to zero on an added level. Proportions are left as `NaN` -# (a never-observed level has no one at risk, so `0 / 0` is undefined) and are -# recoded for display downstream rather than being asserted as zero here -.hierarchical_zero_stats <- c("n", "n_cum") -.hierarchical_nan_stats <- c("p", "p_cum") - #' @rdname add_hierarchical_unobserved_levels #' @export add_hierarchical_unobserved_levels <- function(x, levels) { set_cli_abort_call() - # process inputs ------------------------------------------------------------- + # check inputs --------------------------------------------------------------- check_not_missing(x) check_not_missing(levels) - check_class(x, "card") - check_class(x, "ard_stack_hierarchical") + check_class(x, c("ard_stack_hierarchical", "ard_stack_hierarchical_count")) check_data_frame(levels) - # the columns of `levels` name the hierarchical variables to complete, in - # hierarchy order, and must exist in the ARD's own variable column - vars <- names(levels) - var_universe <- unique(x[["variable"]]) - unknown <- setdiff(vars, var_universe) - if (length(unknown) > 0L) { + ard_args <- attributes(x)$args + variables <- ard_args$variables + + # the columns of `levels` are the top hierarchy variables, in any order + top_variables <- variables[seq_len(ncol(levels))] + if (ncol(levels) == 0L || !setequal(names(levels), top_variables)) { cli::cli_abort( c( - "Columns of {.arg levels} must name hierarchical variables present in {.arg x}.", - "i" = "Unknown column{?s}: {.val {unknown}}.", - "i" = "Available variable{?s}: {.val {var_universe}}." + "The columns of {.arg levels} must be hierarchy variables of {.arg x}, starting from the top.", + i = "The hierarchy variables of {.arg x}, from the top, are {.val {variables}}." ), call = get_cli_abort_call() ) } + if (anyNA(levels)) { + cli::cli_abort( + "The {.arg levels} argument cannot contain missing values.", + call = get_cli_abort_call() + ) + } + levels <- dplyr::distinct(levels[top_variables]) - # a level column that is a factor could reintroduce the very NA-from-bad-level - # problem we are fixing, so compare as character throughout - levels[] <- lapply(levels, as.character) - - top_var <- vars[1L] - child_var <- if (length(vars) >= 2L) vars[2L] else NA_character_ - - # helper: first level value from a list-column (`variable_level`, `groupN_level`) - level_chr <- function(col) { - vapply( - col, - function(z) { - z <- as.character(z) - if (length(z)) z[[1L]] else NA_character_ - }, - character(1L) + # only the variables with summary rows in `x` get new rows, and only `n`, `N` + # and `p` have a known value for an unobserved level + complete_variables <- intersect(top_variables, ard_args$include) + is_summary_row <- x$context %in% c("hierarchical", "hierarchical_count") & x$variable %in% complete_variables + unexpected_stats <- setdiff(x$stat_name[is_summary_row], c("n", "N", "p")) + if (!is_empty(unexpected_stats)) { + cli::cli_abort( + c( + "Cannot add unobserved levels to an ARD with the {.val {unexpected_stats}} statistic{?s}.", + i = "Only the {.val {c('n', 'N', 'p')}} statistics can be set for an unobserved level." + ), + call = get_cli_abort_call() ) } - # the hierarchical parent of a nested variable is stored in the last populated - # `groupN` column: without a `by` the top variable has no group columns and the - # child's parent is `group1`; with a `by` the arm occupies `group1` and the - # parent shifts to `group2`. Detect the child's parent group column from data. - child_rows <- if (!is.na(child_var)) x[x[["variable"]] == child_var, ] else x[0, ] - parent_group_col <- NA_character_ - if (nrow(child_rows) > 0L) { - group_cols <- grep("^group[0-9]+$", names(x), value = TRUE) - for (gc in group_cols) { - if (any(as.character(child_rows[[gc]]) == top_var, na.rm = TRUE)) { - parent_group_col <- gc - break + # build the rows of the unobserved levels ------------------------------------ + new_rows <- + lapply( + complete_variables, + \(variable) { + .unobserved_level_rows( + x = x[is_summary_row & x$variable == variable, ], + levels = levels, + variable = variable, + ancestors = variables[seq_len(match(variable, variables) - 1L)] + ) } - } - } - parent_level_col <- if (!is.na(parent_group_col)) paste0(parent_group_col, "_level") else NA_character_ + ) |> + dplyr::bind_rows() - # build a zero-row block from an observed template, overriding the variable and - # its level, optionally setting the hierarchical parent, and zeroing counts - build_block <- function(template, parent_level, variable, level) { - if (nrow(template) == 0L) { - return(template) - } - template[["variable"]] <- variable - template[["variable_level"]] <- rep(list(level), nrow(template)) - if (!is.null(parent_level) && !is.na(parent_group_col)) { - template[[parent_group_col]] <- top_var - template[[parent_level_col]] <- rep(list(parent_level), nrow(template)) - } - is_zero <- template[["stat_name"]] %in% .hierarchical_zero_stats - template[["stat"]][is_zero] <- as.list(rep(0, sum(is_zero))) - is_nan <- template[["stat_name"]] %in% .hierarchical_nan_stats - template[["stat"]][is_nan] <- as.list(rep(NaN, sum(is_nan))) - if ("warning" %in% names(template)) template[["warning"]] <- rep(list(NULL), nrow(template)) - if ("error" %in% names(template)) template[["error"]] <- rep(list(NULL), nrow(template)) - template + if (nrow(new_rows) == 0L) { + return(x) } - # blueprint rows carry the correct stat structure (n/N/p, by-groups, fmt_fun). - # one blueprint per `by`-group is preserved by taking all rows of one level. - observed_top <- unique(level_chr(x[["variable_level"]][x[["variable"]] == top_var])) - blueprint_top <- x[x[["variable"]] == top_var & level_chr(x[["variable_level"]]) == observed_top[1L], ] - # a child blueprint spans one child level under one parent, across all - # `by`-groups; the parent level is overwritten per added row - blueprint_child <- if (nrow(child_rows) > 0L) { - first_child <- level_chr(child_rows[["variable_level"]])[1L] - child_one <- child_rows[level_chr(child_rows[["variable_level"]]) == first_child, ] - if (!is.na(parent_level_col)) { - first_parent <- level_chr(child_one[[parent_level_col]])[1L] - child_one[level_chr(child_one[[parent_level_col]]) == first_parent, ] - } else { - child_one - } - } else { - x[0, ] + # sort as `ard_stack_hierarchical()` does, so each added level sits under its parent + dplyr::bind_rows(x, new_rows) |> + sort_ard_hierarchical(sort = "alphanumeric") +} + +# rows for the combinations of `levels` missing from `x`, the summary rows of +# `variable`. Each layout of `x` (one per set of group columns: with the `by` +# variables, or overall without them) is completed from a template, the rows of +# one observed level, which hold every `by` group with its denominator `N` +.unobserved_level_rows <- function(x, levels, variable, ancestors) { + if (nrow(x) == 0L) { + cli::cli_abort( + "Cannot add levels for {.val {variable}}: {.arg x} has no rows for this variable to copy.", + call = get_cli_abort_call() + ) } + expected <- dplyr::distinct(levels[c(ancestors, variable)]) + expected_chr <- dplyr::mutate(expected, across(everything(), as.character)) + group_cols <- grep("^group[0-9]+$", names(x), value = TRUE) - new_blocks <- list() + lapply( + vctrs::vec_group_loc(x[group_cols])$loc, + \(loc) { + x_layout <- x[loc, ] + # the level columns of the ancestors and of `variable` in this layout + level_cols <- c( + sprintf("%s_level", group_cols[match(ancestors, unlist(x_layout[1L, group_cols]))]), + "variable_level" + ) + observed <- x_layout[level_cols] |> + unlist_ard_columns(columns = everything()) |> + dplyr::mutate(across(everything(), as.character)) |> + stats::setNames(names(expected)) + missing <- vctrs::vec_slice(expected, !vctrs::vec_in(expected_chr, observed)) + if (nrow(missing) == 0L) { + return(NULL) + } - # top-level completion: add every expected top value not already observed - expected_top <- unique(levels[[top_var]]) - expected_top <- expected_top[!is.na(expected_top)] - for (lvl in setdiff(expected_top, observed_top)) { - new_blocks <- c(new_blocks, list(build_block(blueprint_top, NULL, top_var, lvl))) - } + # copy the template once per missing combination, then set its levels + template <- x_layout[vctrs::vec_equal(observed, vctrs::vec_slice(observed, 1L)), ] + i_missing <- rep(seq_len(nrow(missing)), each = nrow(template)) + new <- template[rep(seq_len(nrow(template)), times = nrow(missing)), ] + for (i in seq_along(level_cols)) { + new[[level_cols[i]]] <- .as_levels_like( + missing[[i]][i_missing], + like = template[[level_cols[i]]][[1L]], + arg = paste0("levels$", names(missing)[i]) + ) + } - # child completion: for every expected parent, add the children listed in - # `levels` that are not already observed under it. A newly added (unobserved) - # parent has no observed children, so its full child set is added -- the same - # code path as an observed parent, giving consistent behaviour for all levels. - if (!is.na(child_var) && !is.na(parent_level_col)) { - for (parent in expected_top) { - expected_kids <- unique(levels[[child_var]][levels[[top_var]] == parent]) - expected_kids <- expected_kids[!is.na(expected_kids)] - observed_kids <- unique(level_chr( - child_rows[["variable_level"]][level_chr(child_rows[[parent_level_col]]) == parent] - )) - for (kid in setdiff(expected_kids, observed_kids)) { - new_blocks <- c(new_blocks, list(build_block(blueprint_child, parent, child_var, kid))) + # `n` is 0 and so is `p = n / N`, except in an empty `by` group (`N = 0`): + # there `p` is NaN, which is exactly where the template's own `p` is NaN + new$stat[new$stat_name == "n"] <- list(0L) + is_p <- new$stat_name == "p" + new$stat[is_p] <- lapply(new$stat[is_p], \(p) if (is.nan(p)) NaN else 0) + for (col in intersect(c("warning", "error"), names(new))) { + new[[col]] <- rep(list(NULL), nrow(new)) + } + if ("stat_fmt" %in% names(new)) { + new <- apply_fmt_fun(new, replace = TRUE) } + new } - } - - if (length(new_blocks) == 0L) { - return(x) - } + ) |> + dplyr::bind_rows() +} - out <- dplyr::bind_rows(x, dplyr::bind_rows(new_blocks)) - class(out) <- class(x) - out +# new level values in the type of the levels already in the ARD (`like`), as a +# list column. A factor keeps its levels, extended by any new value +.as_levels_like <- function(values, like, arg) { + values <- + if (is.factor(like)) { + factor(as.character(values), levels = union(levels(like), as.character(values))) + } else { + vctrs::vec_cast(values, like, x_arg = arg, call = get_cli_abort_call()) + } + as.list(values) } diff --git a/man/add_hierarchical_unobserved_levels.Rd b/man/add_hierarchical_unobserved_levels.Rd index bee610e7b..7446abacb 100644 --- a/man/add_hierarchical_unobserved_levels.Rd +++ b/man/add_hierarchical_unobserved_levels.Rd @@ -8,63 +8,59 @@ add_hierarchical_unobserved_levels(x, levels) } \arguments{ \item{x}{(\code{card})\cr -a stacked hierarchical ARD created with \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}.} +a stacked hierarchical ARD of class \code{'card'} created using \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} or +\code{\link[=ard_stack_hierarchical_count]{ard_stack_hierarchical_count()}}.} \item{levels}{(\code{data.frame})\cr -the expected level combinations. Its columns are named after the -hierarchical variables to complete, in hierarchy order (e.g. columns -\code{AESOC} and \code{AEDECOD}), matching the \code{variables}/\code{include} of the original -\code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}} call. Each row is a combination that should be -present: any combination not already in \code{x} is added as a zero-count row. -Use a single column (e.g. just \code{AESOC}) to complete only the top level.} +the expected level combinations, one per row. The columns are named after the +hierarchy variables of \code{x} and start from the top of the hierarchy, e.g. \code{AESOC} +alone, or \code{AESOC} and \code{AEDECOD}. Their order does not matter.} } \value{ -a stacked hierarchical ARD +an ARD data frame of class 'card' } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}\cr -A stacked hierarchical ARD keeps only the levels seen in the data, so a -category that never occurs (an SOC with no events, a preferred term absent -under an observed SOC, an unused grade) simply drops out instead of showing -up with a count of zero. +A stacked hierarchical ARD only has rows for the levels observed in the data: +an SOC with no events, or an AE never reported under an SOC, has no rows. -\code{add_hierarchical_unobserved_levels()} puts those rows back. Supply a data -frame of the level combinations you expect to see, and any that are missing -are added with a count of zero; proportions are left as \code{NaN}, since a -never-observed level has no one at risk (\code{0 / 0} is undefined) and should be -recoded for display rather than asserted as zero here. +\code{add_hierarchical_unobserved_levels()} adds these rows. Pass the level +combinations you expect in \code{levels}: each combination missing from \code{x} is +added with \code{n = 0}, the denominator \code{N} of its \code{by} group, and \code{p = 0}. As in +the rest of the ARD, \code{p} is \code{NaN} only when the \code{by} group is empty (\code{N = 0}). } -\examples{ -set.seed(1) -adae <- data.frame( - USUBJID = sprintf("S\%03d", 1:20), - AESOC = sample(c("Cardiac", "GI"), 20, TRUE), - AEDECOD = sample(c("PT1", "PT2"), 20, TRUE) -) +\details{ +Rows are only added for the variables with summary rows in \code{x} (see the +\code{include} argument of \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}). -ard <- ard_stack_hierarchical( - adae, - variables = c(AESOC, AEDECOD), - id = USUBJID, - denominator = data.frame(USUBJID = sprintf("S\%03d", 1:30)) -) +The result is sorted alphanumerically, as returned by \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}, +so that each added level sits under its parent. Use \code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} +afterwards for a different order. +} +\examples{ +\dontshow{if ((identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true"))) withAutoprint(\{ # examplesIf} +# AEs of two SOCs: no severe AE is reported for EYE DISORDERS, +# and only some of the CARDIAC DISORDERS AEs are severe +adae <- ADAE |> + dplyr::filter(AESOC \%in\% c("CARDIAC DISORDERS", "EYE DISORDERS")) -# complete the top level: the unobserved SOC "Vascular" is added as a zero-row -ard |> - add_hierarchical_unobserved_levels( - levels = data.frame(AESOC = c("Cardiac", "GI", "Vascular")) +ard <- adae |> + dplyr::filter(AESEV == "SEVERE") |> + ard_stack_hierarchical( + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = ADSL, + id = USUBJID ) -# complete both levels, including children of the unobserved parent "Vascular" -ard |> - add_hierarchical_unobserved_levels( - levels = data.frame( - AESOC = c("Cardiac", "Cardiac", "GI", "GI", "Vascular", "Vascular"), - AEDECOD = c("PT1", "PT2", "PT1", "PT2", "PTX", "PTY") - ) - ) +# add the SOC with no severe AEs +add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC)) + +# add every SOC/AE combination of the two SOCs +add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) +\dontshow{\}) # examplesIf} } \seealso{ -\code{\link[gtsummary:tbl_hierarchical]{gtsummary::tbl_hierarchical()}}, \code{\link[=ard_stack_hierarchical]{ard_stack_hierarchical()}}, \code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} +\code{\link[=sort_ard_hierarchical]{sort_ard_hierarchical()}} } diff --git a/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md b/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md new file mode 100644 index 000000000..860bebefa --- /dev/null +++ b/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md @@ -0,0 +1,70 @@ +# add_hierarchical_unobserved_levels() errors with incorrect inputs + + Code + add_hierarchical_unobserved_levels(ard_tabulate(cards::ADSL, variables = AGEGR1), + levels = levels_all) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! The `x` argument must be class , not a object. + +--- + + Code + add_hierarchical_unobserved_levels(ard, levels = "EYE DISORDERS") + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! The `levels` argument must be class , not a string. + +--- + + Code + add_hierarchical_unobserved_levels(ard, levels = data.frame(TRTA = "Placebo")) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. + i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". + +--- + + Code + add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(levels_all, + AEDECOD)) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. + i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". + +--- + + Code + add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = NA_character_)) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! The `levels` argument cannot contain missing values. + +--- + + Code + add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = 1)) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! Can't convert `levels$AESOC` to . + +--- + + Code + add_hierarchical_unobserved_levels(ard_cum, levels = levels_all) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! Cannot add unobserved levels to an ARD with the "n_cum" statistic. + i Only the "n", "N", and "p" statistics can be set for an unobserved level. + +--- + + Code + add_hierarchical_unobserved_levels(dplyr::filter(ard, variable != "AEDECOD"), + levels = levels_all) + Condition + Error in `add_hierarchical_unobserved_levels()`: + ! Cannot add levels for "AEDECOD": `x` has no rows for this variable to copy. + diff --git a/tests/testthat/test-add_hierarchical_unobserved_levels.R b/tests/testthat/test-add_hierarchical_unobserved_levels.R index b008d1b87..61f399f71 100644 --- a/tests/testthat/test-add_hierarchical_unobserved_levels.R +++ b/tests/testthat/test-add_hierarchical_unobserved_levels.R @@ -1,180 +1,260 @@ skip_on_cran() -# a small hierarchical ARD where "Vascular" and "PT3" never occur in the data. -# The expected universe is supplied by the caller via the `levels` data frame, -# so the source columns need not be factors. -make_ard <- function(by = FALSE) { - set.seed(1) - adae <- data.frame( - USUBJID = sprintf("S%03d", 1:20), - SOC = sample(c("Cardiac", "GI"), 20, TRUE), - PT = sample(c("PT1", "PT2"), 20, TRUE), - TRT = rep(c("A", "B"), 10) - ) - denom <- data.frame(USUBJID = sprintf("S%03d", 1:30), TRT = rep(c("A", "B"), 15)) - if (by) { - ard_stack_hierarchical(adae, variables = c(SOC, PT), by = TRT, id = USUBJID, denominator = denom) - } else { - ard_stack_hierarchical(adae, variables = c(SOC, PT), id = USUBJID, denominator = denom) - } -} +ADAE_subset <- cards::ADAE |> + dplyr::filter(AESOC %in% c("CARDIAC DISORDERS", "EYE DISORDERS")) + +# two CARDIAC DISORDERS AEs, each reported in all three arms: EYE DISORDERS and +# the other CARDIAC DISORDERS AEs are unobserved +ADAE_observed <- ADAE_subset |> + dplyr::filter(AEDECOD %in% c("MYOCARDIAL INFARCTION", "SINUS BRADYCARDIA")) + +ard <- ard_stack_hierarchical( + data = ADAE_observed, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID +) -# first level value from a list-column -lvl1 <- function(col) { - vapply(col, function(z) { - z <- as.character(z) - if (length(z)) z[[1L]] else NA_character_ - }, character(1L)) +# the 27 SOC/AE combinations of the two SOCs +levels_all <- dplyr::distinct(ADAE_subset, AESOC, AEDECOD) + +# "SOC / AE" of each AE row with the `n` statistic, so once per arm +ae_rows <- function(x) { + x <- x |> + dplyr::filter(variable == "AEDECOD", stat_name == "n") |> + unlist_ard_columns() + sort(paste(x$group2_level, x$variable_level, sep = " / ")) } +expected_ae_rows <- sort(rep(paste(levels_all$AESOC, levels_all$AEDECOD, sep = " / "), times = 3L)) + +test_that("add_hierarchical_unobserved_levels() works", { + expect_silent(ard_full <- add_hierarchical_unobserved_levels(ard, levels = levels_all)) + + # each SOC/AE combination has a row per arm, under its SOC + expect_equal(ae_rows(ard_full), expected_ae_rows) -test_that("add_hierarchical_unobserved_levels() completes the top level from a one-column data frame", { - ard <- make_ard() - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame(SOC = c("Cardiac", "GI", "Vascular")) + # an added level has n = 0, the N of its arm, and p = 0 + ard_eye <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("EYE DISORDERS")) + ard_cardiac <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("CARDIAC DISORDERS")) + expect_identical(unique(ard_eye$stat[ard_eye$stat_name == "n"]), list(0L)) + expect_identical(unique(ard_eye$stat[ard_eye$stat_name == "p"]), list(0)) + expect_identical(ard_eye$group1_level, ard_cardiac$group1_level) + expect_identical(ard_eye$stat[ard_eye$stat_name == "N"], ard_cardiac$stat[ard_cardiac$stat_name == "N"]) + + # the rows of `x` are unchanged: removing the zero-count levels gives back `x` + expect_equal(filter_ard_hierarchical(ard_full, sum(n) > 0), ard) + + # the result is sorted like the output of `ard_stack_hierarchical()` + expect_equal(sort_ard_hierarchical(ard_full, sort = "alphanumeric"), ard_full) + + # the column order of `levels` does not matter + expect_equal( + add_hierarchical_unobserved_levels(ard, levels = levels_all[c("AEDECOD", "AESOC")]), + ard_full ) +}) - expect_s3_class(out, "ard_stack_hierarchical") - expect_setequal( - unique(lvl1(out$variable_level[out$variable == "SOC"])), - c("Cardiac", "GI", "Vascular") +test_that("add_hierarchical_unobserved_levels() adds the top level only", { + ard_soc <- add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(ADAE_subset, AESOC)) + + # EYE DISORDERS is added, a row per arm and statistic, with no AE rows under it + expect_equal(nrow(ard_soc), nrow(ard) + 9L) + expect_true(any(ard_soc$variable_level %in% list("EYE DISORDERS"))) + expect_equal(ae_rows(ard_soc), ae_rows(ard)) +}) + +test_that("add_hierarchical_unobserved_levels() returns `x` unchanged when no level is missing", { + expect_identical( + add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(ADAE_observed, AESOC, AEDECOD)), + ard ) - # top-level only: no PT rows are invented under the unobserved parent - expect_false(any(lvl1(out$group1_level[out$variable == "PT"]) == "Vascular")) - # the added row has n = 0 and carries a real denominator N - expect_equal( - out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n"][[1L]], - 0 +}) + +test_that("add_hierarchical_unobserved_levels() works with `overall`, `over_variables`, `attributes` and `total_n`", { + ard_opts <- ard_stack_hierarchical( + data = ADAE_observed, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID, + overall = TRUE, + over_variables = TRUE, + attributes = TRUE, + total_n = TRUE ) + ard_full <- add_hierarchical_unobserved_levels(ard_opts, levels = levels_all) + + # an added AE has a row per arm and an overall row, all under its SOC expect_equal( - out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "N"][[1L]], - 30 - ) - # proportion is left as NaN (0 / 0 is undefined), not asserted as zero - expect_true( - is.nan(out$stat[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "p"][[1L]]) + ard_full |> + dplyr::filter(variable == "AEDECOD", variable_level %in% list("GLAUCOMA"), stat_name == "n") |> + dplyr::select(all_ard_groups()) |> + unlist_ard_columns() |> + as.data.frame(), + data.frame( + group1 = c("TRTA", "TRTA", "TRTA", "AESOC"), + group1_level = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose", "EYE DISORDERS"), + group2 = c("AESOC", "AESOC", "AESOC", NA), + group2_level = c("EYE DISORDERS", "EYE DISORDERS", "EYE DISORDERS", NA) + ), + ignore_attr = "args" ) + + # the rows that do not depend on the levels are unchanged + other_rows <- \(x) dplyr::filter(x, context %in% c("attributes", "total_n") | variable == "..ard_hierarchical_overall..") + expect_equal(other_rows(ard_full), other_rows(ard_opts)) }) -test_that("add_hierarchical_unobserved_levels() completes nested levels under observed parents", { - ard <- make_ard() - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame( - SOC = c("Cardiac", "Cardiac", "Cardiac", "GI", "GI", "GI"), - PT = c("PT1", "PT2", "PT3", "PT1", "PT2", "PT3") - ) +test_that("add_hierarchical_unobserved_levels() works with `include`", { + ard_ae <- ard_stack_hierarchical( + data = ADAE_observed, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID, + include = AEDECOD ) + ard_full <- add_hierarchical_unobserved_levels(ard_ae, levels = levels_all) - # the unobserved PT3 is filled under each observed parent - for (parent in c("Cardiac", "GI")) { - expect_true( - "PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == parent]) - ) - } + # AE rows are added under their SOC, and no SOC summary rows are created + expect_equal(ae_rows(ard_full), expected_ae_rows) + expect_false("AESOC" %in% ard_full$variable) }) -test_that("add_hierarchical_unobserved_levels() adds children of a missing parent", { - ard <- make_ard() - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame(SOC = c("Vascular", "Vascular"), PT = c("PTX", "PTY")) - ) - - # the unobserved parent is added at the top level - expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) - # and its children are added underneath it - kids <- out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"] - expect_setequal(unique(lvl1(kids)), c("PTX", "PTY")) - expect_true(all( - unlist(out$stat[out$variable == "PT" & lvl1(out$group1_level) == "Vascular" & out$stat_name == "n"]) == 0 - )) +test_that("add_hierarchical_unobserved_levels() works with ard_stack_hierarchical_count()", { + ard_count <- ard_stack_hierarchical_count( + data = ADAE_observed, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL + ) + ard_full <- add_hierarchical_unobserved_levels(ard_count, levels = levels_all) + + expect_equal(ae_rows(ard_full), expected_ae_rows) + + # an added level only has the `n` statistic, set to 0 + ard_eye <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("EYE DISORDERS")) + expect_identical(unique(ard_eye$stat_name), "n") + expect_identical(unique(ard_eye$stat), list(0L)) }) -test_that("add_hierarchical_unobserved_levels() adds a missing child of an observed parent", { - ard <- make_ard() - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame(SOC = c("Cardiac", "Cardiac", "Cardiac"), PT = c("PT1", "PT2", "PT3")) +test_that("add_hierarchical_unobserved_levels() works with three hierarchy variables", { + ard_sev <- ard_stack_hierarchical( + data = ADAE_subset, + variables = c(AESOC, AEDECOD, AESEV), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID + ) + # no severe GLAUCOMA is reported + ard_full <- add_hierarchical_unobserved_levels( + ard_sev, + levels = data.frame(AESOC = "EYE DISORDERS", AEDECOD = "GLAUCOMA", AESEV = "SEVERE") ) - expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) - expect_equal( - out$stat[out$variable == "PT" & lvl1(out$variable_level) == "PT3" & - lvl1(out$group1_level) == "Cardiac" & out$stat_name == "n"][[1L]], - 0 + # only the severity is added, a row per arm and statistic, under its SOC and AE + expect_equal(nrow(ard_full), nrow(ard_sev) + 9L) + ard_severe <- dplyr::filter( + ard_full, + variable == "AESEV", variable_level %in% list("SEVERE"), group3_level %in% list("GLAUCOMA") ) + expect_equal(unique(unlist(ard_severe$group2_level)), "EYE DISORDERS") + expect_identical(unique(ard_severe$stat[ard_severe$stat_name == "n"]), list(0L)) }) -test_that("add_hierarchical_unobserved_levels() completes parents and children in one call", { - ard <- make_ard() - levels <- data.frame( - SOC = c("Vascular", "Vascular", "Cardiac"), - PT = c("PTX", "PTY", "PT3") +test_that("add_hierarchical_unobserved_levels() keeps factor levels as factors", { + # the factor levels are the observed ones only, so the added levels are new + ard_fct <- ADAE_observed |> + dplyr::mutate(AESOC = factor(AESOC), AEDECOD = factor(AEDECOD)) |> + ard_stack_hierarchical( + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID + ) + ard_full <- add_hierarchical_unobserved_levels(ard_fct, levels = levels_all) + + # added levels are factors too, so the level columns still unlist to factors + expect_s3_class(unlist(ard_full$variable_level[ard_full$variable == "AESOC"]), "factor") + expect_s3_class(unlist(ard_full$group2_level[ard_full$variable == "AEDECOD"]), "factor") + expect_equal(ae_rows(ard_full), expected_ae_rows) +}) + +test_that("add_hierarchical_unobserved_levels() keeps `p` as NaN in an empty `by` group", { + # "Arm Z" has no subjects, so N = 0 and p = 0 / 0 + arm_levels <- c(sort(unique(cards::ADSL$TRTA)), "Arm Z") + ard_z <- ard_stack_hierarchical( + data = dplyr::mutate(ADAE_observed, TRTA = factor(TRTA, levels = arm_levels)), + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = dplyr::mutate(cards::ADSL, TRTA = factor(TRTA, levels = arm_levels)), + id = USUBJID ) - out <- add_hierarchical_unobserved_levels(ard, levels = levels) + ard_full <- add_hierarchical_unobserved_levels(ard_z, levels = levels_all) - expect_true("Vascular" %in% lvl1(out$variable_level[out$variable == "SOC"])) - expect_setequal( - unique(lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Vascular"])), - c("PTX", "PTY") + ard_eye_p <- dplyr::filter( + ard_full, + variable == "AESOC", variable_level %in% list("EYE DISORDERS"), stat_name == "p" ) - expect_true("PT3" %in% lvl1(out$variable_level[out$variable == "PT" & lvl1(out$group1_level) == "Cardiac"])) + expect_equal(unlist(ard_eye_p$stat), c(0, 0, 0, NaN)) }) -test_that("add_hierarchical_unobserved_levels() preserves the by structure", { - ard <- make_ard(by = TRUE) - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame(SOC = "Vascular", PT = "PTX") +test_that("add_hierarchical_unobserved_levels() formats the added levels of a formatted ARD", { + ard_full <- add_hierarchical_unobserved_levels(apply_fmt_fun(ard), levels = levels_all) + + ard_eye <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("EYE DISORDERS")) + expect_equal(unlist(ard_eye$stat_fmt[ard_eye$stat_name %in% c("n", "p")]), rep(c("0", "0.0"), times = 3L)) +}) + +test_that("add_hierarchical_unobserved_levels() errors with incorrect inputs", { + # `x` is not a stacked hierarchical ARD + expect_snapshot( + add_hierarchical_unobserved_levels(ard_tabulate(cards::ADSL, variables = AGEGR1), levels = levels_all), + error = TRUE ) - # one Vascular SOC row per by-group, with the arm retained in group1 - vasc_soc <- out[out$variable == "SOC" & lvl1(out$variable_level) == "Vascular" & out$stat_name == "n", ] - expect_equal(nrow(vasc_soc), 2L) - expect_setequal(lvl1(vasc_soc$group1_level), c("A", "B")) + # `levels` is not a data frame + expect_snapshot( + add_hierarchical_unobserved_levels(ard, levels = "EYE DISORDERS"), + error = TRUE + ) - # one Vascular > PTX row per by-group, with the parent SOC in group2 - vasc_pt <- out[out$variable == "PT" & lvl1(out$variable_level) == "PTX" & out$stat_name == "n", ] - expect_equal(nrow(vasc_pt), 2L) - expect_setequal(lvl1(vasc_pt$group2_level), c("Vascular")) -}) + # a column of `levels` is not a hierarchy variable + expect_snapshot( + add_hierarchical_unobserved_levels(ard, levels = data.frame(TRTA = "Placebo")), + error = TRUE + ) -test_that("add_hierarchical_unobserved_levels() is a no-op when nothing is missing", { - ard <- make_ard() - # every combination in `levels` is already observed, so the input is unchanged - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame( - SOC = c("Cardiac", "Cardiac", "GI", "GI"), - PT = c("PT1", "PT2", "PT1", "PT2") - ) + # the columns of `levels` do not start from the top of the hierarchy + expect_snapshot( + add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(levels_all, AEDECOD)), + error = TRUE ) - expect_equal(nrow(out), nrow(ard)) -}) -test_that("add_hierarchical_unobserved_levels() input checks", { - ard <- make_ard() - expect_error( - add_hierarchical_unobserved_levels(data.frame(a = 1), levels = data.frame(SOC = "X")), - class = "check_class" + # `levels` has missing values + expect_snapshot( + add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = NA_character_)), + error = TRUE ) - expect_error( - add_hierarchical_unobserved_levels(ard, levels = "not a data frame"), - class = "check_data_frame" + + # a level of the wrong type + expect_snapshot( + add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = 1)), + error = TRUE ) - # a column that is not a hierarchical variable in the ARD is rejected - expect_error( - add_hierarchical_unobserved_levels(ard, levels = data.frame(NOTAVAR = "X")), - "Unknown column" + + # a statistic with no known value for an unobserved level + ard_cum <- ard + ard_cum$stat_name[ard_cum$variable == "AESOC" & ard_cum$stat_name == "N"] <- "n_cum" + expect_snapshot( + add_hierarchical_unobserved_levels(ard_cum, levels = levels_all), + error = TRUE ) -}) -test_that("add_hierarchical_unobserved_levels() output remains a valid ARD", { - ard <- make_ard() - out <- add_hierarchical_unobserved_levels( - ard, - levels = data.frame(SOC = "Vascular", PT = "PTX") + # `x` has no rows to copy for a variable + expect_snapshot( + add_hierarchical_unobserved_levels(dplyr::filter(ard, variable != "AEDECOD"), levels = levels_all), + error = TRUE ) - expect_no_error(sort_ard_hierarchical(out)) }) From ce9b435f2feea808acec53425cef9e2b0baedefa Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 28 Oct 2026 17:18:00 +0000 Subject: [PATCH 09/10] Check the statistics of every added row in the tests A wrong `N` on the added AE rows, or on an added overall row, passed every test before: only the added SOC rows had their `n`, `N` and `p` checked. Now every added SOC and AE row is checked, and so is the `N` of the arm and overall rows with `overall = TRUE`. --- .../test-add_hierarchical_unobserved_levels.R | 28 ++++++++++++++----- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-add_hierarchical_unobserved_levels.R b/tests/testthat/test-add_hierarchical_unobserved_levels.R index 61f399f71..4b1cb14f8 100644 --- a/tests/testthat/test-add_hierarchical_unobserved_levels.R +++ b/tests/testthat/test-add_hierarchical_unobserved_levels.R @@ -34,13 +34,19 @@ test_that("add_hierarchical_unobserved_levels() works", { # each SOC/AE combination has a row per arm, under its SOC expect_equal(ae_rows(ard_full), expected_ae_rows) - # an added level has n = 0, the N of its arm, and p = 0 - ard_eye <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("EYE DISORDERS")) - ard_cardiac <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("CARDIAC DISORDERS")) - expect_identical(unique(ard_eye$stat[ard_eye$stat_name == "n"]), list(0L)) - expect_identical(unique(ard_eye$stat[ard_eye$stat_name == "p"]), list(0)) - expect_identical(ard_eye$group1_level, ard_cardiac$group1_level) - expect_identical(ard_eye$stat[ard_eye$stat_name == "N"], ard_cardiac$stat[ard_cardiac$stat_name == "N"]) + # every added level, SOC or AE, has n = 0, the N of its arm, and p = 0 + ard_added <- dplyr::filter( + ard_full, + variable %in% c("AESOC", "AEDECOD"), + !variable_level %in% list("CARDIAC DISORDERS", "MYOCARDIAL INFARCTION", "SINUS BRADYCARDIA") + ) + expect_equal(nrow(ard_added), 26L * 3L * 3L) # 1 SOC and 25 AEs, in 3 arms, with n, N and p + expect_identical(unique(ard_added$stat[ard_added$stat_name == "n"]), list(0L)) + expect_identical(unique(ard_added$stat[ard_added$stat_name == "p"]), list(0)) + expect_equal( + ard_added |> dplyr::filter(stat_name == "N") |> dplyr::distinct(group1_level, stat), + ard |> dplyr::filter(variable == "AESOC", stat_name == "N") |> dplyr::distinct(group1_level, stat) + ) # the rows of `x` are unchanged: removing the zero-count levels gives back `x` expect_equal(filter_ard_hierarchical(ard_full, sum(n) > 0), ard) @@ -100,6 +106,14 @@ test_that("add_hierarchical_unobserved_levels() works with `overall`, `over_vari ), ignore_attr = "args" ) + # with the N of each arm, and of all subjects in the overall row + expect_equal( + ard_full |> + dplyr::filter(variable == "AEDECOD", variable_level %in% list("GLAUCOMA"), stat_name == "N") |> + dplyr::pull(stat) |> + unlist(), + unname(c(table(cards::ADSL$TRTA), nrow(cards::ADSL))) + ) # the rows that do not depend on the levels are unchanged other_rows <- \(x) dplyr::filter(x, context %in% c("attributes", "total_n") | variable == "..ard_hierarchical_overall..") From dd9d7a607309f5fad037e06ea4b5a80d965902c1 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 28 Oct 2026 17:20:05 +0000 Subject: [PATCH 10/10] Rename `add_hierarchical_unobserved_levels()` back to `add_hierarchical_zero_rows()` As agreed in the PR discussion. The help page title now matches the other stacked hierarchical helpers. --- NAMESPACE | 2 +- NEWS.md | 2 +- ..._levels.R => add_hierarchical_zero_rows.R} | 14 ++-- _pkgdown.yml | 2 +- ...evels.Rd => add_hierarchical_zero_rows.Rd} | 16 ++--- .../add_hierarchical_unobserved_levels.md | 70 ------------------- .../_snaps/add_hierarchical_zero_rows.md | 68 ++++++++++++++++++ ...ls.R => test-add_hierarchical_zero_rows.R} | 60 ++++++++-------- 8 files changed, 116 insertions(+), 118 deletions(-) rename R/{add_hierarchical_unobserved_levels.R => add_hierarchical_zero_rows.R} (94%) rename man/{add_hierarchical_unobserved_levels.Rd => add_hierarchical_zero_rows.Rd} (83%) delete mode 100644 tests/testthat/_snaps/add_hierarchical_unobserved_levels.md create mode 100644 tests/testthat/_snaps/add_hierarchical_zero_rows.md rename tests/testthat/{test-add_hierarchical_unobserved_levels.R => test-add_hierarchical_zero_rows.R} (75%) diff --git a/NAMESPACE b/NAMESPACE index 754fff04c..437a50106 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,7 @@ S3method(process_selectors,data.frame) S3method(tibble::tbl_sum,card) export("%>%") export(add_calculated_row) -export(add_hierarchical_unobserved_levels) +export(add_hierarchical_zero_rows) export(alias_as_fmt_fn) export(alias_as_fmt_fun) export(all_ard_group_n) diff --git a/NEWS.md b/NEWS.md index db53f896c..78c9eca8b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ## New Features and Functions -* Added `add_hierarchical_unobserved_levels()` to add zero-count rows to `ard_stack_hierarchical()` and `ard_stack_hierarchical_count()` results for the level combinations that do not occur in the data, e.g. an SOC with no events. The expected combinations are passed as a data frame with columns named after the hierarchy variables. (#602, @Melkiades) +* Added `add_hierarchical_zero_rows()` to add zero-count rows to `ard_stack_hierarchical()` and `ard_stack_hierarchical_count()` results for the level combinations that do not occur in the data, e.g. an SOC with no events. The expected combinations are passed as a data frame with columns named after the hierarchy variables. (#602, @Melkiades) ## Bug Fixes diff --git a/R/add_hierarchical_unobserved_levels.R b/R/add_hierarchical_zero_rows.R similarity index 94% rename from R/add_hierarchical_unobserved_levels.R rename to R/add_hierarchical_zero_rows.R index f27cb136f..a62b115ef 100644 --- a/R/add_hierarchical_unobserved_levels.R +++ b/R/add_hierarchical_zero_rows.R @@ -1,11 +1,11 @@ -#' Add Unobserved Levels to Hierarchical ARDs +#' Add Zero Rows to Stacked Hierarchical ARDs #' #' @description `r lifecycle::badge('experimental')`\cr #' #' A stacked hierarchical ARD only has rows for the levels observed in the data: #' an SOC with no events, or an AE never reported under an SOC, has no rows. #' -#' `add_hierarchical_unobserved_levels()` adds these rows. Pass the level +#' `add_hierarchical_zero_rows()` adds these rows. Pass the level #' combinations you expect in `levels`: each combination missing from `x` is #' added with `n = 0`, the denominator `N` of its `by` group, and `p = 0`. As in #' the rest of the ARD, `p` is `NaN` only when the `by` group is empty (`N = 0`). @@ -28,7 +28,7 @@ #' #' @return an ARD data frame of class 'card' #' @seealso [sort_ard_hierarchical()] -#' @name add_hierarchical_unobserved_levels +#' @name add_hierarchical_zero_rows #' #' @examplesIf (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) #' # AEs of two SOCs: no severe AE is reported for EYE DISORDERS, @@ -46,15 +46,15 @@ #' ) #' #' # add the SOC with no severe AEs -#' add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC)) +#' add_hierarchical_zero_rows(ard, levels = dplyr::distinct(adae, AESOC)) #' #' # add every SOC/AE combination of the two SOCs -#' add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) +#' add_hierarchical_zero_rows(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) NULL -#' @rdname add_hierarchical_unobserved_levels +#' @rdname add_hierarchical_zero_rows #' @export -add_hierarchical_unobserved_levels <- function(x, levels) { +add_hierarchical_zero_rows <- function(x, levels) { set_cli_abort_call() # check inputs --------------------------------------------------------------- diff --git a/_pkgdown.yml b/_pkgdown.yml index 58f68c99a..992455cd2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -83,7 +83,7 @@ reference: - as_cards_fn - subtitle: "Wrangle ARD" contents: - - add_hierarchical_unobserved_levels + - add_hierarchical_zero_rows - diff_ard_hierarchical - filter_ard_hierarchical - sort_ard_hierarchical diff --git a/man/add_hierarchical_unobserved_levels.Rd b/man/add_hierarchical_zero_rows.Rd similarity index 83% rename from man/add_hierarchical_unobserved_levels.Rd rename to man/add_hierarchical_zero_rows.Rd index 7446abacb..9de9ffb42 100644 --- a/man/add_hierarchical_unobserved_levels.Rd +++ b/man/add_hierarchical_zero_rows.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_hierarchical_unobserved_levels.R -\name{add_hierarchical_unobserved_levels} -\alias{add_hierarchical_unobserved_levels} -\title{Add Unobserved Levels to Hierarchical ARDs} +% Please edit documentation in R/add_hierarchical_zero_rows.R +\name{add_hierarchical_zero_rows} +\alias{add_hierarchical_zero_rows} +\title{Add Zero Rows to Stacked Hierarchical ARDs} \usage{ -add_hierarchical_unobserved_levels(x, levels) +add_hierarchical_zero_rows(x, levels) } \arguments{ \item{x}{(\code{card})\cr @@ -25,7 +25,7 @@ an ARD data frame of class 'card' A stacked hierarchical ARD only has rows for the levels observed in the data: an SOC with no events, or an AE never reported under an SOC, has no rows. -\code{add_hierarchical_unobserved_levels()} adds these rows. Pass the level +\code{add_hierarchical_zero_rows()} adds these rows. Pass the level combinations you expect in \code{levels}: each combination missing from \code{x} is added with \code{n = 0}, the denominator \code{N} of its \code{by} group, and \code{p = 0}. As in the rest of the ARD, \code{p} is \code{NaN} only when the \code{by} group is empty (\code{N = 0}). @@ -55,10 +55,10 @@ ard <- adae |> ) # add the SOC with no severe AEs -add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC)) +add_hierarchical_zero_rows(ard, levels = dplyr::distinct(adae, AESOC)) # add every SOC/AE combination of the two SOCs -add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) +add_hierarchical_zero_rows(ard, levels = dplyr::distinct(adae, AESOC, AEDECOD)) \dontshow{\}) # examplesIf} } \seealso{ diff --git a/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md b/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md deleted file mode 100644 index 860bebefa..000000000 --- a/tests/testthat/_snaps/add_hierarchical_unobserved_levels.md +++ /dev/null @@ -1,70 +0,0 @@ -# add_hierarchical_unobserved_levels() errors with incorrect inputs - - Code - add_hierarchical_unobserved_levels(ard_tabulate(cards::ADSL, variables = AGEGR1), - levels = levels_all) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! The `x` argument must be class , not a object. - ---- - - Code - add_hierarchical_unobserved_levels(ard, levels = "EYE DISORDERS") - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! The `levels` argument must be class , not a string. - ---- - - Code - add_hierarchical_unobserved_levels(ard, levels = data.frame(TRTA = "Placebo")) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. - i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". - ---- - - Code - add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(levels_all, - AEDECOD)) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. - i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". - ---- - - Code - add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = NA_character_)) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! The `levels` argument cannot contain missing values. - ---- - - Code - add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = 1)) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! Can't convert `levels$AESOC` to . - ---- - - Code - add_hierarchical_unobserved_levels(ard_cum, levels = levels_all) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! Cannot add unobserved levels to an ARD with the "n_cum" statistic. - i Only the "n", "N", and "p" statistics can be set for an unobserved level. - ---- - - Code - add_hierarchical_unobserved_levels(dplyr::filter(ard, variable != "AEDECOD"), - levels = levels_all) - Condition - Error in `add_hierarchical_unobserved_levels()`: - ! Cannot add levels for "AEDECOD": `x` has no rows for this variable to copy. - diff --git a/tests/testthat/_snaps/add_hierarchical_zero_rows.md b/tests/testthat/_snaps/add_hierarchical_zero_rows.md new file mode 100644 index 000000000..79c54ded9 --- /dev/null +++ b/tests/testthat/_snaps/add_hierarchical_zero_rows.md @@ -0,0 +1,68 @@ +# add_hierarchical_zero_rows() errors with incorrect inputs + + Code + add_hierarchical_zero_rows(ard_tabulate(cards::ADSL, variables = AGEGR1), + levels = levels_all) + Condition + Error in `add_hierarchical_zero_rows()`: + ! The `x` argument must be class , not a object. + +--- + + Code + add_hierarchical_zero_rows(ard, levels = "EYE DISORDERS") + Condition + Error in `add_hierarchical_zero_rows()`: + ! The `levels` argument must be class , not a string. + +--- + + Code + add_hierarchical_zero_rows(ard, levels = data.frame(TRTA = "Placebo")) + Condition + Error in `add_hierarchical_zero_rows()`: + ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. + i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". + +--- + + Code + add_hierarchical_zero_rows(ard, levels = dplyr::distinct(levels_all, AEDECOD)) + Condition + Error in `add_hierarchical_zero_rows()`: + ! The columns of `levels` must be hierarchy variables of `x`, starting from the top. + i The hierarchy variables of `x`, from the top, are "AESOC" and "AEDECOD". + +--- + + Code + add_hierarchical_zero_rows(ard, levels = data.frame(AESOC = NA_character_)) + Condition + Error in `add_hierarchical_zero_rows()`: + ! The `levels` argument cannot contain missing values. + +--- + + Code + add_hierarchical_zero_rows(ard, levels = data.frame(AESOC = 1)) + Condition + Error in `add_hierarchical_zero_rows()`: + ! Can't convert `levels$AESOC` to . + +--- + + Code + add_hierarchical_zero_rows(ard_cum, levels = levels_all) + Condition + Error in `add_hierarchical_zero_rows()`: + ! Cannot add unobserved levels to an ARD with the "n_cum" statistic. + i Only the "n", "N", and "p" statistics can be set for an unobserved level. + +--- + + Code + add_hierarchical_zero_rows(dplyr::filter(ard, variable != "AEDECOD"), levels = levels_all) + Condition + Error in `add_hierarchical_zero_rows()`: + ! Cannot add levels for "AEDECOD": `x` has no rows for this variable to copy. + diff --git a/tests/testthat/test-add_hierarchical_unobserved_levels.R b/tests/testthat/test-add_hierarchical_zero_rows.R similarity index 75% rename from tests/testthat/test-add_hierarchical_unobserved_levels.R rename to tests/testthat/test-add_hierarchical_zero_rows.R index 4b1cb14f8..497ff5870 100644 --- a/tests/testthat/test-add_hierarchical_unobserved_levels.R +++ b/tests/testthat/test-add_hierarchical_zero_rows.R @@ -28,8 +28,8 @@ ae_rows <- function(x) { } expected_ae_rows <- sort(rep(paste(levels_all$AESOC, levels_all$AEDECOD, sep = " / "), times = 3L)) -test_that("add_hierarchical_unobserved_levels() works", { - expect_silent(ard_full <- add_hierarchical_unobserved_levels(ard, levels = levels_all)) +test_that("add_hierarchical_zero_rows() works", { + expect_silent(ard_full <- add_hierarchical_zero_rows(ard, levels = levels_all)) # each SOC/AE combination has a row per arm, under its SOC expect_equal(ae_rows(ard_full), expected_ae_rows) @@ -56,13 +56,13 @@ test_that("add_hierarchical_unobserved_levels() works", { # the column order of `levels` does not matter expect_equal( - add_hierarchical_unobserved_levels(ard, levels = levels_all[c("AEDECOD", "AESOC")]), + add_hierarchical_zero_rows(ard, levels = levels_all[c("AEDECOD", "AESOC")]), ard_full ) }) -test_that("add_hierarchical_unobserved_levels() adds the top level only", { - ard_soc <- add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(ADAE_subset, AESOC)) +test_that("add_hierarchical_zero_rows() adds the top level only", { + ard_soc <- add_hierarchical_zero_rows(ard, levels = dplyr::distinct(ADAE_subset, AESOC)) # EYE DISORDERS is added, a row per arm and statistic, with no AE rows under it expect_equal(nrow(ard_soc), nrow(ard) + 9L) @@ -70,14 +70,14 @@ test_that("add_hierarchical_unobserved_levels() adds the top level only", { expect_equal(ae_rows(ard_soc), ae_rows(ard)) }) -test_that("add_hierarchical_unobserved_levels() returns `x` unchanged when no level is missing", { +test_that("add_hierarchical_zero_rows() returns `x` unchanged when no level is missing", { expect_identical( - add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(ADAE_observed, AESOC, AEDECOD)), + add_hierarchical_zero_rows(ard, levels = dplyr::distinct(ADAE_observed, AESOC, AEDECOD)), ard ) }) -test_that("add_hierarchical_unobserved_levels() works with `overall`, `over_variables`, `attributes` and `total_n`", { +test_that("add_hierarchical_zero_rows() works with `overall`, `over_variables`, `attributes` and `total_n`", { ard_opts <- ard_stack_hierarchical( data = ADAE_observed, variables = c(AESOC, AEDECOD), @@ -89,7 +89,7 @@ test_that("add_hierarchical_unobserved_levels() works with `overall`, `over_vari attributes = TRUE, total_n = TRUE ) - ard_full <- add_hierarchical_unobserved_levels(ard_opts, levels = levels_all) + ard_full <- add_hierarchical_zero_rows(ard_opts, levels = levels_all) # an added AE has a row per arm and an overall row, all under its SOC expect_equal( @@ -120,7 +120,7 @@ test_that("add_hierarchical_unobserved_levels() works with `overall`, `over_vari expect_equal(other_rows(ard_full), other_rows(ard_opts)) }) -test_that("add_hierarchical_unobserved_levels() works with `include`", { +test_that("add_hierarchical_zero_rows() works with `include`", { ard_ae <- ard_stack_hierarchical( data = ADAE_observed, variables = c(AESOC, AEDECOD), @@ -129,21 +129,21 @@ test_that("add_hierarchical_unobserved_levels() works with `include`", { id = USUBJID, include = AEDECOD ) - ard_full <- add_hierarchical_unobserved_levels(ard_ae, levels = levels_all) + ard_full <- add_hierarchical_zero_rows(ard_ae, levels = levels_all) # AE rows are added under their SOC, and no SOC summary rows are created expect_equal(ae_rows(ard_full), expected_ae_rows) expect_false("AESOC" %in% ard_full$variable) }) -test_that("add_hierarchical_unobserved_levels() works with ard_stack_hierarchical_count()", { +test_that("add_hierarchical_zero_rows() works with ard_stack_hierarchical_count()", { ard_count <- ard_stack_hierarchical_count( data = ADAE_observed, variables = c(AESOC, AEDECOD), by = TRTA, denominator = cards::ADSL ) - ard_full <- add_hierarchical_unobserved_levels(ard_count, levels = levels_all) + ard_full <- add_hierarchical_zero_rows(ard_count, levels = levels_all) expect_equal(ae_rows(ard_full), expected_ae_rows) @@ -153,7 +153,7 @@ test_that("add_hierarchical_unobserved_levels() works with ard_stack_hierarchica expect_identical(unique(ard_eye$stat), list(0L)) }) -test_that("add_hierarchical_unobserved_levels() works with three hierarchy variables", { +test_that("add_hierarchical_zero_rows() works with three hierarchy variables", { ard_sev <- ard_stack_hierarchical( data = ADAE_subset, variables = c(AESOC, AEDECOD, AESEV), @@ -162,7 +162,7 @@ test_that("add_hierarchical_unobserved_levels() works with three hierarchy varia id = USUBJID ) # no severe GLAUCOMA is reported - ard_full <- add_hierarchical_unobserved_levels( + ard_full <- add_hierarchical_zero_rows( ard_sev, levels = data.frame(AESOC = "EYE DISORDERS", AEDECOD = "GLAUCOMA", AESEV = "SEVERE") ) @@ -177,7 +177,7 @@ test_that("add_hierarchical_unobserved_levels() works with three hierarchy varia expect_identical(unique(ard_severe$stat[ard_severe$stat_name == "n"]), list(0L)) }) -test_that("add_hierarchical_unobserved_levels() keeps factor levels as factors", { +test_that("add_hierarchical_zero_rows() keeps factor levels as factors", { # the factor levels are the observed ones only, so the added levels are new ard_fct <- ADAE_observed |> dplyr::mutate(AESOC = factor(AESOC), AEDECOD = factor(AEDECOD)) |> @@ -187,7 +187,7 @@ test_that("add_hierarchical_unobserved_levels() keeps factor levels as factors", denominator = cards::ADSL, id = USUBJID ) - ard_full <- add_hierarchical_unobserved_levels(ard_fct, levels = levels_all) + ard_full <- add_hierarchical_zero_rows(ard_fct, levels = levels_all) # added levels are factors too, so the level columns still unlist to factors expect_s3_class(unlist(ard_full$variable_level[ard_full$variable == "AESOC"]), "factor") @@ -195,7 +195,7 @@ test_that("add_hierarchical_unobserved_levels() keeps factor levels as factors", expect_equal(ae_rows(ard_full), expected_ae_rows) }) -test_that("add_hierarchical_unobserved_levels() keeps `p` as NaN in an empty `by` group", { +test_that("add_hierarchical_zero_rows() keeps `p` as NaN in an empty `by` group", { # "Arm Z" has no subjects, so N = 0 and p = 0 / 0 arm_levels <- c(sort(unique(cards::ADSL$TRTA)), "Arm Z") ard_z <- ard_stack_hierarchical( @@ -205,7 +205,7 @@ test_that("add_hierarchical_unobserved_levels() keeps `p` as NaN in an empty `by denominator = dplyr::mutate(cards::ADSL, TRTA = factor(TRTA, levels = arm_levels)), id = USUBJID ) - ard_full <- add_hierarchical_unobserved_levels(ard_z, levels = levels_all) + ard_full <- add_hierarchical_zero_rows(ard_z, levels = levels_all) ard_eye_p <- dplyr::filter( ard_full, @@ -214,47 +214,47 @@ test_that("add_hierarchical_unobserved_levels() keeps `p` as NaN in an empty `by expect_equal(unlist(ard_eye_p$stat), c(0, 0, 0, NaN)) }) -test_that("add_hierarchical_unobserved_levels() formats the added levels of a formatted ARD", { - ard_full <- add_hierarchical_unobserved_levels(apply_fmt_fun(ard), levels = levels_all) +test_that("add_hierarchical_zero_rows() formats the added levels of a formatted ARD", { + ard_full <- add_hierarchical_zero_rows(apply_fmt_fun(ard), levels = levels_all) ard_eye <- dplyr::filter(ard_full, variable == "AESOC", variable_level %in% list("EYE DISORDERS")) expect_equal(unlist(ard_eye$stat_fmt[ard_eye$stat_name %in% c("n", "p")]), rep(c("0", "0.0"), times = 3L)) }) -test_that("add_hierarchical_unobserved_levels() errors with incorrect inputs", { +test_that("add_hierarchical_zero_rows() errors with incorrect inputs", { # `x` is not a stacked hierarchical ARD expect_snapshot( - add_hierarchical_unobserved_levels(ard_tabulate(cards::ADSL, variables = AGEGR1), levels = levels_all), + add_hierarchical_zero_rows(ard_tabulate(cards::ADSL, variables = AGEGR1), levels = levels_all), error = TRUE ) # `levels` is not a data frame expect_snapshot( - add_hierarchical_unobserved_levels(ard, levels = "EYE DISORDERS"), + add_hierarchical_zero_rows(ard, levels = "EYE DISORDERS"), error = TRUE ) # a column of `levels` is not a hierarchy variable expect_snapshot( - add_hierarchical_unobserved_levels(ard, levels = data.frame(TRTA = "Placebo")), + add_hierarchical_zero_rows(ard, levels = data.frame(TRTA = "Placebo")), error = TRUE ) # the columns of `levels` do not start from the top of the hierarchy expect_snapshot( - add_hierarchical_unobserved_levels(ard, levels = dplyr::distinct(levels_all, AEDECOD)), + add_hierarchical_zero_rows(ard, levels = dplyr::distinct(levels_all, AEDECOD)), error = TRUE ) # `levels` has missing values expect_snapshot( - add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = NA_character_)), + add_hierarchical_zero_rows(ard, levels = data.frame(AESOC = NA_character_)), error = TRUE ) # a level of the wrong type expect_snapshot( - add_hierarchical_unobserved_levels(ard, levels = data.frame(AESOC = 1)), + add_hierarchical_zero_rows(ard, levels = data.frame(AESOC = 1)), error = TRUE ) @@ -262,13 +262,13 @@ test_that("add_hierarchical_unobserved_levels() errors with incorrect inputs", { ard_cum <- ard ard_cum$stat_name[ard_cum$variable == "AESOC" & ard_cum$stat_name == "N"] <- "n_cum" expect_snapshot( - add_hierarchical_unobserved_levels(ard_cum, levels = levels_all), + add_hierarchical_zero_rows(ard_cum, levels = levels_all), error = TRUE ) # `x` has no rows to copy for a variable expect_snapshot( - add_hierarchical_unobserved_levels(dplyr::filter(ard, variable != "AEDECOD"), levels = levels_all), + add_hierarchical_zero_rows(dplyr::filter(ard, variable != "AEDECOD"), levels = levels_all), error = TRUE ) })