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 1/7] 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 2/7] 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 3/7] 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 4/7] 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 5/7] 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 6/7] 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 7/7] 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