From 0c9712f11b531929a1bdc7ce66f26d2d37dfed00 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 09:18:18 +0000 Subject: [PATCH 01/46] fix: decouple visual styling from tbl_hierarchical_rate_by_grade to prevent Cartesian join explosion tbl_hierarchical_rate_by_grade() was blanking the label column for grade rows before returning, causing tbl_merge() inside tbl_with_pools() to lose row uniqueness and produce a Cartesian cross-join. Split into two functions: - tbl_hierarchical_rate_by_grade(): returns structurally pristine table with unique label values, injects custom_info metadata - add_grade_column(): post-processing function that applies all visual formatting (label_grade column, label blanking, headers, indentation) Co-authored-by: Ona --- R/add_grade_column.R | 161 +++++++++++++++ R/tbl_hierarchical_rate_by_grade.R | 77 ++----- tests/testthat/_snaps/add_grade_column.md | 17 ++ .../_snaps/tbl_hierarchical_rate_by_grade.md | 140 +------------ tests/testthat/test-add_grade_column.R | 188 ++++++++++++++++++ .../test-tbl_hierarchical_rate_by_grade.R | 25 ++- tests/testthat/test-tbl_with_pools.R | 71 +++++++ 7 files changed, 478 insertions(+), 201 deletions(-) create mode 100644 R/add_grade_column.R create mode 100644 tests/testthat/_snaps/add_grade_column.md create mode 100644 tests/testthat/test-add_grade_column.R diff --git a/R/add_grade_column.R b/R/add_grade_column.R new file mode 100644 index 00000000..59c8a4a0 --- /dev/null +++ b/R/add_grade_column.R @@ -0,0 +1,161 @@ +#' Add Grade Column to Hierarchical Rate-by-Grade Tables +#' +#' @description +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function: +#' - Creates a `label_grade` column to display grade labels separately. +#' - Blanks the `label` column for grade-level rows. +#' - Removes statistics from non-summary rows (SOC label rows without rates). +#' - Applies indentation for grade levels within grade groups. +#' - Updates column headers and formatting. +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or `x$tbls[[1]]$custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' ## Intended Workflow +#' +#' ```r +#' # Standalone +#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() +#' +#' # With pooled columns +#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() +#' ``` +#' +#' @returns The input gtsummary table with grade column formatting applied. +#' @export +#' +#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") +#' ADSL <- cards::ADSL +#' ADAE_subset <- cards::ADAE |> +#' dplyr::filter( +#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], +#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] +#' ) +#' +#' grade_groups <- list( +#' "Grade 1-2" = c("1", "2"), +#' "Grade 3-4" = c("3", "4"), +#' "Grade 5" = "5" +#' ) +#' +#' # Standalone usage +#' tbl_hierarchical_rate_by_grade( +#' ADAE_subset, +#' variables = c(AEBODSYS, AEDECOD, AETOXGR), +#' denominator = ADSL, +#' by = TRTA, +#' grade_groups = grade_groups +#' ) |> +#' add_grade_column() +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # extract metadata: standalone vs merged table + + info <- x$custom_info %||% + tryCatch(x$tbls[[1]]$custom_info, error = function(e) NULL) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 14905dab..65e7ba25 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -41,6 +41,11 @@ #' A gtsummary table of class `'tbl_hierarchical_rate_by_grade'`. #' #' @details +#' This function returns a structurally pristine table where the `label` column retains unique grade text +#' (e.g., "1", "2", "Grade 1-2"). This preserves row uniqueness required by [gtsummary::tbl_merge()] and +#' [tbl_with_pools()]. To apply visual formatting (grade column, label blanking, header styling), pipe the +#' result through [add_grade_column()] **after** any merging operations. +#' #' When using the `filter` argument, the filter will be applied to the second variable from `variables`, i.e. the #' adverse event terms variable. If an AE does not meet the filtering criteria, the AE overall row as well as all grade #' and grade group rows within an AE section will be excluded from the table. Filtering out AEs does not exclude the @@ -81,7 +86,8 @@ #' ), #' grade_groups = grade_groups, #' grades_exclude = "5" -#' ) +#' ) |> +#' add_grade_column() #' #' # Example 2 ---------------------------------- #' # Filter: Keep AEs with an overall prevalence of greater than 10% @@ -93,7 +99,8 @@ #' grade_groups = list("Grades 1-2" = c("1", "2"), "Grades 3-5" = c("3", "4", "5")), #' filter = sum(n) / sum(N) > 0.10 #' ) |> -#' add_overall(last = TRUE) +#' add_overall(last = TRUE) |> +#' add_grade_column() NULL #' @export @@ -365,6 +372,7 @@ tbl_hierarchical_rate_by_grade <- function(data, } ) + # structural cleanup: remove duplicate/empty rows but preserve label uniqueness tbl_final <- tbl_final |> gtsummary::modify_table_body( \(table_body) { @@ -374,63 +382,10 @@ tbl_hierarchical_rate_by_grade <- function(data, # remove soc summary rows if all sub-rows filtered out dplyr::filter(!(.data$variable == soc & dplyr::lead(.data$variable) %in% c(soc, NA))) |> # remove rows for grades in grades_exclude - dplyr::filter(!.data$label %in% grades_exclude) |> - dplyr::rowwise() |> - # add label_grade column to display grade labels - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # remove grade levels from label column - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from summary rows if not an overall row - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() + dplyr::filter(!.data$label %in% grades_exclude) } - ) |> - # show label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header label - gtsummary::modify_header( - label ~ paste0(label[[soc]], " \n", paste0(rep("\U00A0", 4L), collapse = ""), label[[ae]]), - label_grade ~ label[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" ) - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - tbl_final <- tbl_final |> - gtsummary::modify_indent( - columns = "label_grade", rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - # return final table --------------------------------------------------------- tbl_final$call_list <- list(tbl_hierarchical_rate_by_grade = match.call()) tbl_final$cards <- list( @@ -438,6 +393,16 @@ tbl_hierarchical_rate_by_grade <- function(data, ) tbl_final$inputs <- tbl_hierarchical_rate_by_grade_inputs + # inject metadata for downstream post-processing by add_grade_column() + tbl_final$custom_info <- list( + soc = soc, + ae = ae, + grade = grade, + grade_groups = grade_groups, + lvls = lvls, + label_list = label + ) + tbl_final |> structure(class = c("tbl_hierarchical_rate_by_grade", "gtsummary")) } diff --git a/tests/testthat/_snaps/add_grade_column.md b/tests/testthat/_snaps/add_grade_column.md new file mode 100644 index 00000000..01732d50 --- /dev/null +++ b/tests/testthat/_snaps/add_grade_column.md @@ -0,0 +1,17 @@ +# add_grade_column() errors when custom_info is missing + + Code + add_grade_column(tbl) + Condition + Error in `add_grade_column()`: + ! No `custom_info` metadata found on the input table. + i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. + +# add_grade_column() errors on non-gtsummary input + + Code + add_grade_column(data.frame(x = 1)) + Condition + Error in `add_grade_column()`: + ! `x` must be a object. + diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index f723d1e8..01c47c77 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -1,139 +1,3 @@ -# tbl_hierarchical_rate_by_grade() works - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) - ---- - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - ---- - - Code - as.data.frame(tbl)[1, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% - -# tbl_hierarchical_rate_by_grade(include_overall) works - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - ---- - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) - 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) - 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) - # tbl_hierarchical_rate_by_grade() error messaging works Code @@ -142,14 +6,14 @@ grades_exclude = 4:5) Condition Error in `tbl_hierarchical_rate_by_grade()`: - ! The `grades_exclude` argument must be class or empty, not an integer vector. + ! `grades_exclude` must be a vector or empty. --- Code tbl <- tbl_hierarchical_rate_by_grade(ADAE_subset, variables = c(AEBODSYS, AEDECOD, AETOXGR), denominator = ADSL, by = TRTA, label = label, - grade_groups = list("Grade 5" ~ "5")) + grade_groups = list(`Grade 5` ~ "5")) Condition Error in `tbl_hierarchical_rate_by_grade()`: ! Grade groups must be specified via a named list where each list element is a character vector of the grades to include in the grade group and each name is the corresponding name of the grade group. For example, `"Grade 3-4" = c("3", "4")`. diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R new file mode 100644 index 00000000..b15204f6 --- /dev/null +++ b/tests/testthat/test-add_grade_column.R @@ -0,0 +1,188 @@ +skip_on_cran() + +ADSL <- cards::ADSL +ADAE_subset <- cards::ADAE |> + dplyr::filter( + AESOC %in% unique(cards::ADAE$AESOC)[1:5], + AETERM %in% unique(cards::ADAE$AETERM)[1:5] + ) + +label <- list( + AEBODSYS = "MedDRA System Organ Class", + AEDECOD = "MedDRA Preferred Term", + AETOXGR = "Grade" +) + +grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4"), + "Grade 5" = "5" +) + +# --- 1. Standalone table formatting ------------------------------------------ +test_that("add_grade_column() works on a standalone tbl_hierarchical_rate_by_grade", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + # before add_grade_column: no label_grade column, label not blanked + expect_false("label_grade" %in% names(tbl$table_body)) + expect_true(any(tbl$table_body$label %in% as.character(1:5))) + + result <- tbl |> add_grade_column() + + # after add_grade_column: label_grade exists, grade labels blanked from label + expect_true("label_grade" %in% names(result$table_body)) + + # grade rows have blank label + grade_rows <- result$table_body$variable == "AETOXGR" + expect_true(all(result$table_body$label[grade_rows] == "")) + + # label_grade has grade text for grade rows + expect_true(all(result$table_body$label_grade[grade_rows] != "")) + + # AE rows get "- Any Grade -" + ae_rows <- result$table_body$variable == "AEDECOD" + expect_true(all(result$table_body$label_grade[ae_rows] == "- Any Grade -")) + + # SOC label rows get empty label_grade (not "- Any Grade -") + soc_rows <- result$table_body$variable == "AEBODSYS" & + result$table_body$label != "- Any adverse events -" + expect_true(all(result$table_body$label_grade[soc_rows] == "")) +}) + +# --- 2. Standalone without grade groups -------------------------------------- +test_that("add_grade_column() works without grade groups", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label + ) + + result <- tbl |> add_grade_column() + + expect_true("label_grade" %in% names(result$table_body)) + # no indentation styling for grade groups since none defined + indent_rows <- result$table_styling$indent |> + dplyr::filter(column == "label_grade") + # only default indentation, no grade-group-specific indent + expect_true(nrow(indent_rows) == 0 || !any(indent_rows$indent == 4L)) +}) + +# --- 3. Metadata extraction from merged tables -------------------------------- +test_that("add_grade_column() extracts custom_info from merged tables", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + # simulate a merged table structure + merged <- gtsummary::tbl_merge( + tbls = list(tbl, tbl), + tab_spanner = FALSE, + quiet = TRUE + ) + + result <- merged |> add_grade_column() + expect_true("label_grade" %in% names(result$table_body)) +}) + +# --- 4. Error when no custom_info metadata ------------------------------------ +test_that("add_grade_column() errors when custom_info is missing", { + # use a plain gtsummary table with no custom_info + tbl <- gtsummary::tbl_summary(cards::ADSL, include = AGE) + + expect_snapshot( + add_grade_column(tbl), + error = TRUE + ) +}) + +# --- 5. Error when input is not gtsummary ------------------------------------ +test_that("add_grade_column() errors on non-gtsummary input", { + expect_snapshot( + add_grade_column(data.frame(x = 1)), + error = TRUE + ) +}) + +# --- 6. Stats blanking for non-summary rows ----------------------------------- +test_that("add_grade_column() blanks stats for SOC label rows", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # SOC label rows (not "- Any adverse events -") should have NA stats + soc_label_rows <- result$table_body |> + dplyr::filter( + variable == "AEBODSYS", + label != "- Any adverse events -" + ) + + stat_cols <- names(soc_label_rows)[grepl("^stat_", names(soc_label_rows))] + for (col in stat_cols) { + expect_true(all(is.na(soc_label_rows[[col]]))) + } +}) + +# --- 7. Zero formatting ("0 (0.0%)" -> "0") ---------------------------------- +test_that("add_grade_column() recodes zero statistics", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # check that post_fmt_fun is set (the actual recoding happens at render time) + expect_true(nrow(result$table_styling$post_fmt_fun) > 0) +}) + +# --- 8. Header labels are set correctly -------------------------------------- +test_that("add_grade_column() sets correct header labels", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # label_grade header should be the grade label + lg_header <- result$table_styling$header |> + dplyr::filter(column == "label_grade") |> + dplyr::pull(label) + expect_equal(lg_header, "Grade") + + # label header should combine SOC and AE labels + lbl_header <- result$table_styling$header |> + dplyr::filter(column == "label") |> + dplyr::pull(label) + expect_true(grepl("MedDRA System Organ Class", lbl_header)) + expect_true(grepl("MedDRA Preferred Term", lbl_header)) +}) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 001f7551..96aea1a5 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -33,7 +33,18 @@ test_that("tbl_hierarchical_rate_by_grade() works", { label = label ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + + # custom_info metadata is injected for add_grade_column() + + expect_true(!is.null(tbl$custom_info)) + expect_equal(tbl$custom_info$soc, "AEBODSYS") + expect_equal(tbl$custom_info$ae, "AEDECOD") + expect_equal(tbl$custom_info$grade, "AETOXGR") + + # label column retains grade text (not blanked) for merge safety + expect_true(any(tbl$table_body$label %in% as.character(1:5))) + + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # with grade groups expect_silent( @@ -47,7 +58,7 @@ test_that("tbl_hierarchical_rate_by_grade() works", { grade_groups = grade_groups ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # no by, no label expect_silent( @@ -72,7 +83,7 @@ test_that("tbl_hierarchical_rate_by_grade() works", { digits = everything() ~ list(n = label_roche_number(digits = 1, decimal.mark = ","), p = 3) ) ) - expect_snapshot(as.data.frame(tbl)[1, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1, ]) }) test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { @@ -91,7 +102,7 @@ test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { include_overall = everything() ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # all overall sections removed expect_silent( @@ -106,7 +117,7 @@ test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { include_overall = NULL ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) }) test_that("tbl_hierarchical_rate_by_grade() works with add_overall()", { @@ -310,7 +321,7 @@ test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { expect_identical( tbl_excl$table_body, tbl_no_excl$table_body |> - dplyr::filter(label_grade != "5") + dplyr::filter(label != "5") ) # all grades excluded @@ -329,7 +340,7 @@ test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { expect_identical( tbl_excl$table_body, tbl_no_excl$table_body |> - dplyr::filter(!label_grade %in% as.character(1:5)) + dplyr::filter(!label %in% as.character(1:5)) ) }) diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index 5915cb78..c320cd77 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -416,3 +416,74 @@ test_that("tbl_with_pools() skips if an rlang::expr() evaluates to 0 rows", { error = TRUE ) }) + + +# --- 13. Pipeline: tbl_with_pools + tbl_hierarchical_rate_by_grade + add_grade_column --- +test_that("tbl_with_pools() + tbl_hierarchical_rate_by_grade() + add_grade_column() pipeline works", { + # This is the critical regression test for the Cartesian join explosion. + # Previously, tbl_hierarchical_rate_by_grade() blanked the `label` column for + + # grade rows before returning, causing tbl_merge() inside tbl_with_pools() to + # lose row uniqueness and produce a Cartesian cross-join. + + ADSL_pipe <- cards::ADSL + ADAE_pipe <- cards::ADAE |> + dplyr::filter( + AESOC %in% unique(cards::ADAE$AESOC)[1:3], + AETERM %in% unique(cards::ADAE$AETERM)[1:3] + ) + + pools <- list( + "Any Xanomeline" = c("Xanomeline High Dose", "Xanomeline Low Dose"), + "All Patients" = "all" + ) + + grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4") + ) + + # the merge should complete without row explosion + expect_silent( + merged_tbl <- tbl_with_pools( + data = ADAE_pipe, + pools = pools, + by = "TRTA", + denominator = ADSL_pipe, + keep_original = TRUE, + .tbl_fun = tbl_hierarchical_rate_by_grade, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + grade_groups = grade_groups + ) + ) + + # verify no Cartesian explosion: row count should match a single table + single_tbl <- tbl_hierarchical_rate_by_grade( + ADAE_pipe, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL_pipe, + by = TRTA, + grade_groups = grade_groups + ) + # merged table should have same number of rows (not exponentially more) + expect_equal(nrow(merged_tbl$table_body), nrow(single_tbl$table_body)) + + # verify label column retains unique values (not all blank) + grade_labels <- merged_tbl$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label) + expect_true(all(grade_labels != "")) + + # apply add_grade_column() to the merged result + final_tbl <- merged_tbl |> add_grade_column() + + # after styling: label_grade exists, grade labels blanked from label + expect_true("label_grade" %in% names(final_tbl$table_body)) + grade_labels_after <- final_tbl$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label) + expect_true(all(grade_labels_after == "")) + + # custom_info is extracted from the first sub-table + expect_true(!is.null(merged_tbl$tbls[[1]]$custom_info)) +}) From 2a4a0fa096a46599f358d144d35214225bf37d5f Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 09:18:18 +0000 Subject: [PATCH 02/46] fix: decouple visual styling from tbl_hierarchical_rate_by_grade to prevent Cartesian join explosion tbl_hierarchical_rate_by_grade() was blanking the label column for grade rows before returning, causing tbl_merge() inside tbl_with_pools() to lose row uniqueness and produce a Cartesian cross-join. Split into two functions: - tbl_hierarchical_rate_by_grade(): returns structurally pristine table with unique label values, injects custom_info metadata - add_grade_column(): post-processing function that applies all visual formatting (label_grade column, label blanking, headers, indentation) --- R/add_grade_column.R | 161 +++++++++++++++ R/tbl_hierarchical_rate_by_grade.R | 77 ++----- tests/testthat/_snaps/add_grade_column.md | 17 ++ .../_snaps/tbl_hierarchical_rate_by_grade.md | 140 +------------ tests/testthat/test-add_grade_column.R | 188 ++++++++++++++++++ .../test-tbl_hierarchical_rate_by_grade.R | 25 ++- tests/testthat/test-tbl_with_pools.R | 71 +++++++ 7 files changed, 478 insertions(+), 201 deletions(-) create mode 100644 R/add_grade_column.R create mode 100644 tests/testthat/_snaps/add_grade_column.md create mode 100644 tests/testthat/test-add_grade_column.R diff --git a/R/add_grade_column.R b/R/add_grade_column.R new file mode 100644 index 00000000..59c8a4a0 --- /dev/null +++ b/R/add_grade_column.R @@ -0,0 +1,161 @@ +#' Add Grade Column to Hierarchical Rate-by-Grade Tables +#' +#' @description +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function: +#' - Creates a `label_grade` column to display grade labels separately. +#' - Blanks the `label` column for grade-level rows. +#' - Removes statistics from non-summary rows (SOC label rows without rates). +#' - Applies indentation for grade levels within grade groups. +#' - Updates column headers and formatting. +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or `x$tbls[[1]]$custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' ## Intended Workflow +#' +#' ```r +#' # Standalone +#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() +#' +#' # With pooled columns +#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() +#' ``` +#' +#' @returns The input gtsummary table with grade column formatting applied. +#' @export +#' +#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") +#' ADSL <- cards::ADSL +#' ADAE_subset <- cards::ADAE |> +#' dplyr::filter( +#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], +#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] +#' ) +#' +#' grade_groups <- list( +#' "Grade 1-2" = c("1", "2"), +#' "Grade 3-4" = c("3", "4"), +#' "Grade 5" = "5" +#' ) +#' +#' # Standalone usage +#' tbl_hierarchical_rate_by_grade( +#' ADAE_subset, +#' variables = c(AEBODSYS, AEDECOD, AETOXGR), +#' denominator = ADSL, +#' by = TRTA, +#' grade_groups = grade_groups +#' ) |> +#' add_grade_column() +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # extract metadata: standalone vs merged table + + info <- x$custom_info %||% + tryCatch(x$tbls[[1]]$custom_info, error = function(e) NULL) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 14905dab..65e7ba25 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -41,6 +41,11 @@ #' A gtsummary table of class `'tbl_hierarchical_rate_by_grade'`. #' #' @details +#' This function returns a structurally pristine table where the `label` column retains unique grade text +#' (e.g., "1", "2", "Grade 1-2"). This preserves row uniqueness required by [gtsummary::tbl_merge()] and +#' [tbl_with_pools()]. To apply visual formatting (grade column, label blanking, header styling), pipe the +#' result through [add_grade_column()] **after** any merging operations. +#' #' When using the `filter` argument, the filter will be applied to the second variable from `variables`, i.e. the #' adverse event terms variable. If an AE does not meet the filtering criteria, the AE overall row as well as all grade #' and grade group rows within an AE section will be excluded from the table. Filtering out AEs does not exclude the @@ -81,7 +86,8 @@ #' ), #' grade_groups = grade_groups, #' grades_exclude = "5" -#' ) +#' ) |> +#' add_grade_column() #' #' # Example 2 ---------------------------------- #' # Filter: Keep AEs with an overall prevalence of greater than 10% @@ -93,7 +99,8 @@ #' grade_groups = list("Grades 1-2" = c("1", "2"), "Grades 3-5" = c("3", "4", "5")), #' filter = sum(n) / sum(N) > 0.10 #' ) |> -#' add_overall(last = TRUE) +#' add_overall(last = TRUE) |> +#' add_grade_column() NULL #' @export @@ -365,6 +372,7 @@ tbl_hierarchical_rate_by_grade <- function(data, } ) + # structural cleanup: remove duplicate/empty rows but preserve label uniqueness tbl_final <- tbl_final |> gtsummary::modify_table_body( \(table_body) { @@ -374,63 +382,10 @@ tbl_hierarchical_rate_by_grade <- function(data, # remove soc summary rows if all sub-rows filtered out dplyr::filter(!(.data$variable == soc & dplyr::lead(.data$variable) %in% c(soc, NA))) |> # remove rows for grades in grades_exclude - dplyr::filter(!.data$label %in% grades_exclude) |> - dplyr::rowwise() |> - # add label_grade column to display grade labels - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # remove grade levels from label column - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from summary rows if not an overall row - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() + dplyr::filter(!.data$label %in% grades_exclude) } - ) |> - # show label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header label - gtsummary::modify_header( - label ~ paste0(label[[soc]], " \n", paste0(rep("\U00A0", 4L), collapse = ""), label[[ae]]), - label_grade ~ label[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" ) - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - tbl_final <- tbl_final |> - gtsummary::modify_indent( - columns = "label_grade", rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - # return final table --------------------------------------------------------- tbl_final$call_list <- list(tbl_hierarchical_rate_by_grade = match.call()) tbl_final$cards <- list( @@ -438,6 +393,16 @@ tbl_hierarchical_rate_by_grade <- function(data, ) tbl_final$inputs <- tbl_hierarchical_rate_by_grade_inputs + # inject metadata for downstream post-processing by add_grade_column() + tbl_final$custom_info <- list( + soc = soc, + ae = ae, + grade = grade, + grade_groups = grade_groups, + lvls = lvls, + label_list = label + ) + tbl_final |> structure(class = c("tbl_hierarchical_rate_by_grade", "gtsummary")) } diff --git a/tests/testthat/_snaps/add_grade_column.md b/tests/testthat/_snaps/add_grade_column.md new file mode 100644 index 00000000..01732d50 --- /dev/null +++ b/tests/testthat/_snaps/add_grade_column.md @@ -0,0 +1,17 @@ +# add_grade_column() errors when custom_info is missing + + Code + add_grade_column(tbl) + Condition + Error in `add_grade_column()`: + ! No `custom_info` metadata found on the input table. + i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. + +# add_grade_column() errors on non-gtsummary input + + Code + add_grade_column(data.frame(x = 1)) + Condition + Error in `add_grade_column()`: + ! `x` must be a object. + diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index f723d1e8..01c47c77 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -1,139 +1,3 @@ -# tbl_hierarchical_rate_by_grade() works - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) - ---- - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - ---- - - Code - as.data.frame(tbl)[1, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% - -# tbl_hierarchical_rate_by_grade(include_overall) works - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - ---- - - Code - as.data.frame(tbl)[1:25, ] - Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) - 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) - 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) - # tbl_hierarchical_rate_by_grade() error messaging works Code @@ -142,14 +6,14 @@ grades_exclude = 4:5) Condition Error in `tbl_hierarchical_rate_by_grade()`: - ! The `grades_exclude` argument must be class or empty, not an integer vector. + ! `grades_exclude` must be a vector or empty. --- Code tbl <- tbl_hierarchical_rate_by_grade(ADAE_subset, variables = c(AEBODSYS, AEDECOD, AETOXGR), denominator = ADSL, by = TRTA, label = label, - grade_groups = list("Grade 5" ~ "5")) + grade_groups = list(`Grade 5` ~ "5")) Condition Error in `tbl_hierarchical_rate_by_grade()`: ! Grade groups must be specified via a named list where each list element is a character vector of the grades to include in the grade group and each name is the corresponding name of the grade group. For example, `"Grade 3-4" = c("3", "4")`. diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R new file mode 100644 index 00000000..b15204f6 --- /dev/null +++ b/tests/testthat/test-add_grade_column.R @@ -0,0 +1,188 @@ +skip_on_cran() + +ADSL <- cards::ADSL +ADAE_subset <- cards::ADAE |> + dplyr::filter( + AESOC %in% unique(cards::ADAE$AESOC)[1:5], + AETERM %in% unique(cards::ADAE$AETERM)[1:5] + ) + +label <- list( + AEBODSYS = "MedDRA System Organ Class", + AEDECOD = "MedDRA Preferred Term", + AETOXGR = "Grade" +) + +grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4"), + "Grade 5" = "5" +) + +# --- 1. Standalone table formatting ------------------------------------------ +test_that("add_grade_column() works on a standalone tbl_hierarchical_rate_by_grade", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + # before add_grade_column: no label_grade column, label not blanked + expect_false("label_grade" %in% names(tbl$table_body)) + expect_true(any(tbl$table_body$label %in% as.character(1:5))) + + result <- tbl |> add_grade_column() + + # after add_grade_column: label_grade exists, grade labels blanked from label + expect_true("label_grade" %in% names(result$table_body)) + + # grade rows have blank label + grade_rows <- result$table_body$variable == "AETOXGR" + expect_true(all(result$table_body$label[grade_rows] == "")) + + # label_grade has grade text for grade rows + expect_true(all(result$table_body$label_grade[grade_rows] != "")) + + # AE rows get "- Any Grade -" + ae_rows <- result$table_body$variable == "AEDECOD" + expect_true(all(result$table_body$label_grade[ae_rows] == "- Any Grade -")) + + # SOC label rows get empty label_grade (not "- Any Grade -") + soc_rows <- result$table_body$variable == "AEBODSYS" & + result$table_body$label != "- Any adverse events -" + expect_true(all(result$table_body$label_grade[soc_rows] == "")) +}) + +# --- 2. Standalone without grade groups -------------------------------------- +test_that("add_grade_column() works without grade groups", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label + ) + + result <- tbl |> add_grade_column() + + expect_true("label_grade" %in% names(result$table_body)) + # no indentation styling for grade groups since none defined + indent_rows <- result$table_styling$indent |> + dplyr::filter(column == "label_grade") + # only default indentation, no grade-group-specific indent + expect_true(nrow(indent_rows) == 0 || !any(indent_rows$indent == 4L)) +}) + +# --- 3. Metadata extraction from merged tables -------------------------------- +test_that("add_grade_column() extracts custom_info from merged tables", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + # simulate a merged table structure + merged <- gtsummary::tbl_merge( + tbls = list(tbl, tbl), + tab_spanner = FALSE, + quiet = TRUE + ) + + result <- merged |> add_grade_column() + expect_true("label_grade" %in% names(result$table_body)) +}) + +# --- 4. Error when no custom_info metadata ------------------------------------ +test_that("add_grade_column() errors when custom_info is missing", { + # use a plain gtsummary table with no custom_info + tbl <- gtsummary::tbl_summary(cards::ADSL, include = AGE) + + expect_snapshot( + add_grade_column(tbl), + error = TRUE + ) +}) + +# --- 5. Error when input is not gtsummary ------------------------------------ +test_that("add_grade_column() errors on non-gtsummary input", { + expect_snapshot( + add_grade_column(data.frame(x = 1)), + error = TRUE + ) +}) + +# --- 6. Stats blanking for non-summary rows ----------------------------------- +test_that("add_grade_column() blanks stats for SOC label rows", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # SOC label rows (not "- Any adverse events -") should have NA stats + soc_label_rows <- result$table_body |> + dplyr::filter( + variable == "AEBODSYS", + label != "- Any adverse events -" + ) + + stat_cols <- names(soc_label_rows)[grepl("^stat_", names(soc_label_rows))] + for (col in stat_cols) { + expect_true(all(is.na(soc_label_rows[[col]]))) + } +}) + +# --- 7. Zero formatting ("0 (0.0%)" -> "0") ---------------------------------- +test_that("add_grade_column() recodes zero statistics", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # check that post_fmt_fun is set (the actual recoding happens at render time) + expect_true(nrow(result$table_styling$post_fmt_fun) > 0) +}) + +# --- 8. Header labels are set correctly -------------------------------------- +test_that("add_grade_column() sets correct header labels", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result <- tbl |> add_grade_column() + + # label_grade header should be the grade label + lg_header <- result$table_styling$header |> + dplyr::filter(column == "label_grade") |> + dplyr::pull(label) + expect_equal(lg_header, "Grade") + + # label header should combine SOC and AE labels + lbl_header <- result$table_styling$header |> + dplyr::filter(column == "label") |> + dplyr::pull(label) + expect_true(grepl("MedDRA System Organ Class", lbl_header)) + expect_true(grepl("MedDRA Preferred Term", lbl_header)) +}) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 001f7551..96aea1a5 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -33,7 +33,18 @@ test_that("tbl_hierarchical_rate_by_grade() works", { label = label ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + + # custom_info metadata is injected for add_grade_column() + + expect_true(!is.null(tbl$custom_info)) + expect_equal(tbl$custom_info$soc, "AEBODSYS") + expect_equal(tbl$custom_info$ae, "AEDECOD") + expect_equal(tbl$custom_info$grade, "AETOXGR") + + # label column retains grade text (not blanked) for merge safety + expect_true(any(tbl$table_body$label %in% as.character(1:5))) + + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # with grade groups expect_silent( @@ -47,7 +58,7 @@ test_that("tbl_hierarchical_rate_by_grade() works", { grade_groups = grade_groups ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # no by, no label expect_silent( @@ -72,7 +83,7 @@ test_that("tbl_hierarchical_rate_by_grade() works", { digits = everything() ~ list(n = label_roche_number(digits = 1, decimal.mark = ","), p = 3) ) ) - expect_snapshot(as.data.frame(tbl)[1, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1, ]) }) test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { @@ -91,7 +102,7 @@ test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { include_overall = everything() ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) # all overall sections removed expect_silent( @@ -106,7 +117,7 @@ test_that("tbl_hierarchical_rate_by_grade(include_overall) works", { include_overall = NULL ) ) - expect_snapshot(as.data.frame(tbl)[1:25, ]) + expect_snapshot(as.data.frame(tbl |> add_grade_column())[1:25, ]) }) test_that("tbl_hierarchical_rate_by_grade() works with add_overall()", { @@ -310,7 +321,7 @@ test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { expect_identical( tbl_excl$table_body, tbl_no_excl$table_body |> - dplyr::filter(label_grade != "5") + dplyr::filter(label != "5") ) # all grades excluded @@ -329,7 +340,7 @@ test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { expect_identical( tbl_excl$table_body, tbl_no_excl$table_body |> - dplyr::filter(!label_grade %in% as.character(1:5)) + dplyr::filter(!label %in% as.character(1:5)) ) }) diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index 5915cb78..c320cd77 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -416,3 +416,74 @@ test_that("tbl_with_pools() skips if an rlang::expr() evaluates to 0 rows", { error = TRUE ) }) + + +# --- 13. Pipeline: tbl_with_pools + tbl_hierarchical_rate_by_grade + add_grade_column --- +test_that("tbl_with_pools() + tbl_hierarchical_rate_by_grade() + add_grade_column() pipeline works", { + # This is the critical regression test for the Cartesian join explosion. + # Previously, tbl_hierarchical_rate_by_grade() blanked the `label` column for + + # grade rows before returning, causing tbl_merge() inside tbl_with_pools() to + # lose row uniqueness and produce a Cartesian cross-join. + + ADSL_pipe <- cards::ADSL + ADAE_pipe <- cards::ADAE |> + dplyr::filter( + AESOC %in% unique(cards::ADAE$AESOC)[1:3], + AETERM %in% unique(cards::ADAE$AETERM)[1:3] + ) + + pools <- list( + "Any Xanomeline" = c("Xanomeline High Dose", "Xanomeline Low Dose"), + "All Patients" = "all" + ) + + grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4") + ) + + # the merge should complete without row explosion + expect_silent( + merged_tbl <- tbl_with_pools( + data = ADAE_pipe, + pools = pools, + by = "TRTA", + denominator = ADSL_pipe, + keep_original = TRUE, + .tbl_fun = tbl_hierarchical_rate_by_grade, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + grade_groups = grade_groups + ) + ) + + # verify no Cartesian explosion: row count should match a single table + single_tbl <- tbl_hierarchical_rate_by_grade( + ADAE_pipe, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL_pipe, + by = TRTA, + grade_groups = grade_groups + ) + # merged table should have same number of rows (not exponentially more) + expect_equal(nrow(merged_tbl$table_body), nrow(single_tbl$table_body)) + + # verify label column retains unique values (not all blank) + grade_labels <- merged_tbl$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label) + expect_true(all(grade_labels != "")) + + # apply add_grade_column() to the merged result + final_tbl <- merged_tbl |> add_grade_column() + + # after styling: label_grade exists, grade labels blanked from label + expect_true("label_grade" %in% names(final_tbl$table_body)) + grade_labels_after <- final_tbl$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label) + expect_true(all(grade_labels_after == "")) + + # custom_info is extracted from the first sub-table + expect_true(!is.null(merged_tbl$tbls[[1]]$custom_info)) +}) From 6f1310806ee36ee1cca186dc1b8684f81a1e178a Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 10:17:38 +0000 Subject: [PATCH 03/46] fix: add idempotency guard, robust metadata lookup, and double-call test - add_grade_column() now returns early if label_grade already exists - metadata lookup iterates over x$tbls instead of hardcoding tbls[[1]] - added idempotency test (test #8) - fixed broken comment block in tbl_with_pools test Co-authored-by: Ona --- R/add_grade_column.R | 6 ++++-- tests/testthat/test-add_grade_column.R | 26 +++++++++++++++++++++++++- tests/testthat/test-tbl_with_pools.R | 3 +-- 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/R/add_grade_column.R b/R/add_grade_column.R index 59c8a4a0..5a4658f9 100644 --- a/R/add_grade_column.R +++ b/R/add_grade_column.R @@ -70,10 +70,12 @@ add_grade_column <- function(x) { ) } - # extract metadata: standalone vs merged table + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + # extract metadata: standalone vs merged table info <- x$custom_info %||% - tryCatch(x$tbls[[1]]$custom_info, error = function(e) NULL) + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) if (is.null(info)) { cli::cli_abort( diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R index b15204f6..5ef77068 100644 --- a/tests/testthat/test-add_grade_column.R +++ b/tests/testthat/test-add_grade_column.R @@ -160,7 +160,31 @@ test_that("add_grade_column() recodes zero statistics", { expect_true(nrow(result$table_styling$post_fmt_fun) > 0) }) -# --- 8. Header labels are set correctly -------------------------------------- +# --- 8. Idempotency: calling add_grade_column() twice ------------------------- +test_that("add_grade_column() is idempotent when called twice", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result_once <- tbl |> add_grade_column() + result_twice <- result_once |> add_grade_column() + + # second call should return the same table unchanged + expect_identical(result_once$table_body, result_twice$table_body) + + # grade labels should not be corrupted + grade_labels <- result_twice$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label_grade) + expect_true(all(grade_labels != "")) +}) + +# --- 9. Header labels are set correctly -------------------------------------- test_that("add_grade_column() sets correct header labels", { tbl <- tbl_hierarchical_rate_by_grade( ADAE_subset, diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index c320cd77..8c51bdae 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -420,9 +420,8 @@ test_that("tbl_with_pools() skips if an rlang::expr() evaluates to 0 rows", { # --- 13. Pipeline: tbl_with_pools + tbl_hierarchical_rate_by_grade + add_grade_column --- test_that("tbl_with_pools() + tbl_hierarchical_rate_by_grade() + add_grade_column() pipeline works", { - # This is the critical regression test for the Cartesian join explosion. + # Regression test for the Cartesian join explosion. # Previously, tbl_hierarchical_rate_by_grade() blanked the `label` column for - # grade rows before returning, causing tbl_merge() inside tbl_with_pools() to # lose row uniqueness and produce a Cartesian cross-join. From 450e0dd78e969d5ebfc3105be54997af60609d80 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 10:17:38 +0000 Subject: [PATCH 04/46] fix: add idempotency guard, robust metadata lookup, and double-call test - add_grade_column() now returns early if label_grade already exists - metadata lookup iterates over x$tbls instead of hardcoding tbls[[1]] - added idempotency test (test #8) - fixed broken comment block in tbl_with_pools test --- R/add_grade_column.R | 6 ++++-- tests/testthat/test-add_grade_column.R | 26 +++++++++++++++++++++++++- tests/testthat/test-tbl_with_pools.R | 3 +-- 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/R/add_grade_column.R b/R/add_grade_column.R index 59c8a4a0..5a4658f9 100644 --- a/R/add_grade_column.R +++ b/R/add_grade_column.R @@ -70,10 +70,12 @@ add_grade_column <- function(x) { ) } - # extract metadata: standalone vs merged table + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + # extract metadata: standalone vs merged table info <- x$custom_info %||% - tryCatch(x$tbls[[1]]$custom_info, error = function(e) NULL) + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) if (is.null(info)) { cli::cli_abort( diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R index b15204f6..5ef77068 100644 --- a/tests/testthat/test-add_grade_column.R +++ b/tests/testthat/test-add_grade_column.R @@ -160,7 +160,31 @@ test_that("add_grade_column() recodes zero statistics", { expect_true(nrow(result$table_styling$post_fmt_fun) > 0) }) -# --- 8. Header labels are set correctly -------------------------------------- +# --- 8. Idempotency: calling add_grade_column() twice ------------------------- +test_that("add_grade_column() is idempotent when called twice", { + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = grade_groups + ) + + result_once <- tbl |> add_grade_column() + result_twice <- result_once |> add_grade_column() + + # second call should return the same table unchanged + expect_identical(result_once$table_body, result_twice$table_body) + + # grade labels should not be corrupted + grade_labels <- result_twice$table_body |> + dplyr::filter(variable == "AETOXGR") |> + dplyr::pull(label_grade) + expect_true(all(grade_labels != "")) +}) + +# --- 9. Header labels are set correctly -------------------------------------- test_that("add_grade_column() sets correct header labels", { tbl <- tbl_hierarchical_rate_by_grade( ADAE_subset, diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index c320cd77..8c51bdae 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -420,9 +420,8 @@ test_that("tbl_with_pools() skips if an rlang::expr() evaluates to 0 rows", { # --- 13. Pipeline: tbl_with_pools + tbl_hierarchical_rate_by_grade + add_grade_column --- test_that("tbl_with_pools() + tbl_hierarchical_rate_by_grade() + add_grade_column() pipeline works", { - # This is the critical regression test for the Cartesian join explosion. + # Regression test for the Cartesian join explosion. # Previously, tbl_hierarchical_rate_by_grade() blanked the `label` column for - # grade rows before returning, causing tbl_merge() inside tbl_with_pools() to # lose row uniqueness and produce a Cartesian cross-join. From 8becdc8abac95ccc18f79f4fc3f9f8ebcd0a8d62 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 10:18:16 +0000 Subject: [PATCH 05/46] docs: update @details to match Find() lookup Co-authored-by: Ona --- R/add_grade_column.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/add_grade_column.R b/R/add_grade_column.R index 5a4658f9..7af0c380 100644 --- a/R/add_grade_column.R +++ b/R/add_grade_column.R @@ -21,7 +21,7 @@ #' #' @details #' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or `x$tbls[[1]]$custom_info` (merged tables). +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' #' ## Intended Workflow From 9c30ff7c2d340675a59abfbdfd76e79e2c4dbf20 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 10:18:16 +0000 Subject: [PATCH 06/46] docs: update @details to match Find() lookup --- R/add_grade_column.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/add_grade_column.R b/R/add_grade_column.R index 5a4658f9..7af0c380 100644 --- a/R/add_grade_column.R +++ b/R/add_grade_column.R @@ -21,7 +21,7 @@ #' #' @details #' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or `x$tbls[[1]]$custom_info` (merged tables). +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' #' ## Intended Workflow From fc7795e44ae63d118c4da9f09cf05954b27d4cfe Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 12:52:26 +0200 Subject: [PATCH 07/46] docs and md --- NAMESPACE | 1 + man/add_grade_column.Rd | 72 +++++++++ man/tbl_hierarchical_rate_by_grade.Rd | 11 +- tests/testthat/_snaps/add_grade_column.new.md | 17 +++ .../_snaps/tbl_hierarchical_rate_by_grade.md | 140 +++++++++++++++++- 5 files changed, 237 insertions(+), 4 deletions(-) create mode 100644 man/add_grade_column.Rd create mode 100644 tests/testthat/_snaps/add_grade_column.new.md diff --git a/NAMESPACE b/NAMESPACE index bc161acd..9c7147e5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export("%>%") export(add_blank_rows) export(add_difference_row) export(add_forest) +export(add_grade_column) export(add_hierarchical_count_row) export(add_overall) export(adjust_stat_columns_wrap) diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd new file mode 100644 index 00000000..c52b75ec --- /dev/null +++ b/man/add_grade_column.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_grade_column.R +\name{add_grade_column} +\alias{add_grade_column} +\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} +\usage{ +add_grade_column(x) +} +\arguments{ +\item{x}{(\code{gtsummary})\cr +A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table +(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} +} +\value{ +The input gtsummary table with grade column formatting applied. +} +\description{ +Post-processing function that applies visual formatting to tables generated by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging +(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking +the \code{label} column prior to merge. + +The function: +\itemize{ +\item Creates a \code{label_grade} column to display grade labels separately. +\item Blanks the \code{label} column for grade-level rows. +\item Removes statistics from non-summary rows (SOC label rows without rates). +\item Applies indentation for grade levels within grade groups. +\item Updates column headers and formatting. +} +} +\details{ +The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via +\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). +If no metadata is found, the function aborts with an informative error. +\subsection{Intended Workflow}{ + +\if{html}{\out{
}}\preformatted{# Standalone +tbl_hierarchical_rate_by_grade(...) |> add_grade_column() + +# With pooled columns +tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() +}\if{html}{\out{
}} +} +} +\examples{ +\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} +ADSL <- cards::ADSL +ADAE_subset <- cards::ADAE |> + dplyr::filter( + AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], + AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] + ) + +grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4"), + "Grade 5" = "5" +) + +# Standalone usage +tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + grade_groups = grade_groups +) |> + add_grade_column() +\dontshow{\}) # examplesIf} +} diff --git a/man/tbl_hierarchical_rate_by_grade.Rd b/man/tbl_hierarchical_rate_by_grade.Rd index 2aca6595..6a945e93 100644 --- a/man/tbl_hierarchical_rate_by_grade.Rd +++ b/man/tbl_hierarchical_rate_by_grade.Rd @@ -134,6 +134,11 @@ Grades will appear in rows in the order of the factor levels given, with each gr first level in its group. } \details{ +This function returns a structurally pristine table where the \code{label} column retains unique grade text +(e.g., "1", "2", "Grade 1-2"). This preserves row uniqueness required by \code{\link[gtsummary:tbl_merge]{gtsummary::tbl_merge()}} and +\code{\link[=tbl_with_pools]{tbl_with_pools()}}. To apply visual formatting (grade column, label blanking, header styling), pipe the +result through \code{\link[=add_grade_column]{add_grade_column()}} \strong{after} any merging operations. + When using the \code{filter} argument, the filter will be applied to the second variable from \code{variables}, i.e. the adverse event terms variable. If an AE does not meet the filtering criteria, the AE overall row as well as all grade and grade group rows within an AE section will be excluded from the table. Filtering out AEs does not exclude the @@ -172,7 +177,8 @@ tbl_hierarchical_rate_by_grade( ), grade_groups = grade_groups, grades_exclude = "5" -) +) |> + add_grade_column() # Example 2 ---------------------------------- # Filter: Keep AEs with an overall prevalence of greater than 10\% @@ -184,6 +190,7 @@ tbl_hierarchical_rate_by_grade( grade_groups = list("Grades 1-2" = c("1", "2"), "Grades 3-5" = c("3", "4", "5")), filter = sum(n) / sum(N) > 0.10 ) |> - add_overall(last = TRUE) + add_overall(last = TRUE) |> + add_grade_column() \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/add_grade_column.new.md b/tests/testthat/_snaps/add_grade_column.new.md new file mode 100644 index 00000000..2651d48d --- /dev/null +++ b/tests/testthat/_snaps/add_grade_column.new.md @@ -0,0 +1,17 @@ +# add_grade_column() errors when custom_info is missing + + Code + add_grade_column(tbl) + Condition + Error in `add_grade_column()`: + ! No custom_info metadata found on the input table. + i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. + +# add_grade_column() errors on non-gtsummary input + + Code + add_grade_column(data.frame(x = 1)) + Condition + Error in `add_grade_column()`: + ! `x` must be a object. + diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 01c47c77..3f88730c 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -1,3 +1,139 @@ +# tbl_hierarchical_rate_by_grade() works + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) + 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) + 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + +# tbl_hierarchical_rate_by_grade(include_overall) works + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) + 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) + 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) + 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) + 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) + 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) + 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) + 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) + 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) + 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) + 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + # tbl_hierarchical_rate_by_grade() error messaging works Code @@ -6,14 +142,14 @@ grades_exclude = 4:5) Condition Error in `tbl_hierarchical_rate_by_grade()`: - ! `grades_exclude` must be a vector or empty. + ! The `grades_exclude` argument must be class or empty, not an integer vector. --- Code tbl <- tbl_hierarchical_rate_by_grade(ADAE_subset, variables = c(AEBODSYS, AEDECOD, AETOXGR), denominator = ADSL, by = TRTA, label = label, - grade_groups = list(`Grade 5` ~ "5")) + grade_groups = list("Grade 5" ~ "5")) Condition Error in `tbl_hierarchical_rate_by_grade()`: ! Grade groups must be specified via a named list where each list element is a character vector of the grades to include in the grade group and each name is the corresponding name of the grade group. For example, `"Grade 3-4" = c("3", "4")`. From 02b4a8e20ff17636497698c69a7018fa595c257c Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 12:52:26 +0200 Subject: [PATCH 08/46] docs and md --- NAMESPACE | 1 + man/add_grade_column.Rd | 72 +++++++++ man/tbl_hierarchical_rate_by_grade.Rd | 11 +- tests/testthat/_snaps/add_grade_column.new.md | 17 +++ .../_snaps/tbl_hierarchical_rate_by_grade.md | 140 +++++++++++++++++- 5 files changed, 237 insertions(+), 4 deletions(-) create mode 100644 man/add_grade_column.Rd create mode 100644 tests/testthat/_snaps/add_grade_column.new.md diff --git a/NAMESPACE b/NAMESPACE index bc161acd..9c7147e5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export("%>%") export(add_blank_rows) export(add_difference_row) export(add_forest) +export(add_grade_column) export(add_hierarchical_count_row) export(add_overall) export(adjust_stat_columns_wrap) diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd new file mode 100644 index 00000000..c52b75ec --- /dev/null +++ b/man/add_grade_column.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_grade_column.R +\name{add_grade_column} +\alias{add_grade_column} +\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} +\usage{ +add_grade_column(x) +} +\arguments{ +\item{x}{(\code{gtsummary})\cr +A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table +(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} +} +\value{ +The input gtsummary table with grade column formatting applied. +} +\description{ +Post-processing function that applies visual formatting to tables generated by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging +(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking +the \code{label} column prior to merge. + +The function: +\itemize{ +\item Creates a \code{label_grade} column to display grade labels separately. +\item Blanks the \code{label} column for grade-level rows. +\item Removes statistics from non-summary rows (SOC label rows without rates). +\item Applies indentation for grade levels within grade groups. +\item Updates column headers and formatting. +} +} +\details{ +The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via +\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). +If no metadata is found, the function aborts with an informative error. +\subsection{Intended Workflow}{ + +\if{html}{\out{
}}\preformatted{# Standalone +tbl_hierarchical_rate_by_grade(...) |> add_grade_column() + +# With pooled columns +tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() +}\if{html}{\out{
}} +} +} +\examples{ +\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} +ADSL <- cards::ADSL +ADAE_subset <- cards::ADAE |> + dplyr::filter( + AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], + AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] + ) + +grade_groups <- list( + "Grade 1-2" = c("1", "2"), + "Grade 3-4" = c("3", "4"), + "Grade 5" = "5" +) + +# Standalone usage +tbl_hierarchical_rate_by_grade( + ADAE_subset, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + grade_groups = grade_groups +) |> + add_grade_column() +\dontshow{\}) # examplesIf} +} diff --git a/man/tbl_hierarchical_rate_by_grade.Rd b/man/tbl_hierarchical_rate_by_grade.Rd index 2aca6595..6a945e93 100644 --- a/man/tbl_hierarchical_rate_by_grade.Rd +++ b/man/tbl_hierarchical_rate_by_grade.Rd @@ -134,6 +134,11 @@ Grades will appear in rows in the order of the factor levels given, with each gr first level in its group. } \details{ +This function returns a structurally pristine table where the \code{label} column retains unique grade text +(e.g., "1", "2", "Grade 1-2"). This preserves row uniqueness required by \code{\link[gtsummary:tbl_merge]{gtsummary::tbl_merge()}} and +\code{\link[=tbl_with_pools]{tbl_with_pools()}}. To apply visual formatting (grade column, label blanking, header styling), pipe the +result through \code{\link[=add_grade_column]{add_grade_column()}} \strong{after} any merging operations. + When using the \code{filter} argument, the filter will be applied to the second variable from \code{variables}, i.e. the adverse event terms variable. If an AE does not meet the filtering criteria, the AE overall row as well as all grade and grade group rows within an AE section will be excluded from the table. Filtering out AEs does not exclude the @@ -172,7 +177,8 @@ tbl_hierarchical_rate_by_grade( ), grade_groups = grade_groups, grades_exclude = "5" -) +) |> + add_grade_column() # Example 2 ---------------------------------- # Filter: Keep AEs with an overall prevalence of greater than 10\% @@ -184,6 +190,7 @@ tbl_hierarchical_rate_by_grade( grade_groups = list("Grades 1-2" = c("1", "2"), "Grades 3-5" = c("3", "4", "5")), filter = sum(n) / sum(N) > 0.10 ) |> - add_overall(last = TRUE) + add_overall(last = TRUE) |> + add_grade_column() \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/add_grade_column.new.md b/tests/testthat/_snaps/add_grade_column.new.md new file mode 100644 index 00000000..2651d48d --- /dev/null +++ b/tests/testthat/_snaps/add_grade_column.new.md @@ -0,0 +1,17 @@ +# add_grade_column() errors when custom_info is missing + + Code + add_grade_column(tbl) + Condition + Error in `add_grade_column()`: + ! No custom_info metadata found on the input table. + i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. + +# add_grade_column() errors on non-gtsummary input + + Code + add_grade_column(data.frame(x = 1)) + Condition + Error in `add_grade_column()`: + ! `x` must be a object. + diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 01c47c77..3f88730c 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -1,3 +1,139 @@ +# tbl_hierarchical_rate_by_grade() works + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) + 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) + 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + +# tbl_hierarchical_rate_by_grade(include_overall) works + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + +--- + + Code + as.data.frame(add_grade_column(tbl))[1:25, ] + Output + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) + 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) + 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) + 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) + 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) + 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) + 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) + 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) + 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) + 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) + 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + # tbl_hierarchical_rate_by_grade() error messaging works Code @@ -6,14 +142,14 @@ grades_exclude = 4:5) Condition Error in `tbl_hierarchical_rate_by_grade()`: - ! `grades_exclude` must be a vector or empty. + ! The `grades_exclude` argument must be class or empty, not an integer vector. --- Code tbl <- tbl_hierarchical_rate_by_grade(ADAE_subset, variables = c(AEBODSYS, AEDECOD, AETOXGR), denominator = ADSL, by = TRTA, label = label, - grade_groups = list(`Grade 5` ~ "5")) + grade_groups = list("Grade 5" ~ "5")) Condition Error in `tbl_hierarchical_rate_by_grade()`: ! Grade groups must be specified via a named list where each list element is a character vector of the grades to include in the grade group and each name is the corresponding name of the grade group. For example, `"Grade 3-4" = c("3", "4")`. From b23ab6dba07226c3d9503026cbfd0b057026b80c Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 13:18:04 +0200 Subject: [PATCH 09/46] snapshot --- tests/testthat/_snaps/add_grade_column.md | 2 +- tests/testthat/_snaps/add_grade_column.new.md | 17 ----------------- 2 files changed, 1 insertion(+), 18 deletions(-) delete mode 100644 tests/testthat/_snaps/add_grade_column.new.md diff --git a/tests/testthat/_snaps/add_grade_column.md b/tests/testthat/_snaps/add_grade_column.md index 01732d50..2651d48d 100644 --- a/tests/testthat/_snaps/add_grade_column.md +++ b/tests/testthat/_snaps/add_grade_column.md @@ -4,7 +4,7 @@ add_grade_column(tbl) Condition Error in `add_grade_column()`: - ! No `custom_info` metadata found on the input table. + ! No custom_info metadata found on the input table. i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. # add_grade_column() errors on non-gtsummary input diff --git a/tests/testthat/_snaps/add_grade_column.new.md b/tests/testthat/_snaps/add_grade_column.new.md deleted file mode 100644 index 2651d48d..00000000 --- a/tests/testthat/_snaps/add_grade_column.new.md +++ /dev/null @@ -1,17 +0,0 @@ -# add_grade_column() errors when custom_info is missing - - Code - add_grade_column(tbl) - Condition - Error in `add_grade_column()`: - ! No custom_info metadata found on the input table. - i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. - -# add_grade_column() errors on non-gtsummary input - - Code - add_grade_column(data.frame(x = 1)) - Condition - Error in `add_grade_column()`: - ! `x` must be a object. - From ed63de68d25a3b092627a2c7f04cf299a0a2ca6a Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 13:18:04 +0200 Subject: [PATCH 10/46] snapshot --- tests/testthat/_snaps/add_grade_column.md | 2 +- tests/testthat/_snaps/add_grade_column.new.md | 17 ----------------- 2 files changed, 1 insertion(+), 18 deletions(-) delete mode 100644 tests/testthat/_snaps/add_grade_column.new.md diff --git a/tests/testthat/_snaps/add_grade_column.md b/tests/testthat/_snaps/add_grade_column.md index 01732d50..2651d48d 100644 --- a/tests/testthat/_snaps/add_grade_column.md +++ b/tests/testthat/_snaps/add_grade_column.md @@ -4,7 +4,7 @@ add_grade_column(tbl) Condition Error in `add_grade_column()`: - ! No `custom_info` metadata found on the input table. + ! No custom_info metadata found on the input table. i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. # add_grade_column() errors on non-gtsummary input diff --git a/tests/testthat/_snaps/add_grade_column.new.md b/tests/testthat/_snaps/add_grade_column.new.md deleted file mode 100644 index 2651d48d..00000000 --- a/tests/testthat/_snaps/add_grade_column.new.md +++ /dev/null @@ -1,17 +0,0 @@ -# add_grade_column() errors when custom_info is missing - - Code - add_grade_column(tbl) - Condition - Error in `add_grade_column()`: - ! No custom_info metadata found on the input table. - i Ensure the table was created with `tbl_hierarchical_rate_by_grade()`. - -# add_grade_column() errors on non-gtsummary input - - Code - add_grade_column(data.frame(x = 1)) - Condition - Error in `add_grade_column()`: - ! `x` must be a object. - From 74c84193e0f3406a95d5c92a69c6236a5cb175cb Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 11:49:00 +0000 Subject: [PATCH 11/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. Co-authored-by: Ona --- R/tbl_mmrm.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From c2d8a7ed5072dbfa6547e453cac34c0fe494176d Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 11:49:00 +0000 Subject: [PATCH 12/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. --- R/tbl_mmrm.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From 76f4c0be12c3fdc2325fab3e0d171e9619d7da1a Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 12:37:18 +0000 Subject: [PATCH 13/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. Also added AGENTS.md to .gitignore. Co-authored-by: Ona --- .gitignore | 1 + R/tbl_mmrm.R | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index cc50487d..812039fe 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .Rproj.user .Rhistory docs +AGENTS.md diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From a71cc92eba750a9110d7dab93de01a4504aaf41c Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 12:37:18 +0000 Subject: [PATCH 14/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. Also added AGENTS.md to .gitignore. --- .gitignore | 1 + R/tbl_mmrm.R | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index cc50487d..812039fe 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .Rproj.user .Rhistory docs +AGENTS.md diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From 1bd231cdb07d608fdf0920bc9478a5a1f671ba7f Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:20:53 +0000 Subject: [PATCH 15/46] refactor: move add_grade_column() into tbl_hierarchical_rate_by_grade.R Tightly coupled function now shares the same file and help page via @rdname. Removed standalone R/add_grade_column.R and its man page. Co-authored-by: Ona --- R/add_grade_column.R | 163 ----------------------------- R/tbl_hierarchical_rate_by_grade.R | 122 +++++++++++++++++++++ man/add_grade_column.Rd | 72 ------------- 3 files changed, 122 insertions(+), 235 deletions(-) delete mode 100644 R/add_grade_column.R delete mode 100644 man/add_grade_column.Rd diff --git a/R/add_grade_column.R b/R/add_grade_column.R deleted file mode 100644 index 7af0c380..00000000 --- a/R/add_grade_column.R +++ /dev/null @@ -1,163 +0,0 @@ -#' Add Grade Column to Hierarchical Rate-by-Grade Tables -#' -#' @description -#' -#' Post-processing function that applies visual formatting to tables generated by -#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging -#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking -#' the `label` column prior to merge. -#' -#' The function: -#' - Creates a `label_grade` column to display grade labels separately. -#' - Blanks the `label` column for grade-level rows. -#' - Removes statistics from non-summary rows (SOC label rows without rates). -#' - Applies indentation for grade levels within grade groups. -#' - Updates column headers and formatting. -#' -#' @param x (`gtsummary`)\cr -#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table -#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by -#' [tbl_hierarchical_rate_by_grade()]. -#' -#' @details -#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). -#' If no metadata is found, the function aborts with an informative error. -#' -#' ## Intended Workflow -#' -#' ```r -#' # Standalone -#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() -#' -#' # With pooled columns -#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -#' ``` -#' -#' @returns The input gtsummary table with grade column formatting applied. -#' @export -#' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") -#' ADSL <- cards::ADSL -#' ADAE_subset <- cards::ADAE |> -#' dplyr::filter( -#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], -#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] -#' ) -#' -#' grade_groups <- list( -#' "Grade 1-2" = c("1", "2"), -#' "Grade 3-4" = c("3", "4"), -#' "Grade 5" = "5" -#' ) -#' -#' # Standalone usage -#' tbl_hierarchical_rate_by_grade( -#' ADAE_subset, -#' variables = c(AEBODSYS, AEDECOD, AETOXGR), -#' denominator = ADSL, -#' by = TRTA, -#' grade_groups = grade_groups -#' ) |> -#' add_grade_column() -add_grade_column <- function(x) { - set_cli_abort_call() - - if (!inherits(x, "gtsummary")) { - cli::cli_abort( - "{.arg x} must be a {.cls gtsummary} object.", - call = get_cli_abort_call() - ) - } - - # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) - - # extract metadata: standalone vs merged table - info <- x$custom_info %||% - Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) - - if (is.null(info)) { - cli::cli_abort( - c( - "No {.field custom_info} metadata found on the input table.", - "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." - ), - call = get_cli_abort_call() - ) - } - - soc <- info$soc - ae <- info$ae - grade <- info$grade - grade_groups <- info$grade_groups - lvls <- info$lvls - label_list <- info$label_list - - # apply visual formatting to the table body - x <- x |> - gtsummary::modify_table_body( - \(table_body) { - table_body |> - dplyr::rowwise() |> - # create label_grade column - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from non-summary rows - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() - } - ) |> - # show and align label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header labels - gtsummary::modify_header( - label ~ paste0( - label_list[[soc]], " \n", - paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] - ), - label_grade ~ label_list[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" - ) - - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - x <- x |> - gtsummary::modify_indent( - columns = "label_grade", - rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - - x -} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 65e7ba25..104eb859 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -473,3 +473,125 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @rdname tbl_hierarchical_rate_by_grade #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] + +#' @rdname tbl_hierarchical_rate_by_grade +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' ## `add_grade_column()` +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. Must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' @export +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + + # extract metadata: standalone vs merged table + info <- x$custom_info %||% + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd deleted file mode 100644 index c52b75ec..00000000 --- a/man/add_grade_column.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_grade_column.R -\name{add_grade_column} -\alias{add_grade_column} -\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} -\usage{ -add_grade_column(x) -} -\arguments{ -\item{x}{(\code{gtsummary})\cr -A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table -(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} -} -\value{ -The input gtsummary table with grade column formatting applied. -} -\description{ -Post-processing function that applies visual formatting to tables generated by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging -(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking -the \code{label} column prior to merge. - -The function: -\itemize{ -\item Creates a \code{label_grade} column to display grade labels separately. -\item Blanks the \code{label} column for grade-level rows. -\item Removes statistics from non-summary rows (SOC label rows without rates). -\item Applies indentation for grade levels within grade groups. -\item Updates column headers and formatting. -} -} -\details{ -The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via -\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). -If no metadata is found, the function aborts with an informative error. -\subsection{Intended Workflow}{ - -\if{html}{\out{
}}\preformatted{# Standalone -tbl_hierarchical_rate_by_grade(...) |> add_grade_column() - -# With pooled columns -tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -}\if{html}{\out{
}} -} -} -\examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} -ADSL <- cards::ADSL -ADAE_subset <- cards::ADAE |> - dplyr::filter( - AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], - AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] - ) - -grade_groups <- list( - "Grade 1-2" = c("1", "2"), - "Grade 3-4" = c("3", "4"), - "Grade 5" = "5" -) - -# Standalone usage -tbl_hierarchical_rate_by_grade( - ADAE_subset, - variables = c(AEBODSYS, AEDECOD, AETOXGR), - denominator = ADSL, - by = TRTA, - grade_groups = grade_groups -) |> - add_grade_column() -\dontshow{\}) # examplesIf} -} From 3b6551778ffd019edfbfbb8d909c288a3d20e650 Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:20:53 +0000 Subject: [PATCH 16/46] refactor: move add_grade_column() into tbl_hierarchical_rate_by_grade.R Tightly coupled function now shares the same file and help page via @rdname. Removed standalone R/add_grade_column.R and its man page. --- R/add_grade_column.R | 163 ----------------------------- R/tbl_hierarchical_rate_by_grade.R | 122 +++++++++++++++++++++ man/add_grade_column.Rd | 72 ------------- 3 files changed, 122 insertions(+), 235 deletions(-) delete mode 100644 R/add_grade_column.R delete mode 100644 man/add_grade_column.Rd diff --git a/R/add_grade_column.R b/R/add_grade_column.R deleted file mode 100644 index 7af0c380..00000000 --- a/R/add_grade_column.R +++ /dev/null @@ -1,163 +0,0 @@ -#' Add Grade Column to Hierarchical Rate-by-Grade Tables -#' -#' @description -#' -#' Post-processing function that applies visual formatting to tables generated by -#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging -#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking -#' the `label` column prior to merge. -#' -#' The function: -#' - Creates a `label_grade` column to display grade labels separately. -#' - Blanks the `label` column for grade-level rows. -#' - Removes statistics from non-summary rows (SOC label rows without rates). -#' - Applies indentation for grade levels within grade groups. -#' - Updates column headers and formatting. -#' -#' @param x (`gtsummary`)\cr -#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table -#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by -#' [tbl_hierarchical_rate_by_grade()]. -#' -#' @details -#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). -#' If no metadata is found, the function aborts with an informative error. -#' -#' ## Intended Workflow -#' -#' ```r -#' # Standalone -#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() -#' -#' # With pooled columns -#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -#' ``` -#' -#' @returns The input gtsummary table with grade column formatting applied. -#' @export -#' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") -#' ADSL <- cards::ADSL -#' ADAE_subset <- cards::ADAE |> -#' dplyr::filter( -#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], -#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] -#' ) -#' -#' grade_groups <- list( -#' "Grade 1-2" = c("1", "2"), -#' "Grade 3-4" = c("3", "4"), -#' "Grade 5" = "5" -#' ) -#' -#' # Standalone usage -#' tbl_hierarchical_rate_by_grade( -#' ADAE_subset, -#' variables = c(AEBODSYS, AEDECOD, AETOXGR), -#' denominator = ADSL, -#' by = TRTA, -#' grade_groups = grade_groups -#' ) |> -#' add_grade_column() -add_grade_column <- function(x) { - set_cli_abort_call() - - if (!inherits(x, "gtsummary")) { - cli::cli_abort( - "{.arg x} must be a {.cls gtsummary} object.", - call = get_cli_abort_call() - ) - } - - # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) - - # extract metadata: standalone vs merged table - info <- x$custom_info %||% - Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) - - if (is.null(info)) { - cli::cli_abort( - c( - "No {.field custom_info} metadata found on the input table.", - "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." - ), - call = get_cli_abort_call() - ) - } - - soc <- info$soc - ae <- info$ae - grade <- info$grade - grade_groups <- info$grade_groups - lvls <- info$lvls - label_list <- info$label_list - - # apply visual formatting to the table body - x <- x |> - gtsummary::modify_table_body( - \(table_body) { - table_body |> - dplyr::rowwise() |> - # create label_grade column - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from non-summary rows - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() - } - ) |> - # show and align label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header labels - gtsummary::modify_header( - label ~ paste0( - label_list[[soc]], " \n", - paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] - ), - label_grade ~ label_list[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" - ) - - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - x <- x |> - gtsummary::modify_indent( - columns = "label_grade", - rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - - x -} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 65e7ba25..104eb859 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -473,3 +473,125 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @rdname tbl_hierarchical_rate_by_grade #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] + +#' @rdname tbl_hierarchical_rate_by_grade +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' ## `add_grade_column()` +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. Must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' @export +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + + # extract metadata: standalone vs merged table + info <- x$custom_info %||% + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd deleted file mode 100644 index c52b75ec..00000000 --- a/man/add_grade_column.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_grade_column.R -\name{add_grade_column} -\alias{add_grade_column} -\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} -\usage{ -add_grade_column(x) -} -\arguments{ -\item{x}{(\code{gtsummary})\cr -A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table -(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} -} -\value{ -The input gtsummary table with grade column formatting applied. -} -\description{ -Post-processing function that applies visual formatting to tables generated by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging -(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking -the \code{label} column prior to merge. - -The function: -\itemize{ -\item Creates a \code{label_grade} column to display grade labels separately. -\item Blanks the \code{label} column for grade-level rows. -\item Removes statistics from non-summary rows (SOC label rows without rates). -\item Applies indentation for grade levels within grade groups. -\item Updates column headers and formatting. -} -} -\details{ -The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via -\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). -If no metadata is found, the function aborts with an informative error. -\subsection{Intended Workflow}{ - -\if{html}{\out{
}}\preformatted{# Standalone -tbl_hierarchical_rate_by_grade(...) |> add_grade_column() - -# With pooled columns -tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -}\if{html}{\out{
}} -} -} -\examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} -ADSL <- cards::ADSL -ADAE_subset <- cards::ADAE |> - dplyr::filter( - AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], - AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] - ) - -grade_groups <- list( - "Grade 1-2" = c("1", "2"), - "Grade 3-4" = c("3", "4"), - "Grade 5" = "5" -) - -# Standalone usage -tbl_hierarchical_rate_by_grade( - ADAE_subset, - variables = c(AEBODSYS, AEDECOD, AETOXGR), - denominator = ADSL, - by = TRTA, - grade_groups = grade_groups -) |> - add_grade_column() -\dontshow{\}) # examplesIf} -} From cc636c2435b11dcdfeb88f00c82f08aa3be65c07 Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:35:10 +0000 Subject: [PATCH 17/46] style: place @rdname directly above @export for add_grade_column Co-authored-by: Ona --- R/tbl_hierarchical_rate_by_grade.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 104eb859..f95cdb71 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -474,8 +474,6 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] -#' @rdname tbl_hierarchical_rate_by_grade -#' #' @param x (`gtsummary`)\cr #' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table #' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by @@ -493,6 +491,7 @@ add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_ove #' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' +#' @rdname tbl_hierarchical_rate_by_grade #' @export add_grade_column <- function(x) { set_cli_abort_call() From a8ca796177091e80f96fe4d5f6647ffcf33825c5 Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:35:10 +0000 Subject: [PATCH 18/46] style: place @rdname directly above @export for add_grade_column --- R/tbl_hierarchical_rate_by_grade.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 104eb859..f95cdb71 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -474,8 +474,6 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] -#' @rdname tbl_hierarchical_rate_by_grade -#' #' @param x (`gtsummary`)\cr #' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table #' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by @@ -493,6 +491,7 @@ add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_ove #' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' +#' @rdname tbl_hierarchical_rate_by_grade #' @export add_grade_column <- function(x) { set_cli_abort_call() From 8307e4b4ac575b9edf7203cb60dc814e7f1e3b4f Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 12:37:18 +0000 Subject: [PATCH 19/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. Also added AGENTS.md to .gitignore. Co-authored-by: Ona --- .gitignore | 1 + R/tbl_mmrm.R | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index cc50487d..812039fe 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .Rproj.user .Rhistory docs +AGENTS.md diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From fd5912f841ec496c4e003e70a3f35bc4592084e8 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 12:37:18 +0000 Subject: [PATCH 20/46] fix: wrap bare string vars with all_of() in tbl_mmrm to silence tidyselect deprecation Three tidyselect contexts in tbl_mmrm() were passing string variables (arm, visit) as bare names instead of using all_of(). This triggered deprecation warnings from tidyselect 1.1.0+. Also added AGENTS.md to .gitignore. --- .gitignore | 1 + R/tbl_mmrm.R | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index cc50487d..812039fe 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .Rproj.user .Rhistory docs +AGENTS.md diff --git a/R/tbl_mmrm.R b/R/tbl_mmrm.R index a1719a8d..59daa932 100644 --- a/R/tbl_mmrm.R +++ b/R/tbl_mmrm.R @@ -195,7 +195,7 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, if (NROW(base_df) > 0) { cards::process_selectors( base_df, - arm = arm, visit = visit, baseline_aval = {{ baseline_aval }} + arm = all_of(arm), visit = all_of(visit), baseline_aval = {{ baseline_aval }} ) check_data_frame(base_df) check_string(baseline_aval) @@ -251,12 +251,12 @@ tbl_mmrm <- function(mmrm_df, base_df = NULL, arm, visit, baseline_aval = NULL, # 4. Build Post-Baseline MMRM Table gts_mmrm <- mmrm_df |> gtsummary::tbl_strata( - strata = visit, + strata = all_of(visit), .combine_with = "tbl_stack", .header = "{strata}", .tbl_fun = ~ .x |> tbl_custom_summary( - by = arm, + by = all_of(arm), include = c(n, estimate_est, lower_cl_est, estimate_contr, lower_cl_contr, p_value), # MANDATORY: This stops the variable labels from repeating across two lines! type = list(everything() ~ "continuous"), From 6ebd3f158ba6219d104e454a147b430f0da25d85 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 13:20:53 +0000 Subject: [PATCH 21/46] refactor: move add_grade_column() into tbl_hierarchical_rate_by_grade.R Tightly coupled function now shares the same file and help page via @rdname. Removed standalone R/add_grade_column.R and its man page. Co-authored-by: Ona --- R/add_grade_column.R | 163 ----------------------------- R/tbl_hierarchical_rate_by_grade.R | 122 +++++++++++++++++++++ man/add_grade_column.Rd | 72 ------------- 3 files changed, 122 insertions(+), 235 deletions(-) delete mode 100644 R/add_grade_column.R delete mode 100644 man/add_grade_column.Rd diff --git a/R/add_grade_column.R b/R/add_grade_column.R deleted file mode 100644 index 7af0c380..00000000 --- a/R/add_grade_column.R +++ /dev/null @@ -1,163 +0,0 @@ -#' Add Grade Column to Hierarchical Rate-by-Grade Tables -#' -#' @description -#' -#' Post-processing function that applies visual formatting to tables generated by -#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging -#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking -#' the `label` column prior to merge. -#' -#' The function: -#' - Creates a `label_grade` column to display grade labels separately. -#' - Blanks the `label` column for grade-level rows. -#' - Removes statistics from non-summary rows (SOC label rows without rates). -#' - Applies indentation for grade levels within grade groups. -#' - Updates column headers and formatting. -#' -#' @param x (`gtsummary`)\cr -#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table -#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by -#' [tbl_hierarchical_rate_by_grade()]. -#' -#' @details -#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). -#' If no metadata is found, the function aborts with an informative error. -#' -#' ## Intended Workflow -#' -#' ```r -#' # Standalone -#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() -#' -#' # With pooled columns -#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -#' ``` -#' -#' @returns The input gtsummary table with grade column formatting applied. -#' @export -#' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") -#' ADSL <- cards::ADSL -#' ADAE_subset <- cards::ADAE |> -#' dplyr::filter( -#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], -#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] -#' ) -#' -#' grade_groups <- list( -#' "Grade 1-2" = c("1", "2"), -#' "Grade 3-4" = c("3", "4"), -#' "Grade 5" = "5" -#' ) -#' -#' # Standalone usage -#' tbl_hierarchical_rate_by_grade( -#' ADAE_subset, -#' variables = c(AEBODSYS, AEDECOD, AETOXGR), -#' denominator = ADSL, -#' by = TRTA, -#' grade_groups = grade_groups -#' ) |> -#' add_grade_column() -add_grade_column <- function(x) { - set_cli_abort_call() - - if (!inherits(x, "gtsummary")) { - cli::cli_abort( - "{.arg x} must be a {.cls gtsummary} object.", - call = get_cli_abort_call() - ) - } - - # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) - - # extract metadata: standalone vs merged table - info <- x$custom_info %||% - Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) - - if (is.null(info)) { - cli::cli_abort( - c( - "No {.field custom_info} metadata found on the input table.", - "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." - ), - call = get_cli_abort_call() - ) - } - - soc <- info$soc - ae <- info$ae - grade <- info$grade - grade_groups <- info$grade_groups - lvls <- info$lvls - label_list <- info$label_list - - # apply visual formatting to the table body - x <- x |> - gtsummary::modify_table_body( - \(table_body) { - table_body |> - dplyr::rowwise() |> - # create label_grade column - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from non-summary rows - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() - } - ) |> - # show and align label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header labels - gtsummary::modify_header( - label ~ paste0( - label_list[[soc]], " \n", - paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] - ), - label_grade ~ label_list[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" - ) - - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - x <- x |> - gtsummary::modify_indent( - columns = "label_grade", - rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - - x -} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 65e7ba25..104eb859 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -473,3 +473,125 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @rdname tbl_hierarchical_rate_by_grade #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] + +#' @rdname tbl_hierarchical_rate_by_grade +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' ## `add_grade_column()` +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. Must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' @export +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + + # extract metadata: standalone vs merged table + info <- x$custom_info %||% + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd deleted file mode 100644 index c52b75ec..00000000 --- a/man/add_grade_column.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_grade_column.R -\name{add_grade_column} -\alias{add_grade_column} -\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} -\usage{ -add_grade_column(x) -} -\arguments{ -\item{x}{(\code{gtsummary})\cr -A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table -(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} -} -\value{ -The input gtsummary table with grade column formatting applied. -} -\description{ -Post-processing function that applies visual formatting to tables generated by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging -(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking -the \code{label} column prior to merge. - -The function: -\itemize{ -\item Creates a \code{label_grade} column to display grade labels separately. -\item Blanks the \code{label} column for grade-level rows. -\item Removes statistics from non-summary rows (SOC label rows without rates). -\item Applies indentation for grade levels within grade groups. -\item Updates column headers and formatting. -} -} -\details{ -The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via -\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). -If no metadata is found, the function aborts with an informative error. -\subsection{Intended Workflow}{ - -\if{html}{\out{
}}\preformatted{# Standalone -tbl_hierarchical_rate_by_grade(...) |> add_grade_column() - -# With pooled columns -tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -}\if{html}{\out{
}} -} -} -\examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} -ADSL <- cards::ADSL -ADAE_subset <- cards::ADAE |> - dplyr::filter( - AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], - AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] - ) - -grade_groups <- list( - "Grade 1-2" = c("1", "2"), - "Grade 3-4" = c("3", "4"), - "Grade 5" = "5" -) - -# Standalone usage -tbl_hierarchical_rate_by_grade( - ADAE_subset, - variables = c(AEBODSYS, AEDECOD, AETOXGR), - denominator = ADSL, - by = TRTA, - grade_groups = grade_groups -) |> - add_grade_column() -\dontshow{\}) # examplesIf} -} From 7f0771763100137ecb8af73202fe70c2b6af6d54 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 13:20:53 +0000 Subject: [PATCH 22/46] refactor: move add_grade_column() into tbl_hierarchical_rate_by_grade.R Tightly coupled function now shares the same file and help page via @rdname. Removed standalone R/add_grade_column.R and its man page. --- R/add_grade_column.R | 163 ----------------------------- R/tbl_hierarchical_rate_by_grade.R | 122 +++++++++++++++++++++ man/add_grade_column.Rd | 72 ------------- 3 files changed, 122 insertions(+), 235 deletions(-) delete mode 100644 R/add_grade_column.R delete mode 100644 man/add_grade_column.Rd diff --git a/R/add_grade_column.R b/R/add_grade_column.R deleted file mode 100644 index 7af0c380..00000000 --- a/R/add_grade_column.R +++ /dev/null @@ -1,163 +0,0 @@ -#' Add Grade Column to Hierarchical Rate-by-Grade Tables -#' -#' @description -#' -#' Post-processing function that applies visual formatting to tables generated by -#' [tbl_hierarchical_rate_by_grade()]. This function must be called **after** any merging -#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking -#' the `label` column prior to merge. -#' -#' The function: -#' - Creates a `label_grade` column to display grade labels separately. -#' - Blanks the `label` column for grade-level rows. -#' - Removes statistics from non-summary rows (SOC label rows without rates). -#' - Applies indentation for grade levels within grade groups. -#' - Updates column headers and formatting. -#' -#' @param x (`gtsummary`)\cr -#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table -#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by -#' [tbl_hierarchical_rate_by_grade()]. -#' -#' @details -#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via -#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). -#' If no metadata is found, the function aborts with an informative error. -#' -#' ## Intended Workflow -#' -#' ```r -#' # Standalone -#' tbl_hierarchical_rate_by_grade(...) |> add_grade_column() -#' -#' # With pooled columns -#' tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -#' ``` -#' -#' @returns The input gtsummary table with grade column formatting applied. -#' @export -#' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") -#' ADSL <- cards::ADSL -#' ADAE_subset <- cards::ADAE |> -#' dplyr::filter( -#' AESOC %in% unique(cards::ADAE$AESOC)[1:5], -#' AETERM %in% unique(cards::ADAE$AETERM)[1:5] -#' ) -#' -#' grade_groups <- list( -#' "Grade 1-2" = c("1", "2"), -#' "Grade 3-4" = c("3", "4"), -#' "Grade 5" = "5" -#' ) -#' -#' # Standalone usage -#' tbl_hierarchical_rate_by_grade( -#' ADAE_subset, -#' variables = c(AEBODSYS, AEDECOD, AETOXGR), -#' denominator = ADSL, -#' by = TRTA, -#' grade_groups = grade_groups -#' ) |> -#' add_grade_column() -add_grade_column <- function(x) { - set_cli_abort_call() - - if (!inherits(x, "gtsummary")) { - cli::cli_abort( - "{.arg x} must be a {.cls gtsummary} object.", - call = get_cli_abort_call() - ) - } - - # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) - - # extract metadata: standalone vs merged table - info <- x$custom_info %||% - Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) - - if (is.null(info)) { - cli::cli_abort( - c( - "No {.field custom_info} metadata found on the input table.", - "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." - ), - call = get_cli_abort_call() - ) - } - - soc <- info$soc - ae <- info$ae - grade <- info$grade - grade_groups <- info$grade_groups - lvls <- info$lvls - label_list <- info$label_list - - # apply visual formatting to the table body - x <- x |> - gtsummary::modify_table_body( - \(table_body) { - table_body |> - dplyr::rowwise() |> - # create label_grade column - dplyr::mutate( - label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", - .default = "" - ), - .after = "label" - ) |> - # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> - # remove statistics from non-summary rows - dplyr::mutate( - across( - gtsummary::all_stat_cols(), - ~ if ( - .data$variable %in% c(ae, "..ard_hierarchical_overall..") | - .data$label_grade %in% c(lvls, names(grade_groups)) | - .data$label == "- Any adverse events -" - ) { - . - } else { - NA - } - ) - ) |> - dplyr::ungroup() - } - ) |> - # show and align label_grade column - gtsummary::modify_column_unhide("label_grade") |> - gtsummary::modify_column_alignment("label_grade", align = "left") |> - # remove default footnote - gtsummary::remove_footnote_header(columns = everything()) |> - # convert "0 (0.0%)" to "0" - gtsummary::modify_post_fmt_fun( - fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), - columns = gtsummary::all_stat_cols() - ) |> - # update header labels - gtsummary::modify_header( - label ~ paste0( - label_list[[soc]], " \n", - paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] - ), - label_grade ~ label_list[[grade]], - gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" - ) - - # indent grade level labels within grade groups - if (!is_empty(grade_groups)) { - x <- x |> - gtsummary::modify_indent( - columns = "label_grade", - rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), - indent = 4L - ) - } - - x -} diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 65e7ba25..104eb859 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -473,3 +473,125 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @rdname tbl_hierarchical_rate_by_grade #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] + +#' @rdname tbl_hierarchical_rate_by_grade +#' +#' @param x (`gtsummary`)\cr +#' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table +#' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by +#' [tbl_hierarchical_rate_by_grade()]. +#' +#' @details +#' ## `add_grade_column()` +#' +#' Post-processing function that applies visual formatting to tables generated by +#' [tbl_hierarchical_rate_by_grade()]. Must be called **after** any merging +#' (e.g., via [tbl_with_pools()]) to avoid Cartesian join explosions caused by blanking +#' the `label` column prior to merge. +#' +#' The function extracts metadata injected by [tbl_hierarchical_rate_by_grade()] via +#' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). +#' If no metadata is found, the function aborts with an informative error. +#' +#' @export +add_grade_column <- function(x) { + set_cli_abort_call() + + if (!inherits(x, "gtsummary")) { + cli::cli_abort( + "{.arg x} must be a {.cls gtsummary} object.", + call = get_cli_abort_call() + ) + } + + # idempotency guard: skip if already applied + if ("label_grade" %in% names(x$table_body)) return(x) + + # extract metadata: standalone vs merged table + info <- x$custom_info %||% + Find(Negate(is.null), lapply(x$tbls, \(t) t$custom_info)) + + if (is.null(info)) { + cli::cli_abort( + c( + "No {.field custom_info} metadata found on the input table.", + "i" = "Ensure the table was created with {.fun tbl_hierarchical_rate_by_grade}." + ), + call = get_cli_abort_call() + ) + } + + soc <- info$soc + ae <- info$ae + grade <- info$grade + grade_groups <- info$grade_groups + lvls <- info$lvls + label_list <- info$label_list + + # apply visual formatting to the table body + x <- x |> + gtsummary::modify_table_body( + \(table_body) { + table_body |> + dplyr::rowwise() |> + # create label_grade column + dplyr::mutate( + label_grade = dplyr::case_when( + .data$variable == grade ~ label, + .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .default = "" + ), + .after = "label" + ) |> + # blank the label column for grade rows (safe after merge) + dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + # remove statistics from non-summary rows + dplyr::mutate( + across( + gtsummary::all_stat_cols(), + ~ if ( + .data$variable %in% c(ae, "..ard_hierarchical_overall..") | + .data$label_grade %in% c(lvls, names(grade_groups)) | + .data$label == "- Any adverse events -" + ) { + . + } else { + NA + } + ) + ) |> + dplyr::ungroup() + } + ) |> + # show and align label_grade column + gtsummary::modify_column_unhide("label_grade") |> + gtsummary::modify_column_alignment("label_grade", align = "left") |> + # remove default footnote + gtsummary::remove_footnote_header(columns = everything()) |> + # convert "0 (0.0%)" to "0" + gtsummary::modify_post_fmt_fun( + fmt_fun = ~ ifelse(. %in% c("0 (0.0%)", "0 (NA%)"), "0", .), + columns = gtsummary::all_stat_cols() + ) |> + # update header labels + gtsummary::modify_header( + label ~ paste0( + label_list[[soc]], " \n", + paste0(rep("\U00A0", 4L), collapse = ""), label_list[[ae]] + ), + label_grade ~ label_list[[grade]], + gtsummary::all_stat_cols() ~ "{level} \n(N = {n})" + ) + + # indent grade level labels within grade groups + if (!is_empty(grade_groups)) { + x <- x |> + gtsummary::modify_indent( + columns = "label_grade", + rows = .data$variable == grade & .data$label_grade %in% unlist(grade_groups), + indent = 4L + ) + } + + x +} diff --git a/man/add_grade_column.Rd b/man/add_grade_column.Rd deleted file mode 100644 index c52b75ec..00000000 --- a/man/add_grade_column.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_grade_column.R -\name{add_grade_column} -\alias{add_grade_column} -\title{Add Grade Column to Hierarchical Rate-by-Grade Tables} -\usage{ -add_grade_column(x) -} -\arguments{ -\item{x}{(\code{gtsummary})\cr -A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table -(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} -} -\value{ -The input gtsummary table with grade column formatting applied. -} -\description{ -Post-processing function that applies visual formatting to tables generated by -\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. This function must be called \strong{after} any merging -(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking -the \code{label} column prior to merge. - -The function: -\itemize{ -\item Creates a \code{label_grade} column to display grade labels separately. -\item Blanks the \code{label} column for grade-level rows. -\item Removes statistics from non-summary rows (SOC label rows without rates). -\item Applies indentation for grade levels within grade groups. -\item Updates column headers and formatting. -} -} -\details{ -The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via -\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). -If no metadata is found, the function aborts with an informative error. -\subsection{Intended Workflow}{ - -\if{html}{\out{
}}\preformatted{# Standalone -tbl_hierarchical_rate_by_grade(...) |> add_grade_column() - -# With pooled columns -tbl_with_pools(..., .tbl_fun = tbl_hierarchical_rate_by_grade) |> add_grade_column() -}\if{html}{\out{
}} -} -} -\examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} -ADSL <- cards::ADSL -ADAE_subset <- cards::ADAE |> - dplyr::filter( - AESOC \%in\% unique(cards::ADAE$AESOC)[1:5], - AETERM \%in\% unique(cards::ADAE$AETERM)[1:5] - ) - -grade_groups <- list( - "Grade 1-2" = c("1", "2"), - "Grade 3-4" = c("3", "4"), - "Grade 5" = "5" -) - -# Standalone usage -tbl_hierarchical_rate_by_grade( - ADAE_subset, - variables = c(AEBODSYS, AEDECOD, AETOXGR), - denominator = ADSL, - by = TRTA, - grade_groups = grade_groups -) |> - add_grade_column() -\dontshow{\}) # examplesIf} -} From 098515553e05e8d3a8a5e84de157b5bc8e3c0eb1 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 13:35:10 +0000 Subject: [PATCH 23/46] style: place @rdname directly above @export for add_grade_column Co-authored-by: Ona --- R/tbl_hierarchical_rate_by_grade.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 104eb859..f95cdb71 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -474,8 +474,6 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] -#' @rdname tbl_hierarchical_rate_by_grade -#' #' @param x (`gtsummary`)\cr #' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table #' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by @@ -493,6 +491,7 @@ add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_ove #' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' +#' @rdname tbl_hierarchical_rate_by_grade #' @export add_grade_column <- function(x) { set_cli_abort_call() From 83afb768ad9b423d4252e6d6c954705b670cea16 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 6 May 2026 13:35:10 +0000 Subject: [PATCH 24/46] style: place @rdname directly above @export for add_grade_column --- R/tbl_hierarchical_rate_by_grade.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 104eb859..f95cdb71 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -474,8 +474,6 @@ tbl_hierarchical_rate_by_grade <- function(data, #' @export add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_overall.tbl_hierarchical"]] -#' @rdname tbl_hierarchical_rate_by_grade -#' #' @param x (`gtsummary`)\cr #' A gtsummary table produced by [tbl_hierarchical_rate_by_grade()], or a merged table #' (e.g., from [tbl_with_pools()]) where the underlying tables were produced by @@ -493,6 +491,7 @@ add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_ove #' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' +#' @rdname tbl_hierarchical_rate_by_grade #' @export add_grade_column <- function(x) { set_cli_abort_call() From f6f6561b23f3e7db04254368276b2fabadc691ee Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 15:44:07 +0200 Subject: [PATCH 25/46] fix --- man/tbl_hierarchical_rate_by_grade.Rd | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/man/tbl_hierarchical_rate_by_grade.Rd b/man/tbl_hierarchical_rate_by_grade.Rd index 6a945e93..380dab02 100644 --- a/man/tbl_hierarchical_rate_by_grade.Rd +++ b/man/tbl_hierarchical_rate_by_grade.Rd @@ -3,6 +3,7 @@ \name{tbl_hierarchical_rate_by_grade} \alias{tbl_hierarchical_rate_by_grade} \alias{add_overall.tbl_hierarchical_rate_by_grade} +\alias{add_grade_column} \title{AE Rates by Highest Toxicity Grade} \usage{ tbl_hierarchical_rate_by_grade( @@ -30,6 +31,8 @@ tbl_hierarchical_rate_by_grade( digits = NULL, ... ) + +add_grade_column(x) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -108,8 +111,10 @@ computing overall totals and grade group totals. For example, to avoid duplicati Whether rows containing zero rates across all columns should be kept. If \code{FALSE}, this filter will be applied prior to any filters specified via the \code{filter} argument which may still remove these rows. Defaults to \code{FALSE}.} -\item{x}{(\code{tbl_hierarchical_rate_by_grade})\cr -A gtsummary table of class \code{'tbl_hierarchical_rate_by_grade'}.} +\item{x}{(\code{gtsummary})\cr +A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table +(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} \item{last}{(scalar \code{logical})\cr Logical indicator to display overall column last in table. @@ -147,6 +152,18 @@ all AEs for a given SOC have been filtered out, the SOC will be excluded from th and the SOC variable is included in \code{include_overall} the \verb{- Any adverse events -} section will still be kept. See \code{\link[gtsummary:filter_hierarchical]{gtsummary::filter_hierarchical()}} for more details and examples. + +\subsection{\code{add_grade_column()}}{ + +Post-processing function that applies visual formatting to tables generated by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. Must be called \strong{after} any merging +(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking +the \code{label} column prior to merge. + +The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via +\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). +If no metadata is found, the function aborts with an informative error. +} } \examples{ \dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} From a74067c2ba92e7a725d864ffd8135a712fb6c9ab Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 15:44:07 +0200 Subject: [PATCH 26/46] fix --- man/tbl_hierarchical_rate_by_grade.Rd | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/man/tbl_hierarchical_rate_by_grade.Rd b/man/tbl_hierarchical_rate_by_grade.Rd index 6a945e93..380dab02 100644 --- a/man/tbl_hierarchical_rate_by_grade.Rd +++ b/man/tbl_hierarchical_rate_by_grade.Rd @@ -3,6 +3,7 @@ \name{tbl_hierarchical_rate_by_grade} \alias{tbl_hierarchical_rate_by_grade} \alias{add_overall.tbl_hierarchical_rate_by_grade} +\alias{add_grade_column} \title{AE Rates by Highest Toxicity Grade} \usage{ tbl_hierarchical_rate_by_grade( @@ -30,6 +31,8 @@ tbl_hierarchical_rate_by_grade( digits = NULL, ... ) + +add_grade_column(x) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -108,8 +111,10 @@ computing overall totals and grade group totals. For example, to avoid duplicati Whether rows containing zero rates across all columns should be kept. If \code{FALSE}, this filter will be applied prior to any filters specified via the \code{filter} argument which may still remove these rows. Defaults to \code{FALSE}.} -\item{x}{(\code{tbl_hierarchical_rate_by_grade})\cr -A gtsummary table of class \code{'tbl_hierarchical_rate_by_grade'}.} +\item{x}{(\code{gtsummary})\cr +A gtsummary table produced by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}, or a merged table +(e.g., from \code{\link[=tbl_with_pools]{tbl_with_pools()}}) where the underlying tables were produced by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}.} \item{last}{(scalar \code{logical})\cr Logical indicator to display overall column last in table. @@ -147,6 +152,18 @@ all AEs for a given SOC have been filtered out, the SOC will be excluded from th and the SOC variable is included in \code{include_overall} the \verb{- Any adverse events -} section will still be kept. See \code{\link[gtsummary:filter_hierarchical]{gtsummary::filter_hierarchical()}} for more details and examples. + +\subsection{\code{add_grade_column()}}{ + +Post-processing function that applies visual formatting to tables generated by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}}. Must be called \strong{after} any merging +(e.g., via \code{\link[=tbl_with_pools]{tbl_with_pools()}}) to avoid Cartesian join explosions caused by blanking +the \code{label} column prior to merge. + +The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via +\code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). +If no metadata is found, the function aborts with an informative error. +} } \examples{ \dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) withAutoprint(\{ # examplesIf} From 280fe3e737dc05186c608c40ac8669abc05e41bb Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:49:02 +0000 Subject: [PATCH 27/46] test: cover character grade with missing grade group levels (lines 169-171) Co-authored-by: Ona --- .../test-tbl_hierarchical_rate_by_grade.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 96aea1a5..05e61f74 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -292,6 +292,25 @@ test_that("tbl_hierarchical_rate_by_grade(grade_groups) works with some grades n ) }) +test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels to character grade", { + # character grade column (not factor), partial grade groups with a level absent from data + ADAE_char <- ADAE_subset + ADAE_char$AETOXGR <- as.character(ADAE_char$AETOXGR) + ADAE_char <- ADAE_char[!ADAE_char$AETOXGR %in% c("1", "2"), ] + + # grade_groups reference grades "1" and "2" which are absent from data + expect_silent( + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_char, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) + ) + ) +}) + test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { # no grades excluded tbl_no_excl <- From 48990aa565d92aa3e38921f9fbe8a10837a97d38 Mon Sep 17 00:00:00 2001 From: jszczypinski <79863450+jszczypinski@users.noreply.github.com> Date: Wed, 6 May 2026 13:49:02 +0000 Subject: [PATCH 28/46] test: cover character grade with missing grade group levels (lines 169-171) --- .../test-tbl_hierarchical_rate_by_grade.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 96aea1a5..05e61f74 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -292,6 +292,25 @@ test_that("tbl_hierarchical_rate_by_grade(grade_groups) works with some grades n ) }) +test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels to character grade", { + # character grade column (not factor), partial grade groups with a level absent from data + ADAE_char <- ADAE_subset + ADAE_char$AETOXGR <- as.character(ADAE_char$AETOXGR) + ADAE_char <- ADAE_char[!ADAE_char$AETOXGR %in% c("1", "2"), ] + + # grade_groups reference grades "1" and "2" which are absent from data + expect_silent( + tbl <- tbl_hierarchical_rate_by_grade( + ADAE_char, + variables = c(AEBODSYS, AEDECOD, AETOXGR), + denominator = ADSL, + by = TRTA, + label = label, + grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) + ) + ) +}) + test_that("tbl_hierarchical_rate_by_grade(grades_exclude) works", { # no grades excluded tbl_no_excl <- From 0af0743543ca7740c74b84f6b154e345243ca2d7 Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 17:54:56 +0200 Subject: [PATCH 29/46] fix --- tests/testthat/test-tbl_hierarchical_rate_by_grade.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 05e61f74..4c190ac8 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -299,7 +299,7 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t ADAE_char <- ADAE_char[!ADAE_char$AETOXGR %in% c("1", "2"), ] # grade_groups reference grades "1" and "2" which are absent from data - expect_silent( + expect_message( tbl <- tbl_hierarchical_rate_by_grade( ADAE_char, variables = c(AEBODSYS, AEDECOD, AETOXGR), @@ -307,7 +307,8 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t by = TRTA, label = label, grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) - ) + ), + '\\`AETOXGR\\`: ' ) }) From 004db2bcf24561302e5d88db4b2b9626eec282c3 Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 6 May 2026 17:54:56 +0200 Subject: [PATCH 30/46] fix --- tests/testthat/test-tbl_hierarchical_rate_by_grade.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 05e61f74..4c190ac8 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -299,7 +299,7 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t ADAE_char <- ADAE_char[!ADAE_char$AETOXGR %in% c("1", "2"), ] # grade_groups reference grades "1" and "2" which are absent from data - expect_silent( + expect_message( tbl <- tbl_hierarchical_rate_by_grade( ADAE_char, variables = c(AEBODSYS, AEDECOD, AETOXGR), @@ -307,7 +307,8 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t by = TRTA, label = label, grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) - ) + ), + '\\`AETOXGR\\`: ' ) }) From a0ebb77c6a9fd769e3bd8840aa236e1b6889f0ba Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Fri, 8 May 2026 13:07:19 +0200 Subject: [PATCH 31/46] Apply suggestion from @Melkiades Signed-off-by: Davide Garolini --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index 812039fe..cc50487d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ .Rproj.user .Rhistory docs -AGENTS.md From d4b5b40df11b19849fc20deb1ede99d612c21adf Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Fri, 8 May 2026 13:07:19 +0200 Subject: [PATCH 32/46] Apply suggestion from the reviewer --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index 812039fe..cc50487d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ .Rproj.user .Rhistory docs -AGENTS.md From 937eca4ad7201d11a0c0e966b5f5a3d604a1de87 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Fri, 8 May 2026 11:17:22 +0000 Subject: [PATCH 33/46] fix: use .data$label to resolve R CMD check NOTE Bare `label` inside modify_table_body() lambda is not visible to R CMD check. Use .data$label for all references. Co-authored-by: Ona --- R/tbl_hierarchical_rate_by_grade.R | 6 +- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++++-------- 2 files changed, 129 insertions(+), 109 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index f95cdb71..1bd56690 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -536,14 +536,14 @@ add_grade_column <- function(x) { # create label_grade column dplyr::mutate( label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .data$variable == grade ~ .data$label, + .data$variable == ae | .data$label == "- Any adverse events -" ~ "- Any Grade -", .default = "" ), .after = "label" ) |> # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + dplyr::mutate(label = if (.data$variable == grade) "" else .data$label) |> # remove statistics from non-summary rows dplyr::mutate( across( diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 3f88730c..a7b39b67 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,137 +2,157 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 1 20(23.3%) 23(27.4%) 20(23.8%) + 3 2 2(2.3%) 9(10.7%) 10(11.9%) + 4 3 3(3.5%) 10(11.9%) 8(9.5%) + 5 4 1(1.2%) 0(0.0%) 2(2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 8 1 1(1.2%) 1(1.2%) 0(0.0%) + 9 2 0(0.0%) 2(2.4%) 0(0.0%) + 10 4 1(1.2%) 0(0.0%) 0(0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 12 1 1(1.2%) 1(1.2%) 0(0.0%) + 13 2 0(0.0%) 2(2.4%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 17 1 9(10.5%) 2(2.4%) 5(6.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 20 1 9(10.5%) 2(2.4%) 5(6.0%) + 21 2 0(0.0%) 2(2.4%) 0(0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) + 24 1 7(8.1%) 12(14.3%) 12(14.3%) + 25 2 0(0.0%) 4(4.8%) 4(4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0(0.0%) 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 11 1 1(1.2%) 1(1.2%) 0(0.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 17 1 1(1.2%) 1(1.2%) 0(0.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 20 4 1(1.2%) 0(0.0%) 0(0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0(0.0%) 2(2.4%) 0(0.0%) --- Code as.data.frame(add_grade_column(tbl))[1, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0(0.0%) 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 11 1 1(1.2%) 1(1.2%) 0(0.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 17 1 1(1.2%) 1(1.2%) 0(0.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 20 4 1(1.2%) 0(0.0%) 0(0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0(0.0%) 2(2.4%) 0(0.0%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) - 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) - 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 3 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 4 1 1(1.2%) 1(1.2%) 0(0.0%) + 5 2 0(0.0%) 2(2.4%) 0(0.0%) + 6 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 7 4 1(1.2%) 0(0.0%) 0(0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 11 1 9(10.5%) 2(2.4%) 5(6.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) + 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) + 16 1 3(3.5%) 9(10.7%) 4(4.8%) + 17 2 0(0.0%) 3(3.6%) 3(3.6%) + 18 Grade 3-4 0(0.0%) 3(3.6%) 5(6.0%) + 19 3 0(0.0%) 3(3.6%) 3(3.6%) + 20 4 0(0.0%) 0(0.0%) 2(2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) + 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) + 23 1 5(5.8%) 10(11.9%) 13(15.5%) + 24 2 0(0.0%) 5(6.0%) 4(4.8%) + 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From 1e233a4f2069619e6d4799d6f7e40d68f226053a Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Fri, 8 May 2026 11:17:22 +0000 Subject: [PATCH 34/46] fix: use .data$label to resolve R CMD check NOTE Bare `label` inside modify_table_body() lambda is not visible to R CMD check. Use .data$label for all references. --- R/tbl_hierarchical_rate_by_grade.R | 6 +- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++++-------- 2 files changed, 129 insertions(+), 109 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index f95cdb71..1bd56690 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -536,14 +536,14 @@ add_grade_column <- function(x) { # create label_grade column dplyr::mutate( label_grade = dplyr::case_when( - .data$variable == grade ~ label, - .data$variable == ae | label == "- Any adverse events -" ~ "- Any Grade -", + .data$variable == grade ~ .data$label, + .data$variable == ae | .data$label == "- Any adverse events -" ~ "- Any Grade -", .default = "" ), .after = "label" ) |> # blank the label column for grade rows (safe after merge) - dplyr::mutate(label = if (.data$variable == grade) "" else label) |> + dplyr::mutate(label = if (.data$variable == grade) "" else .data$label) |> # remove statistics from non-summary rows dplyr::mutate( across( diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 3f88730c..a7b39b67 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,137 +2,157 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 1 20(23.3%) 23(27.4%) 20(23.8%) + 3 2 2(2.3%) 9(10.7%) 10(11.9%) + 4 3 3(3.5%) 10(11.9%) 8(9.5%) + 5 4 1(1.2%) 0(0.0%) 2(2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 8 1 1(1.2%) 1(1.2%) 0(0.0%) + 9 2 0(0.0%) 2(2.4%) 0(0.0%) + 10 4 1(1.2%) 0(0.0%) 0(0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 12 1 1(1.2%) 1(1.2%) 0(0.0%) + 13 2 0(0.0%) 2(2.4%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 17 1 9(10.5%) 2(2.4%) 5(6.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 20 1 9(10.5%) 2(2.4%) 5(6.0%) + 21 2 0(0.0%) 2(2.4%) 0(0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) + 24 1 7(8.1%) 12(14.3%) 12(14.3%) + 25 2 0(0.0%) 4(4.8%) 4(4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0(0.0%) 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 11 1 1(1.2%) 1(1.2%) 0(0.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 17 1 1(1.2%) 1(1.2%) 0(0.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 20 4 1(1.2%) 0(0.0%) 0(0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0(0.0%) 2(2.4%) 0(0.0%) --- Code as.data.frame(add_grade_column(tbl))[1, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0(0.0%) 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 11 1 1(1.2%) 1(1.2%) 0(0.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 14 4 1(1.2%) 0(0.0%) 0(0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 17 1 1(1.2%) 1(1.2%) 0(0.0%) + 18 2 0(0.0%) 2(2.4%) 0(0.0%) + 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 20 4 1(1.2%) 0(0.0%) 0(0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0(0.0%) 2(2.4%) 0(0.0%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) - 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) - 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) - 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) - 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) + 3 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) + 4 1 1(1.2%) 1(1.2%) 0(0.0%) + 5 2 0(0.0%) 2(2.4%) 0(0.0%) + 6 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) + 7 4 1(1.2%) 0(0.0%) 0(0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 11 1 9(10.5%) 2(2.4%) 5(6.0%) + 12 2 0(0.0%) 2(2.4%) 0(0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) + 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) + 16 1 3(3.5%) 9(10.7%) 4(4.8%) + 17 2 0(0.0%) 3(3.6%) 3(3.6%) + 18 Grade 3-4 0(0.0%) 3(3.6%) 5(6.0%) + 19 3 0(0.0%) 3(3.6%) 3(3.6%) + 20 4 0(0.0%) 0(0.0%) 2(2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) + 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) + 23 1 5(5.8%) 10(11.9%) 13(15.5%) + 24 2 0(0.0%) 5(6.0%) 4(4.8%) + 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From 0a33d5f4dc298c60c23d251982087601db0fb59f Mon Sep 17 00:00:00 2001 From: melkiades Date: Fri, 8 May 2026 13:29:09 +0200 Subject: [PATCH 35/46] fix snaps on local --- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++---------- 1 file changed, 106 insertions(+), 126 deletions(-) diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index a7b39b67..3f88730c 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,157 +2,137 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 1 20(23.3%) 23(27.4%) 20(23.8%) - 3 2 2(2.3%) 9(10.7%) 10(11.9%) - 4 3 3(3.5%) 10(11.9%) 8(9.5%) - 5 4 1(1.2%) 0(0.0%) 2(2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 8 1 1(1.2%) 1(1.2%) 0(0.0%) - 9 2 0(0.0%) 2(2.4%) 0(0.0%) - 10 4 1(1.2%) 0(0.0%) 0(0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 12 1 1(1.2%) 1(1.2%) 0(0.0%) - 13 2 0(0.0%) 2(2.4%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 17 1 9(10.5%) 2(2.4%) 5(6.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 20 1 9(10.5%) 2(2.4%) 5(6.0%) - 21 2 0(0.0%) 2(2.4%) 0(0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) - 24 1 7(8.1%) 12(14.3%) 12(14.3%) - 25 2 0(0.0%) 4(4.8%) 4(4.8%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) + 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) + 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0(0.0%) 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 11 1 1(1.2%) 1(1.2%) 0(0.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 17 1 1(1.2%) 1(1.2%) 0(0.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 20 4 1(1.2%) 0(0.0%) 0(0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0(0.0%) 2(2.4%) 0(0.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) --- Code as.data.frame(add_grade_column(tbl))[1, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0(0.0%) 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 11 1 1(1.2%) 1(1.2%) 0(0.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 17 1 1(1.2%) 1(1.2%) 0(0.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 20 4 1(1.2%) 0(0.0%) 0(0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0(0.0%) 2(2.4%) 0(0.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 3 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 4 1 1(1.2%) 1(1.2%) 0(0.0%) - 5 2 0(0.0%) 2(2.4%) 0(0.0%) - 6 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 7 4 1(1.2%) 0(0.0%) 0(0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 11 1 9(10.5%) 2(2.4%) 5(6.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) - 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) - 16 1 3(3.5%) 9(10.7%) 4(4.8%) - 17 2 0(0.0%) 3(3.6%) 3(3.6%) - 18 Grade 3-4 0(0.0%) 3(3.6%) 5(6.0%) - 19 3 0(0.0%) 3(3.6%) 3(3.6%) - 20 4 0(0.0%) 0(0.0%) 2(2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) - 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) - 23 1 5(5.8%) 10(11.9%) 13(15.5%) - 24 2 0(0.0%) 5(6.0%) 4(4.8%) - 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) + 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) + 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) + 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) + 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) + 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) + 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) + 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) + 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) + 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) + 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From f5cc7412f3d89b78916fe84c56dbb17458fffae1 Mon Sep 17 00:00:00 2001 From: melkiades Date: Fri, 8 May 2026 13:29:09 +0200 Subject: [PATCH 36/46] fix snaps on local --- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++---------- 1 file changed, 106 insertions(+), 126 deletions(-) diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index a7b39b67..3f88730c 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,157 +2,137 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 1 20(23.3%) 23(27.4%) 20(23.8%) - 3 2 2(2.3%) 9(10.7%) 10(11.9%) - 4 3 3(3.5%) 10(11.9%) 8(9.5%) - 5 4 1(1.2%) 0(0.0%) 2(2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 8 1 1(1.2%) 1(1.2%) 0(0.0%) - 9 2 0(0.0%) 2(2.4%) 0(0.0%) - 10 4 1(1.2%) 0(0.0%) 0(0.0%) - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 12 1 1(1.2%) 1(1.2%) 0(0.0%) - 13 2 0(0.0%) 2(2.4%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 17 1 9(10.5%) 2(2.4%) 5(6.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 20 1 9(10.5%) 2(2.4%) 5(6.0%) - 21 2 0(0.0%) 2(2.4%) 0(0.0%) - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) - 24 1 7(8.1%) 12(14.3%) 12(14.3%) - 25 2 0(0.0%) 4(4.8%) 4(4.8%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 5 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 8 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 9 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 10 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 12 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 13 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 21 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) + 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) + 25 2 0 (0.0%) 4 (4.8%) 4 (4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0(0.0%) 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 11 1 1(1.2%) 1(1.2%) 0(0.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 17 1 1(1.2%) 1(1.2%) 0(0.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 20 4 1(1.2%) 0(0.0%) 0(0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0(0.0%) 2(2.4%) 0(0.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) --- Code as.data.frame(add_grade_column(tbl))[1, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0(0.0%) 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 10 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 11 1 1(1.2%) 1(1.2%) 0(0.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 14 4 1(1.2%) 0(0.0%) 0(0.0%) - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 16 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 17 1 1(1.2%) 1(1.2%) 0(0.0%) - 18 2 0(0.0%) 2(2.4%) 0(0.0%) - 19 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 20 4 1(1.2%) 0(0.0%) 0(0.0%) - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0(0.0%) 2(2.4%) 0(0.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 (0.0%) 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 11 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 14 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 17 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 18 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 19 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 20 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 (0.0%) 2 (2.4%) 0 (0.0%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0(0.0%) - 3 Grade 1-2 1(1.2%) 3(3.6%) 0(0.0%) - 4 1 1(1.2%) 1(1.2%) 0(0.0%) - 5 2 0(0.0%) 2(2.4%) 0(0.0%) - 6 Grade 3-4 1(1.2%) 0(0.0%) 0(0.0%) - 7 4 1(1.2%) 0(0.0%) 0(0.0%) - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 11 1 9(10.5%) 2(2.4%) 5(6.0%) - 12 2 0(0.0%) 2(2.4%) 0(0.0%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) - 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) - 16 1 3(3.5%) 9(10.7%) 4(4.8%) - 17 2 0(0.0%) 3(3.6%) 3(3.6%) - 18 Grade 3-4 0(0.0%) 3(3.6%) 5(6.0%) - 19 3 0(0.0%) 3(3.6%) 3(3.6%) - 20 4 0(0.0%) 0(0.0%) 2(2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) - 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) - 23 1 5(5.8%) 10(11.9%) 13(15.5%) - 24 2 0(0.0%) 5(6.0%) 4(4.8%) - 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 (0.0%) + 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 (0.0%) + 4 1 1 (1.2%) 1 (1.2%) 0 (0.0%) + 5 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 6 Grade 3-4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 7 4 1 (1.2%) 0 (0.0%) 0 (0.0%) + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 12 2 0 (0.0%) 2 (2.4%) 0 (0.0%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) + 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) + 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) + 17 2 0 (0.0%) 3 (3.6%) 3 (3.6%) + 18 Grade 3-4 0 (0.0%) 3 (3.6%) 5 (6.0%) + 19 3 0 (0.0%) 3 (3.6%) 3 (3.6%) + 20 4 0 (0.0%) 0 (0.0%) 2 (2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) + 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) + 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) + 24 2 0 (0.0%) 5 (6.0%) 4 (4.8%) + 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From 712215314073d6e1b23135519fbb0a7dbc34a610 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Fri, 8 May 2026 11:41:48 +0000 Subject: [PATCH 37/46] test: tighten assertions and add local_wide_snapshot() helper - Fix test #2: assert no label_grade indent rows exist (was always-true) - Add comment to test #7: explain post_fmt_fun is a proxy check - Use slice_head(n = 30) for deterministic row selection - Add local_wide_snapshot() helper for consistent snapshot width Co-authored-by: Ona --- tests/testthat/_snaps/tbl_with_pools.md | 122 ++++++++++++++++-------- tests/testthat/helper-snapshot_width.R | 6 ++ tests/testthat/test-add_grade_column.R | 8 +- tests/testthat/test-tbl_with_pools.R | 8 +- 4 files changed, 95 insertions(+), 49 deletions(-) create mode 100644 tests/testthat/helper-snapshot_width.R diff --git a/tests/testthat/_snaps/tbl_with_pools.md b/tests/testthat/_snaps/tbl_with_pools.md index 6e50b28e..eea112bf 100644 --- a/tests/testthat/_snaps/tbl_with_pools.md +++ b/tests/testthat/_snaps/tbl_with_pools.md @@ -58,53 +58,93 @@ Code as.data.frame(tbl) Output - Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 - 1 Age 74 (64, 83) 61 (56, 77) 74 (68, 80) 71 (61, 79) 71 (61, 79) - 2 Sex - 3 F 4 (50.0%) 5 (45.5%) 3 (27.3%) 8 (36.4%) 12 (40.0%) - 4 M 4 (50.0%) 6 (54.5%) 8 (72.7%) 14 (63.6%) 18 (60.0%) + Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 + 1 Age 74(64,83) 61(56,77) 74(68,80) 71(61,79) 71(61,79) + 2 Sex + 3 F 4(50.0%) 5(45.5%) 3(27.3%) 8(36.4%) 12(40.0%) + 4 M 4(50.0%) 6(54.5%) 8(72.7%) 14(63.6%) 18(60.0%) # tbl_with_pools() passes the denominator correctly for custom functions Code as.data.frame(tbl) + Condition + Warning in `do.call()`: + unable to translate 'Body System or Organ Class + Dictionary-Derived Term' to native encoding Output - Body System or Organ Class \n    Dictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) All Patients \n(N = 30) - 1 Total number of participants with at least one adverse event 3 (37.5%) 2 (18.2%) 2 (18.2%) 4 (18.2%) 7 (23.3%) - 2 Overall total number of events 11 4 15 19 30 - 3 CARDIAC DISORDERS - 4 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) - 5 Total number of events 2 0 0 2 - 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1 (12.5%) 0 0 1 (3.3%) - 7 BUNDLE BRANCH BLOCK LEFT 1 (12.5%) 0 0 1 (3.3%) - 8 GASTROINTESTINAL DISORDERS - 9 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) - 10 Total number of events 3 0 0 3 - 11 DIARRHOEA 1 (12.5%) 0 0 1 (3.3%) - 12 HIATUS HERNIA 1 (12.5%) 0 0 1 (3.3%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 Total number of participants with at least one adverse event 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) - 15 Total number of events 2 4 3 7 9 - 16 APPLICATION SITE ERYTHEMA 1 (12.5%) 1 (9.1%) 0 1 (4.5%) 2 (6.7%) - 17 APPLICATION SITE PRURITUS 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) - 18 APPLICATION SITE VESICLES 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 19 FATIGUE 0 1 (9.1%) 0 1 (4.5%) 1 (3.3%) - 20 INFECTIONS AND INFESTATIONS - 21 Total number of participants with at least one adverse event 1 (12.5%) 0 1 (9.1%) 1 (4.5%) 2 (6.7%) - 22 Total number of events 1 0 1 1 2 - 23 LOCALISED INFECTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 24 UPPER RESPIRATORY TRACT INFECTION 1 (12.5%) 0 0 1 (3.3%) - 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS - 26 Total number of participants with at least one adverse event 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 27 Total number of events 0 0 2 2 2 - 28 NASAL CONGESTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 29 PHARYNGOLARYNGEAL PAIN 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 31 Total number of participants with at least one adverse event 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) - 32 Total number of events 3 0 9 9 12 - 33 ERYTHEMA 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) - 34 PRURITUS 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 35 PRURITUS GENERALISED 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + Body System or Organ Class \nDictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) + 1 Total number of participants with at least one adverse event 3(37.5%) 2(18.2%) 2(18.2%) 4(18.2%) + 2 Overall total number of events 11 4 15 19 + 3 CARDIAC DISORDERS + 4 Total number of participants with at least one adverse event 2(25.0%) 0 0 + 5 Total number of events 2 0 0 + 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1(12.5%) 0 0 + 7 BUNDLE BRANCH BLOCK LEFT 1(12.5%) 0 0 + 8 GASTROINTESTINAL DISORDERS + 9 Total number of participants with at least one adverse event 2(25.0%) 0 0 + 10 Total number of events 3 0 0 + 11 DIARRHOEA 1(12.5%) 0 0 + 12 HIATUS HERNIA 1(12.5%) 0 0 + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 Total number of participants with at least one adverse event 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) + 15 Total number of events 2 4 3 7 + 16 APPLICATION SITE ERYTHEMA 1(12.5%) 1(9.1%) 0 1(4.5%) + 17 APPLICATION SITE PRURITUS 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) + 18 APPLICATION SITE VESICLES 0 0 1(9.1%) 1(4.5%) + 19 FATIGUE 0 1(9.1%) 0 1(4.5%) + 20 INFECTIONS AND INFESTATIONS + 21 Total number of participants with at least one adverse event 1(12.5%) 0 1(9.1%) 1(4.5%) + 22 Total number of events 1 0 1 1 + 23 LOCALISED INFECTION 0 0 1(9.1%) 1(4.5%) + 24 UPPER RESPIRATORY TRACT INFECTION 1(12.5%) 0 0 + 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS + 26 Total number of participants with at least one adverse event 0 0 1(9.1%) 1(4.5%) + 27 Total number of events 0 0 2 2 + 28 NASAL CONGESTION 0 0 1(9.1%) 1(4.5%) + 29 PHARYNGOLARYNGEAL PAIN 0 0 1(9.1%) 1(4.5%) + 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 31 Total number of participants with at least one adverse event 1(12.5%) 0 2(18.2%) 2(9.1%) + 32 Total number of events 3 0 9 9 + 33 ERYTHEMA 1(12.5%) 0 2(18.2%) 2(9.1%) + 34 PRURITUS 0 0 1(9.1%) 1(4.5%) + 35 PRURITUS GENERALISED 0 0 1(9.1%) 1(4.5%) + All Patients \n(N = 30) + 1 7(23.3%) + 2 30 + 3 + 4 2(6.7%) + 5 2 + 6 1(3.3%) + 7 1(3.3%) + 8 + 9 2(6.7%) + 10 3 + 11 1(3.3%) + 12 1(3.3%) + 13 + 14 4(13.3%) + 15 9 + 16 2(6.7%) + 17 4(13.3%) + 18 1(3.3%) + 19 1(3.3%) + 20 + 21 2(6.7%) + 22 2 + 23 1(3.3%) + 24 1(3.3%) + 25 + 26 1(3.3%) + 27 2 + 28 1(3.3%) + 29 1(3.3%) + 30 + 31 3(10.0%) + 32 12 + 33 3(10.0%) + 34 1(3.3%) + 35 1(3.3%) # tbl_with_pools() warns and skips empty pools properly diff --git a/tests/testthat/helper-snapshot_width.R b/tests/testthat/helper-snapshot_width.R new file mode 100644 index 00000000..f78e9835 --- /dev/null +++ b/tests/testthat/helper-snapshot_width.R @@ -0,0 +1,6 @@ +# Set a wide console width for snapshot tests to prevent line-wrapping +# differences across platforms. Call inside test_that() blocks before +# expect_snapshot() — withr::local_options() resets automatically on exit. +local_wide_snapshot <- function(width = 220, .local_envir = parent.frame()) { + withr::local_options(list(width = width), .local_envir = .local_envir) +} diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R index 5ef77068..05f005b1 100644 --- a/tests/testthat/test-add_grade_column.R +++ b/tests/testthat/test-add_grade_column.R @@ -69,11 +69,10 @@ test_that("add_grade_column() works without grade groups", { result <- tbl |> add_grade_column() expect_true("label_grade" %in% names(result$table_body)) - # no indentation styling for grade groups since none defined + # no grade-group-specific indentation when none defined indent_rows <- result$table_styling$indent |> dplyr::filter(column == "label_grade") - # only default indentation, no grade-group-specific indent - expect_true(nrow(indent_rows) == 0 || !any(indent_rows$indent == 4L)) + expect_equal(nrow(indent_rows), 0) }) # --- 3. Metadata extraction from merged tables -------------------------------- @@ -156,7 +155,8 @@ test_that("add_grade_column() recodes zero statistics", { result <- tbl |> add_grade_column() - # check that post_fmt_fun is set (the actual recoding happens at render time) + # recoding "0 (0.0%)" -> "0" happens at render time via post_fmt_fun; + # we verify the formatting function is registered, not the rendered output expect_true(nrow(result$table_styling$post_fmt_fun) > 0) }) diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index 8c51bdae..32ff5f23 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -3,11 +3,11 @@ skip_on_cran() # Setup small, reproducible datasets using {cards} ADSL_subset <- cards::ADSL |> dplyr::filter(TRTA %in% c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) |> - dplyr::slice(1:30) + dplyr::slice_head(n = 30) ADAE_subset <- cards::ADAE |> dplyr::filter(USUBJID %in% ADSL_subset$USUBJID) |> - dplyr::slice(1:30) + dplyr::slice_head(n = 30) # Define standard pools for testing standard_pools <- list( @@ -96,7 +96,7 @@ test_that("tbl_with_pools() works with standard functions like tbl_summary", { expect_true(any(str_detect(header_labels, "All Patients"))) # Snapshot the table output - withr::local_options(list(width = 220)) + local_wide_snapshot() expect_snapshot(as.data.frame(tbl)) }) @@ -119,7 +119,7 @@ test_that("tbl_with_pools() passes the denominator correctly for custom function expect_s3_class(tbl, "tbl_with_pools") # Snapshot the table output - withr::local_options(list(width = 220)) + local_wide_snapshot() expect_snapshot(as.data.frame(tbl)) }) From 12600ad8352974fe54b96aefc04aad36357c03e4 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Fri, 8 May 2026 11:41:48 +0000 Subject: [PATCH 38/46] test: tighten assertions and add local_wide_snapshot() helper - Fix test #2: assert no label_grade indent rows exist (was always-true) - Add comment to test #7: explain post_fmt_fun is a proxy check - Use slice_head(n = 30) for deterministic row selection - Add local_wide_snapshot() helper for consistent snapshot width --- tests/testthat/_snaps/tbl_with_pools.md | 122 ++++++++++++++++-------- tests/testthat/helper-snapshot_width.R | 6 ++ tests/testthat/test-add_grade_column.R | 8 +- tests/testthat/test-tbl_with_pools.R | 8 +- 4 files changed, 95 insertions(+), 49 deletions(-) create mode 100644 tests/testthat/helper-snapshot_width.R diff --git a/tests/testthat/_snaps/tbl_with_pools.md b/tests/testthat/_snaps/tbl_with_pools.md index 6e50b28e..eea112bf 100644 --- a/tests/testthat/_snaps/tbl_with_pools.md +++ b/tests/testthat/_snaps/tbl_with_pools.md @@ -58,53 +58,93 @@ Code as.data.frame(tbl) Output - Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 - 1 Age 74 (64, 83) 61 (56, 77) 74 (68, 80) 71 (61, 79) 71 (61, 79) - 2 Sex - 3 F 4 (50.0%) 5 (45.5%) 3 (27.3%) 8 (36.4%) 12 (40.0%) - 4 M 4 (50.0%) 6 (54.5%) 8 (72.7%) 14 (63.6%) 18 (60.0%) + Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 + 1 Age 74(64,83) 61(56,77) 74(68,80) 71(61,79) 71(61,79) + 2 Sex + 3 F 4(50.0%) 5(45.5%) 3(27.3%) 8(36.4%) 12(40.0%) + 4 M 4(50.0%) 6(54.5%) 8(72.7%) 14(63.6%) 18(60.0%) # tbl_with_pools() passes the denominator correctly for custom functions Code as.data.frame(tbl) + Condition + Warning in `do.call()`: + unable to translate 'Body System or Organ Class + Dictionary-Derived Term' to native encoding Output - Body System or Organ Class \n    Dictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) All Patients \n(N = 30) - 1 Total number of participants with at least one adverse event 3 (37.5%) 2 (18.2%) 2 (18.2%) 4 (18.2%) 7 (23.3%) - 2 Overall total number of events 11 4 15 19 30 - 3 CARDIAC DISORDERS - 4 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) - 5 Total number of events 2 0 0 2 - 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1 (12.5%) 0 0 1 (3.3%) - 7 BUNDLE BRANCH BLOCK LEFT 1 (12.5%) 0 0 1 (3.3%) - 8 GASTROINTESTINAL DISORDERS - 9 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) - 10 Total number of events 3 0 0 3 - 11 DIARRHOEA 1 (12.5%) 0 0 1 (3.3%) - 12 HIATUS HERNIA 1 (12.5%) 0 0 1 (3.3%) - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 Total number of participants with at least one adverse event 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) - 15 Total number of events 2 4 3 7 9 - 16 APPLICATION SITE ERYTHEMA 1 (12.5%) 1 (9.1%) 0 1 (4.5%) 2 (6.7%) - 17 APPLICATION SITE PRURITUS 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) - 18 APPLICATION SITE VESICLES 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 19 FATIGUE 0 1 (9.1%) 0 1 (4.5%) 1 (3.3%) - 20 INFECTIONS AND INFESTATIONS - 21 Total number of participants with at least one adverse event 1 (12.5%) 0 1 (9.1%) 1 (4.5%) 2 (6.7%) - 22 Total number of events 1 0 1 1 2 - 23 LOCALISED INFECTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 24 UPPER RESPIRATORY TRACT INFECTION 1 (12.5%) 0 0 1 (3.3%) - 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS - 26 Total number of participants with at least one adverse event 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 27 Total number of events 0 0 2 2 2 - 28 NASAL CONGESTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 29 PHARYNGOLARYNGEAL PAIN 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 31 Total number of participants with at least one adverse event 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) - 32 Total number of events 3 0 9 9 12 - 33 ERYTHEMA 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) - 34 PRURITUS 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) - 35 PRURITUS GENERALISED 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + Body System or Organ Class \nDictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) + 1 Total number of participants with at least one adverse event 3(37.5%) 2(18.2%) 2(18.2%) 4(18.2%) + 2 Overall total number of events 11 4 15 19 + 3 CARDIAC DISORDERS + 4 Total number of participants with at least one adverse event 2(25.0%) 0 0 + 5 Total number of events 2 0 0 + 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1(12.5%) 0 0 + 7 BUNDLE BRANCH BLOCK LEFT 1(12.5%) 0 0 + 8 GASTROINTESTINAL DISORDERS + 9 Total number of participants with at least one adverse event 2(25.0%) 0 0 + 10 Total number of events 3 0 0 + 11 DIARRHOEA 1(12.5%) 0 0 + 12 HIATUS HERNIA 1(12.5%) 0 0 + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 Total number of participants with at least one adverse event 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) + 15 Total number of events 2 4 3 7 + 16 APPLICATION SITE ERYTHEMA 1(12.5%) 1(9.1%) 0 1(4.5%) + 17 APPLICATION SITE PRURITUS 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) + 18 APPLICATION SITE VESICLES 0 0 1(9.1%) 1(4.5%) + 19 FATIGUE 0 1(9.1%) 0 1(4.5%) + 20 INFECTIONS AND INFESTATIONS + 21 Total number of participants with at least one adverse event 1(12.5%) 0 1(9.1%) 1(4.5%) + 22 Total number of events 1 0 1 1 + 23 LOCALISED INFECTION 0 0 1(9.1%) 1(4.5%) + 24 UPPER RESPIRATORY TRACT INFECTION 1(12.5%) 0 0 + 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS + 26 Total number of participants with at least one adverse event 0 0 1(9.1%) 1(4.5%) + 27 Total number of events 0 0 2 2 + 28 NASAL CONGESTION 0 0 1(9.1%) 1(4.5%) + 29 PHARYNGOLARYNGEAL PAIN 0 0 1(9.1%) 1(4.5%) + 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 31 Total number of participants with at least one adverse event 1(12.5%) 0 2(18.2%) 2(9.1%) + 32 Total number of events 3 0 9 9 + 33 ERYTHEMA 1(12.5%) 0 2(18.2%) 2(9.1%) + 34 PRURITUS 0 0 1(9.1%) 1(4.5%) + 35 PRURITUS GENERALISED 0 0 1(9.1%) 1(4.5%) + All Patients \n(N = 30) + 1 7(23.3%) + 2 30 + 3 + 4 2(6.7%) + 5 2 + 6 1(3.3%) + 7 1(3.3%) + 8 + 9 2(6.7%) + 10 3 + 11 1(3.3%) + 12 1(3.3%) + 13 + 14 4(13.3%) + 15 9 + 16 2(6.7%) + 17 4(13.3%) + 18 1(3.3%) + 19 1(3.3%) + 20 + 21 2(6.7%) + 22 2 + 23 1(3.3%) + 24 1(3.3%) + 25 + 26 1(3.3%) + 27 2 + 28 1(3.3%) + 29 1(3.3%) + 30 + 31 3(10.0%) + 32 12 + 33 3(10.0%) + 34 1(3.3%) + 35 1(3.3%) # tbl_with_pools() warns and skips empty pools properly diff --git a/tests/testthat/helper-snapshot_width.R b/tests/testthat/helper-snapshot_width.R new file mode 100644 index 00000000..f78e9835 --- /dev/null +++ b/tests/testthat/helper-snapshot_width.R @@ -0,0 +1,6 @@ +# Set a wide console width for snapshot tests to prevent line-wrapping +# differences across platforms. Call inside test_that() blocks before +# expect_snapshot() — withr::local_options() resets automatically on exit. +local_wide_snapshot <- function(width = 220, .local_envir = parent.frame()) { + withr::local_options(list(width = width), .local_envir = .local_envir) +} diff --git a/tests/testthat/test-add_grade_column.R b/tests/testthat/test-add_grade_column.R index 5ef77068..05f005b1 100644 --- a/tests/testthat/test-add_grade_column.R +++ b/tests/testthat/test-add_grade_column.R @@ -69,11 +69,10 @@ test_that("add_grade_column() works without grade groups", { result <- tbl |> add_grade_column() expect_true("label_grade" %in% names(result$table_body)) - # no indentation styling for grade groups since none defined + # no grade-group-specific indentation when none defined indent_rows <- result$table_styling$indent |> dplyr::filter(column == "label_grade") - # only default indentation, no grade-group-specific indent - expect_true(nrow(indent_rows) == 0 || !any(indent_rows$indent == 4L)) + expect_equal(nrow(indent_rows), 0) }) # --- 3. Metadata extraction from merged tables -------------------------------- @@ -156,7 +155,8 @@ test_that("add_grade_column() recodes zero statistics", { result <- tbl |> add_grade_column() - # check that post_fmt_fun is set (the actual recoding happens at render time) + # recoding "0 (0.0%)" -> "0" happens at render time via post_fmt_fun; + # we verify the formatting function is registered, not the rendered output expect_true(nrow(result$table_styling$post_fmt_fun) > 0) }) diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index 8c51bdae..32ff5f23 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -3,11 +3,11 @@ skip_on_cran() # Setup small, reproducible datasets using {cards} ADSL_subset <- cards::ADSL |> dplyr::filter(TRTA %in% c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) |> - dplyr::slice(1:30) + dplyr::slice_head(n = 30) ADAE_subset <- cards::ADAE |> dplyr::filter(USUBJID %in% ADSL_subset$USUBJID) |> - dplyr::slice(1:30) + dplyr::slice_head(n = 30) # Define standard pools for testing standard_pools <- list( @@ -96,7 +96,7 @@ test_that("tbl_with_pools() works with standard functions like tbl_summary", { expect_true(any(str_detect(header_labels, "All Patients"))) # Snapshot the table output - withr::local_options(list(width = 220)) + local_wide_snapshot() expect_snapshot(as.data.frame(tbl)) }) @@ -119,7 +119,7 @@ test_that("tbl_with_pools() passes the denominator correctly for custom function expect_s3_class(tbl, "tbl_with_pools") # Snapshot the table output - withr::local_options(list(width = 220)) + local_wide_snapshot() expect_snapshot(as.data.frame(tbl)) }) From 359feaac36f0584ff4ca0c068e75a7ebc8acde3a Mon Sep 17 00:00:00 2001 From: melkiades Date: Sun, 10 May 2026 13:12:44 +0200 Subject: [PATCH 39/46] fix tests --- R/tbl_hierarchical_rate_by_grade.R | 4 +++- tests/testthat/test-tbl_hierarchical_rate_by_grade.R | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 1bd56690..611ea8a1 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -504,7 +504,9 @@ add_grade_column <- function(x) { } # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) + if ("label_grade" %in% names(x$table_body)) { + return(x) + } # extract metadata: standalone vs merged table info <- x$custom_info %||% diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 4c190ac8..a2df0cc1 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -308,7 +308,7 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t label = label, grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) ), - '\\`AETOXGR\\`: ' + "\\`AETOXGR\\`: " ) }) From 649ca7568bb2bb2437420f2a9a409749923282ad Mon Sep 17 00:00:00 2001 From: melkiades Date: Sun, 10 May 2026 13:12:44 +0200 Subject: [PATCH 40/46] fix tests --- R/tbl_hierarchical_rate_by_grade.R | 4 +++- tests/testthat/test-tbl_hierarchical_rate_by_grade.R | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 1bd56690..611ea8a1 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -504,7 +504,9 @@ add_grade_column <- function(x) { } # idempotency guard: skip if already applied - if ("label_grade" %in% names(x$table_body)) return(x) + if ("label_grade" %in% names(x$table_body)) { + return(x) + } # extract metadata: standalone vs merged table info <- x$custom_info %||% diff --git a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R index 4c190ac8..a2df0cc1 100644 --- a/tests/testthat/test-tbl_hierarchical_rate_by_grade.R +++ b/tests/testthat/test-tbl_hierarchical_rate_by_grade.R @@ -308,7 +308,7 @@ test_that("tbl_hierarchical_rate_by_grade() appends missing grade group levels t label = label, grade_groups = list("Grade 3-4" = c("3", "4"), "Grade 1-2" = c("1", "2")) ), - '\\`AETOXGR\\`: ' + "\\`AETOXGR\\`: " ) }) From f42c7e24434374b572d5c29bc3b8d0bbe5f421f8 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 20 May 2026 15:10:03 +0000 Subject: [PATCH 41/46] update tbl_hierarchical_rate_by_grade snapshots after main merge --- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++++-------- 1 file changed, 126 insertions(+), 106 deletions(-) diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 75ce1bf1..73dac3d1 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,137 +2,157 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 8 1 1 (1.2%) 1 (1.2%) 0 - 9 2 0 2 (2.4%) 0 - 10 4 1 (1.2%) 0 0 - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 12 1 1 (1.2%) 1 (1.2%) 0 - 13 2 0 2 (2.4%) 0 - 14 4 1 (1.2%) 0 0 - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 2 (2.4%) 0 - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 2 (2.4%) 0 - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 4 (4.8%) 4 (4.8%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 1 20(23.3%) 23(27.4%) 20(23.8%) + 3 2 2(2.3%) 9(10.7%) 10(11.9%) + 4 3 3(3.5%) 10(11.9%) 8(9.5%) + 5 4 1(1.2%) 0 2(2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 8 1 1(1.2%) 1(1.2%) 0 + 9 2 0 2(2.4%) 0 + 10 4 1(1.2%) 0 0 + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 12 1 1(1.2%) 1(1.2%) 0 + 13 2 0 2(2.4%) 0 + 14 4 1(1.2%) 0 0 + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 17 1 9(10.5%) 2(2.4%) 5(6.0%) + 18 2 0 2(2.4%) 0 + 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 20 1 9(10.5%) 2(2.4%) 5(6.0%) + 21 2 0 2(2.4%) 0 + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) + 24 1 7(8.1%) 12(14.3%) 12(14.3%) + 25 2 0 4(4.8%) 4(4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 11 1 1 (1.2%) 1 (1.2%) 0 - 12 2 0 2 (2.4%) 0 - 13 Grade 3-4 1 (1.2%) 0 0 - 14 4 1 (1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 17 1 1 (1.2%) 1 (1.2%) 0 - 18 2 0 2 (2.4%) 0 - 19 Grade 3-4 1 (1.2%) 0 0 - 20 4 1 (1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 2 (2.4%) 0 + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 10 Grade 1-2 1(1.2%) 3(3.6%) 0 + 11 1 1(1.2%) 1(1.2%) 0 + 12 2 0 2(2.4%) 0 + 13 Grade 3-4 1(1.2%) 0 0 + 14 4 1(1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 16 Grade 1-2 1(1.2%) 3(3.6%) 0 + 17 1 1(1.2%) 1(1.2%) 0 + 18 2 0 2(2.4%) 0 + 19 Grade 3-4 1(1.2%) 0 0 + 20 4 1(1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0 2(2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 11 1 1 (1.2%) 1 (1.2%) 0 - 12 2 0 2 (2.4%) 0 - 13 Grade 3-4 1 (1.2%) 0 0 - 14 4 1 (1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 17 1 1 (1.2%) 1 (1.2%) 0 - 18 2 0 2 (2.4%) 0 - 19 Grade 3-4 1 (1.2%) 0 0 - 20 4 1 (1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 2 (2.4%) 0 + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 10 Grade 1-2 1(1.2%) 3(3.6%) 0 + 11 1 1(1.2%) 1(1.2%) 0 + 12 2 0 2(2.4%) 0 + 13 Grade 3-4 1(1.2%) 0 0 + 14 4 1(1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 16 Grade 1-2 1(1.2%) 3(3.6%) 0 + 17 1 1(1.2%) 1(1.2%) 0 + 18 2 0 2(2.4%) 0 + 19 Grade 3-4 1(1.2%) 0 0 + 20 4 1(1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0 2(2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 4 1 1 (1.2%) 1 (1.2%) 0 - 5 2 0 2 (2.4%) 0 - 6 Grade 3-4 1 (1.2%) 0 0 - 7 4 1 (1.2%) 0 0 - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 2 (2.4%) 0 - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 3 (3.6%) 5 (6.0%) - 19 3 0 3 (3.6%) 3 (3.6%) - 20 4 0 0 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 3 Grade 1-2 1(1.2%) 3(3.6%) 0 + 4 1 1(1.2%) 1(1.2%) 0 + 5 2 0 2(2.4%) 0 + 6 Grade 3-4 1(1.2%) 0 0 + 7 4 1(1.2%) 0 0 + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 11 1 9(10.5%) 2(2.4%) 5(6.0%) + 12 2 0 2(2.4%) 0 + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) + 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) + 16 1 3(3.5%) 9(10.7%) 4(4.8%) + 17 2 0 3(3.6%) 3(3.6%) + 18 Grade 3-4 0 3(3.6%) 5(6.0%) + 19 3 0 3(3.6%) 3(3.6%) + 20 4 0 0 2(2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) + 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) + 23 1 5(5.8%) 10(11.9%) 13(15.5%) + 24 2 0 5(6.0%) 4(4.8%) + 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From 92af30faac2ee379566a01aa6a1bc3e5d27d6aab Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 20 May 2026 15:10:03 +0000 Subject: [PATCH 42/46] update tbl_hierarchical_rate_by_grade snapshots after main merge --- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++++-------- 1 file changed, 126 insertions(+), 106 deletions(-) diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 75ce1bf1..73dac3d1 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,137 +2,157 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 5 4 1 (1.2%) 0 2 (2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 8 1 1 (1.2%) 1 (1.2%) 0 - 9 2 0 2 (2.4%) 0 - 10 4 1 (1.2%) 0 0 - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 12 1 1 (1.2%) 1 (1.2%) 0 - 13 2 0 2 (2.4%) 0 - 14 4 1 (1.2%) 0 0 - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 18 2 0 2 (2.4%) 0 - 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 21 2 0 2 (2.4%) 0 - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) - 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) - 25 2 0 4 (4.8%) 4 (4.8%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 1 20(23.3%) 23(27.4%) 20(23.8%) + 3 2 2(2.3%) 9(10.7%) 10(11.9%) + 4 3 3(3.5%) 10(11.9%) 8(9.5%) + 5 4 1(1.2%) 0 2(2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 8 1 1(1.2%) 1(1.2%) 0 + 9 2 0 2(2.4%) 0 + 10 4 1(1.2%) 0 0 + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 12 1 1(1.2%) 1(1.2%) 0 + 13 2 0 2(2.4%) 0 + 14 4 1(1.2%) 0 0 + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 17 1 9(10.5%) 2(2.4%) 5(6.0%) + 18 2 0 2(2.4%) 0 + 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 20 1 9(10.5%) 2(2.4%) 5(6.0%) + 21 2 0 2(2.4%) 0 + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) + 24 1 7(8.1%) 12(14.3%) 12(14.3%) + 25 2 0 4(4.8%) 4(4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 11 1 1 (1.2%) 1 (1.2%) 0 - 12 2 0 2 (2.4%) 0 - 13 Grade 3-4 1 (1.2%) 0 0 - 14 4 1 (1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 17 1 1 (1.2%) 1 (1.2%) 0 - 18 2 0 2 (2.4%) 0 - 19 Grade 3-4 1 (1.2%) 0 0 - 20 4 1 (1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 2 (2.4%) 0 + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 10 Grade 1-2 1(1.2%) 3(3.6%) 0 + 11 1 1(1.2%) 1(1.2%) 0 + 12 2 0 2(2.4%) 0 + 13 Grade 3-4 1(1.2%) 0 0 + 14 4 1(1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 16 Grade 1-2 1(1.2%) 3(3.6%) 0 + 17 1 1(1.2%) 1(1.2%) 0 + 18 2 0 2(2.4%) 0 + 19 Grade 3-4 1(1.2%) 0 0 + 20 4 1(1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0 2(2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) - 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) - 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) - 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) - 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) - 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) - 7 4 1 (1.2%) 0 2 (2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 11 1 1 (1.2%) 1 (1.2%) 0 - 12 2 0 2 (2.4%) 0 - 13 Grade 3-4 1 (1.2%) 0 0 - 14 4 1 (1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 17 1 1 (1.2%) 1 (1.2%) 0 - 18 2 0 2 (2.4%) 0 - 19 Grade 3-4 1 (1.2%) 0 0 - 20 4 1 (1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 25 2 0 2 (2.4%) 0 + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) + 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) + 3 1 20(23.3%) 23(27.4%) 20(23.8%) + 4 2 2(2.3%) 9(10.7%) 10(11.9%) + 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) + 6 3 3(3.5%) 10(11.9%) 8(9.5%) + 7 4 1(1.2%) 0 2(2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 + 10 Grade 1-2 1(1.2%) 3(3.6%) 0 + 11 1 1(1.2%) 1(1.2%) 0 + 12 2 0 2(2.4%) 0 + 13 Grade 3-4 1(1.2%) 0 0 + 14 4 1(1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 16 Grade 1-2 1(1.2%) 3(3.6%) 0 + 17 1 1(1.2%) 1(1.2%) 0 + 18 2 0 2(2.4%) 0 + 19 Grade 3-4 1(1.2%) 0 0 + 20 4 1(1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 24 1 9(10.5%) 2(2.4%) 5(6.0%) + 25 2 0 2(2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1:25, ] + Condition + Warning in `do.call()`: + unable to translate 'MedDRA System Organ Class + MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 - 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 - 4 1 1 (1.2%) 1 (1.2%) 0 - 5 2 0 2 (2.4%) 0 - 6 Grade 3-4 1 (1.2%) 0 0 - 7 4 1 (1.2%) 0 0 - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) - 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) - 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) - 12 2 0 2 (2.4%) 0 - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) - 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) - 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) - 17 2 0 3 (3.6%) 3 (3.6%) - 18 Grade 3-4 0 3 (3.6%) 5 (6.0%) - 19 3 0 3 (3.6%) 3 (3.6%) - 20 4 0 0 2 (2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) - 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) - 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) - 24 2 0 5 (6.0%) 4 (4.8%) - 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) + MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 + 3 Grade 1-2 1(1.2%) 3(3.6%) 0 + 4 1 1(1.2%) 1(1.2%) 0 + 5 2 0 2(2.4%) 0 + 6 Grade 3-4 1(1.2%) 0 0 + 7 4 1(1.2%) 0 0 + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) + 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) + 11 1 9(10.5%) 2(2.4%) 5(6.0%) + 12 2 0 2(2.4%) 0 + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) + 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) + 16 1 3(3.5%) 9(10.7%) 4(4.8%) + 17 2 0 3(3.6%) 3(3.6%) + 18 Grade 3-4 0 3(3.6%) 5(6.0%) + 19 3 0 3(3.6%) 3(3.6%) + 20 4 0 0 2(2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) + 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) + 23 1 5(5.8%) 10(11.9%) 13(15.5%) + 24 2 0 5(6.0%) 4(4.8%) + 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) # tbl_hierarchical_rate_by_grade() error messaging works From da0f144b2bd9a565ab4f3057ceb47dd1006b34e8 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 20 May 2026 15:10:33 +0000 Subject: [PATCH 43/46] add NEWS entry for add_grade_column() (#226) --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 199ca93c..aff4e891 100644 --- a/NEWS.md +++ b/NEWS.md @@ -28,7 +28,9 @@ * Added `tbl_hierarchical_incidence_rate()` which computes the incidence rate of adverse events (#211) * Added `adjust_stat_columns_wrap()` which keep the presentation of statistics in one row (#219) - + +* Added `add_grade_column()` to inject a grade-label column into `tbl_hierarchical_rate_by_grade()` output. Decoupled from the table builder to prevent Cartesian join explosion in `tbl_merge()`. (#226) + ### Other Updates * `tbl_hierarchical_rate_and_count()` now emits zero-rows for unobserved factor levels in the first hierarchical variable. (#233) From 8c7f6de6d3c0c00e33fda2abb8e6b124d6190fb7 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Wed, 20 May 2026 15:10:33 +0000 Subject: [PATCH 44/46] add NEWS entry for add_grade_column() (#226) --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 199ca93c..aff4e891 100644 --- a/NEWS.md +++ b/NEWS.md @@ -28,7 +28,9 @@ * Added `tbl_hierarchical_incidence_rate()` which computes the incidence rate of adverse events (#211) * Added `adjust_stat_columns_wrap()` which keep the presentation of statistics in one row (#219) - + +* Added `add_grade_column()` to inject a grade-label column into `tbl_hierarchical_rate_by_grade()` output. Decoupled from the table builder to prevent Cartesian join explosion in `tbl_merge()`. (#226) + ### Other Updates * `tbl_hierarchical_rate_and_count()` now emits zero-rows for unobserved factor levels in the first hierarchical variable. (#233) From a6da1a5dc1af2d40475667fdfcfebedc0dbed9d8 Mon Sep 17 00:00:00 2001 From: melkiades Date: Wed, 20 May 2026 17:26:18 +0200 Subject: [PATCH 45/46] snaps --- .../_snaps/tbl_hierarchical_rate_by_grade.md | 232 ++++++++---------- tests/testthat/_snaps/tbl_with_pools.md | 122 ++++----- 2 files changed, 147 insertions(+), 207 deletions(-) diff --git a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md index 73dac3d1..75ce1bf1 100644 --- a/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md +++ b/tests/testthat/_snaps/tbl_hierarchical_rate_by_grade.md @@ -2,157 +2,137 @@ Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 1 20(23.3%) 23(27.4%) 20(23.8%) - 3 2 2(2.3%) 9(10.7%) 10(11.9%) - 4 3 3(3.5%) 10(11.9%) 8(9.5%) - 5 4 1(1.2%) 0 2(2.4%) - 6 CARDIAC DISORDERS - 7 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 - 8 1 1(1.2%) 1(1.2%) 0 - 9 2 0 2(2.4%) 0 - 10 4 1(1.2%) 0 0 - 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 - 12 1 1(1.2%) 1(1.2%) 0 - 13 2 0 2(2.4%) 0 - 14 4 1(1.2%) 0 0 - 15 GASTROINTESTINAL DISORDERS - 16 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 17 1 9(10.5%) 2(2.4%) 5(6.0%) - 18 2 0 2(2.4%) 0 - 19 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 20 1 9(10.5%) 2(2.4%) 5(6.0%) - 21 2 0 2(2.4%) 0 - 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 23 - Overall - - Any Grade - 8(9.3%) 25(29.8%) 24(28.6%) - 24 1 7(8.1%) 12(14.3%) 12(14.3%) - 25 2 0 4(4.8%) 4(4.8%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 3 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 4 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 5 4 1 (1.2%) 0 2 (2.4%) + 6 CARDIAC DISORDERS + 7 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 8 1 1 (1.2%) 1 (1.2%) 0 + 9 2 0 2 (2.4%) 0 + 10 4 1 (1.2%) 0 0 + 11 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 12 1 1 (1.2%) 1 (1.2%) 0 + 13 2 0 2 (2.4%) 0 + 14 4 1 (1.2%) 0 0 + 15 GASTROINTESTINAL DISORDERS + 16 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 17 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 18 2 0 2 (2.4%) 0 + 19 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 20 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 21 2 0 2 (2.4%) 0 + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 23 - Overall - - Any Grade - 8 (9.3%) 25 (29.8%) 24 (28.6%) + 24 1 7 (8.1%) 12 (14.3%) 12 (14.3%) + 25 2 0 4 (4.8%) 4 (4.8%) --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 - 10 Grade 1-2 1(1.2%) 3(3.6%) 0 - 11 1 1(1.2%) 1(1.2%) 0 - 12 2 0 2(2.4%) 0 - 13 Grade 3-4 1(1.2%) 0 0 - 14 4 1(1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 - 16 Grade 1-2 1(1.2%) 3(3.6%) 0 - 17 1 1(1.2%) 1(1.2%) 0 - 18 2 0 2(2.4%) 0 - 19 Grade 3-4 1(1.2%) 0 0 - 20 4 1(1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0 2(2.4%) 0 + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 + 11 1 1 (1.2%) 1 (1.2%) 0 + 12 2 0 2 (2.4%) 0 + 13 Grade 3-4 1 (1.2%) 0 0 + 14 4 1 (1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 + 17 1 1 (1.2%) 1 (1.2%) 0 + 18 2 0 2 (2.4%) 0 + 19 Grade 3-4 1 (1.2%) 0 0 + 20 4 1 (1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 2 (2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26,0/86,30.233% 42,0/84,50.000% 40,0/84,47.619% + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26,0/86, 30.233% 42,0/84, 50.000% 40,0/84, 47.619% # tbl_hierarchical_rate_by_grade(include_overall) works Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 - Any adverse events - - Any Grade - 26(30.2%) 42(50.0%) 40(47.6%) - 2 Grade 1-2 22(25.6%) 32(38.1%) 30(35.7%) - 3 1 20(23.3%) 23(27.4%) 20(23.8%) - 4 2 2(2.3%) 9(10.7%) 10(11.9%) - 5 Grade 3-4 4(4.7%) 10(11.9%) 10(11.9%) - 6 3 3(3.5%) 10(11.9%) 8(9.5%) - 7 4 1(1.2%) 0 2(2.4%) - 8 CARDIAC DISORDERS - 9 - Overall - - Any Grade - 2(2.3%) 3(3.6%) 0 - 10 Grade 1-2 1(1.2%) 3(3.6%) 0 - 11 1 1(1.2%) 1(1.2%) 0 - 12 2 0 2(2.4%) 0 - 13 Grade 3-4 1(1.2%) 0 0 - 14 4 1(1.2%) 0 0 - 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 - 16 Grade 1-2 1(1.2%) 3(3.6%) 0 - 17 1 1(1.2%) 1(1.2%) 0 - 18 2 0 2(2.4%) 0 - 19 Grade 3-4 1(1.2%) 0 0 - 20 4 1(1.2%) 0 0 - 21 GASTROINTESTINAL DISORDERS - 22 - Overall - - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 23 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 24 1 9(10.5%) 2(2.4%) 5(6.0%) - 25 2 0 2(2.4%) 0 + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 - Any adverse events - - Any Grade - 26 (30.2%) 42 (50.0%) 40 (47.6%) + 2 Grade 1-2 22 (25.6%) 32 (38.1%) 30 (35.7%) + 3 1 20 (23.3%) 23 (27.4%) 20 (23.8%) + 4 2 2 (2.3%) 9 (10.7%) 10 (11.9%) + 5 Grade 3-4 4 (4.7%) 10 (11.9%) 10 (11.9%) + 6 3 3 (3.5%) 10 (11.9%) 8 (9.5%) + 7 4 1 (1.2%) 0 2 (2.4%) + 8 CARDIAC DISORDERS + 9 - Overall - - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 10 Grade 1-2 1 (1.2%) 3 (3.6%) 0 + 11 1 1 (1.2%) 1 (1.2%) 0 + 12 2 0 2 (2.4%) 0 + 13 Grade 3-4 1 (1.2%) 0 0 + 14 4 1 (1.2%) 0 0 + 15 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 16 Grade 1-2 1 (1.2%) 3 (3.6%) 0 + 17 1 1 (1.2%) 1 (1.2%) 0 + 18 2 0 2 (2.4%) 0 + 19 Grade 3-4 1 (1.2%) 0 0 + 20 4 1 (1.2%) 0 0 + 21 GASTROINTESTINAL DISORDERS + 22 - Overall - - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 23 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 24 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 25 2 0 2 (2.4%) 0 --- Code as.data.frame(add_grade_column(tbl))[1:25, ] - Condition - Warning in `do.call()`: - unable to translate 'MedDRA System Organ Class - MedDRA Preferred Term' to native encoding Output - MedDRA System Organ Class \nMedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) - 1 CARDIAC DISORDERS - 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2(2.3%) 3(3.6%) 0 - 3 Grade 1-2 1(1.2%) 3(3.6%) 0 - 4 1 1(1.2%) 1(1.2%) 0 - 5 2 0 2(2.4%) 0 - 6 Grade 3-4 1(1.2%) 0 0 - 7 4 1(1.2%) 0 0 - 8 GASTROINTESTINAL DISORDERS - 9 DIARRHOEA - Any Grade - 9(10.5%) 4(4.8%) 5(6.0%) - 10 Grade 1-2 9(10.5%) 4(4.8%) 5(6.0%) - 11 1 9(10.5%) 2(2.4%) 5(6.0%) - 12 2 0 2(2.4%) 0 - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 APPLICATION SITE ERYTHEMA - Any Grade - 3(3.5%) 15(17.9%) 12(14.3%) - 15 Grade 1-2 3(3.5%) 12(14.3%) 7(8.3%) - 16 1 3(3.5%) 9(10.7%) 4(4.8%) - 17 2 0 3(3.6%) 3(3.6%) - 18 Grade 3-4 0 3(3.6%) 5(6.0%) - 19 3 0 3(3.6%) 3(3.6%) - 20 4 0 0 2(2.4%) - 21 APPLICATION SITE PRURITUS - Any Grade - 6(7.0%) 22(26.2%) 22(26.2%) - 22 Grade 1-2 5(5.8%) 15(17.9%) 17(20.2%) - 23 1 5(5.8%) 10(11.9%) 13(15.5%) - 24 2 0 5(6.0%) 4(4.8%) - 25 Grade 3-4 1(1.2%) 7(8.3%) 5(6.0%) + MedDRA System Organ Class \n    MedDRA Preferred Term Grade Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) + 1 CARDIAC DISORDERS + 2 ATRIOVENTRICULAR BLOCK SECOND DEGREE - Any Grade - 2 (2.3%) 3 (3.6%) 0 + 3 Grade 1-2 1 (1.2%) 3 (3.6%) 0 + 4 1 1 (1.2%) 1 (1.2%) 0 + 5 2 0 2 (2.4%) 0 + 6 Grade 3-4 1 (1.2%) 0 0 + 7 4 1 (1.2%) 0 0 + 8 GASTROINTESTINAL DISORDERS + 9 DIARRHOEA - Any Grade - 9 (10.5%) 4 (4.8%) 5 (6.0%) + 10 Grade 1-2 9 (10.5%) 4 (4.8%) 5 (6.0%) + 11 1 9 (10.5%) 2 (2.4%) 5 (6.0%) + 12 2 0 2 (2.4%) 0 + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 APPLICATION SITE ERYTHEMA - Any Grade - 3 (3.5%) 15 (17.9%) 12 (14.3%) + 15 Grade 1-2 3 (3.5%) 12 (14.3%) 7 (8.3%) + 16 1 3 (3.5%) 9 (10.7%) 4 (4.8%) + 17 2 0 3 (3.6%) 3 (3.6%) + 18 Grade 3-4 0 3 (3.6%) 5 (6.0%) + 19 3 0 3 (3.6%) 3 (3.6%) + 20 4 0 0 2 (2.4%) + 21 APPLICATION SITE PRURITUS - Any Grade - 6 (7.0%) 22 (26.2%) 22 (26.2%) + 22 Grade 1-2 5 (5.8%) 15 (17.9%) 17 (20.2%) + 23 1 5 (5.8%) 10 (11.9%) 13 (15.5%) + 24 2 0 5 (6.0%) 4 (4.8%) + 25 Grade 3-4 1 (1.2%) 7 (8.3%) 5 (6.0%) # tbl_hierarchical_rate_by_grade() error messaging works diff --git a/tests/testthat/_snaps/tbl_with_pools.md b/tests/testthat/_snaps/tbl_with_pools.md index eea112bf..6e50b28e 100644 --- a/tests/testthat/_snaps/tbl_with_pools.md +++ b/tests/testthat/_snaps/tbl_with_pools.md @@ -58,93 +58,53 @@ Code as.data.frame(tbl) Output - Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 - 1 Age 74(64,83) 61(56,77) 74(68,80) 71(61,79) 71(61,79) - 2 Sex - 3 F 4(50.0%) 5(45.5%) 3(27.3%) 8(36.4%) 12(40.0%) - 4 M 4(50.0%) 6(54.5%) 8(72.7%) 14(63.6%) 18(60.0%) + Characteristic Placebo \nN = 8 Xanomeline High Dose \nN = 11 Xanomeline Low Dose \nN = 11 Any Xanomeline \nN = 22 All Patients \nN = 30 + 1 Age 74 (64, 83) 61 (56, 77) 74 (68, 80) 71 (61, 79) 71 (61, 79) + 2 Sex + 3 F 4 (50.0%) 5 (45.5%) 3 (27.3%) 8 (36.4%) 12 (40.0%) + 4 M 4 (50.0%) 6 (54.5%) 8 (72.7%) 14 (63.6%) 18 (60.0%) # tbl_with_pools() passes the denominator correctly for custom functions Code as.data.frame(tbl) - Condition - Warning in `do.call()`: - unable to translate 'Body System or Organ Class - Dictionary-Derived Term' to native encoding Output - Body System or Organ Class \nDictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) - 1 Total number of participants with at least one adverse event 3(37.5%) 2(18.2%) 2(18.2%) 4(18.2%) - 2 Overall total number of events 11 4 15 19 - 3 CARDIAC DISORDERS - 4 Total number of participants with at least one adverse event 2(25.0%) 0 0 - 5 Total number of events 2 0 0 - 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1(12.5%) 0 0 - 7 BUNDLE BRANCH BLOCK LEFT 1(12.5%) 0 0 - 8 GASTROINTESTINAL DISORDERS - 9 Total number of participants with at least one adverse event 2(25.0%) 0 0 - 10 Total number of events 3 0 0 - 11 DIARRHOEA 1(12.5%) 0 0 - 12 HIATUS HERNIA 1(12.5%) 0 0 - 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 14 Total number of participants with at least one adverse event 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) - 15 Total number of events 2 4 3 7 - 16 APPLICATION SITE ERYTHEMA 1(12.5%) 1(9.1%) 0 1(4.5%) - 17 APPLICATION SITE PRURITUS 1(12.5%) 2(18.2%) 1(9.1%) 3(13.6%) - 18 APPLICATION SITE VESICLES 0 0 1(9.1%) 1(4.5%) - 19 FATIGUE 0 1(9.1%) 0 1(4.5%) - 20 INFECTIONS AND INFESTATIONS - 21 Total number of participants with at least one adverse event 1(12.5%) 0 1(9.1%) 1(4.5%) - 22 Total number of events 1 0 1 1 - 23 LOCALISED INFECTION 0 0 1(9.1%) 1(4.5%) - 24 UPPER RESPIRATORY TRACT INFECTION 1(12.5%) 0 0 - 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS - 26 Total number of participants with at least one adverse event 0 0 1(9.1%) 1(4.5%) - 27 Total number of events 0 0 2 2 - 28 NASAL CONGESTION 0 0 1(9.1%) 1(4.5%) - 29 PHARYNGOLARYNGEAL PAIN 0 0 1(9.1%) 1(4.5%) - 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 31 Total number of participants with at least one adverse event 1(12.5%) 0 2(18.2%) 2(9.1%) - 32 Total number of events 3 0 9 9 - 33 ERYTHEMA 1(12.5%) 0 2(18.2%) 2(9.1%) - 34 PRURITUS 0 0 1(9.1%) 1(4.5%) - 35 PRURITUS GENERALISED 0 0 1(9.1%) 1(4.5%) - All Patients \n(N = 30) - 1 7(23.3%) - 2 30 - 3 - 4 2(6.7%) - 5 2 - 6 1(3.3%) - 7 1(3.3%) - 8 - 9 2(6.7%) - 10 3 - 11 1(3.3%) - 12 1(3.3%) - 13 - 14 4(13.3%) - 15 9 - 16 2(6.7%) - 17 4(13.3%) - 18 1(3.3%) - 19 1(3.3%) - 20 - 21 2(6.7%) - 22 2 - 23 1(3.3%) - 24 1(3.3%) - 25 - 26 1(3.3%) - 27 2 - 28 1(3.3%) - 29 1(3.3%) - 30 - 31 3(10.0%) - 32 12 - 33 3(10.0%) - 34 1(3.3%) - 35 1(3.3%) + Body System or Organ Class \n    Dictionary-Derived Term Placebo \n(N = 8) Xanomeline High Dose \n(N = 11) Xanomeline Low Dose \n(N = 11) Any Xanomeline \n(N = 22) All Patients \n(N = 30) + 1 Total number of participants with at least one adverse event 3 (37.5%) 2 (18.2%) 2 (18.2%) 4 (18.2%) 7 (23.3%) + 2 Overall total number of events 11 4 15 19 30 + 3 CARDIAC DISORDERS + 4 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) + 5 Total number of events 2 0 0 2 + 6 ATRIOVENTRICULAR BLOCK SECOND DEGREE 1 (12.5%) 0 0 1 (3.3%) + 7 BUNDLE BRANCH BLOCK LEFT 1 (12.5%) 0 0 1 (3.3%) + 8 GASTROINTESTINAL DISORDERS + 9 Total number of participants with at least one adverse event 2 (25.0%) 0 0 2 (6.7%) + 10 Total number of events 3 0 0 3 + 11 DIARRHOEA 1 (12.5%) 0 0 1 (3.3%) + 12 HIATUS HERNIA 1 (12.5%) 0 0 1 (3.3%) + 13 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 14 Total number of participants with at least one adverse event 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) + 15 Total number of events 2 4 3 7 9 + 16 APPLICATION SITE ERYTHEMA 1 (12.5%) 1 (9.1%) 0 1 (4.5%) 2 (6.7%) + 17 APPLICATION SITE PRURITUS 1 (12.5%) 2 (18.2%) 1 (9.1%) 3 (13.6%) 4 (13.3%) + 18 APPLICATION SITE VESICLES 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 19 FATIGUE 0 1 (9.1%) 0 1 (4.5%) 1 (3.3%) + 20 INFECTIONS AND INFESTATIONS + 21 Total number of participants with at least one adverse event 1 (12.5%) 0 1 (9.1%) 1 (4.5%) 2 (6.7%) + 22 Total number of events 1 0 1 1 2 + 23 LOCALISED INFECTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 24 UPPER RESPIRATORY TRACT INFECTION 1 (12.5%) 0 0 1 (3.3%) + 25 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS + 26 Total number of participants with at least one adverse event 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 27 Total number of events 0 0 2 2 2 + 28 NASAL CONGESTION 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 29 PHARYNGOLARYNGEAL PAIN 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 30 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 31 Total number of participants with at least one adverse event 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) + 32 Total number of events 3 0 9 9 12 + 33 ERYTHEMA 1 (12.5%) 0 2 (18.2%) 2 (9.1%) 3 (10.0%) + 34 PRURITUS 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) + 35 PRURITUS GENERALISED 0 0 1 (9.1%) 1 (4.5%) 1 (3.3%) # tbl_with_pools() warns and skips empty pools properly From 56339db04cec616d0fbe3a8a950cd1d8e6197929 Mon Sep 17 00:00:00 2001 From: Davide Garolini <11279768+Melkiades@users.noreply.github.com> Date: Fri, 22 May 2026 14:20:23 +0000 Subject: [PATCH 46/46] address reviewer comments on PR #228 - remove helper-snapshot_width.R, inline withr::local_options() - condense test title, add comment explaining custom data subsets - add @details to add_grade_column() docs explaining coupling - add TODO for anonymous function extraction (#251) --- R/tbl_hierarchical_rate_by_grade.R | 9 +++++++++ man/crane-package.Rd | 2 +- man/tbl_hierarchical_rate_by_grade.Rd | 7 +++++++ tests/testthat/helper-snapshot_width.R | 6 ------ tests/testthat/test-tbl_with_pools.R | 14 +++++++------- 5 files changed, 24 insertions(+), 14 deletions(-) delete mode 100644 tests/testthat/helper-snapshot_width.R diff --git a/R/tbl_hierarchical_rate_by_grade.R b/R/tbl_hierarchical_rate_by_grade.R index 611ea8a1..c1fb38ee 100644 --- a/R/tbl_hierarchical_rate_by_grade.R +++ b/R/tbl_hierarchical_rate_by_grade.R @@ -491,6 +491,13 @@ add_overall.tbl_hierarchical_rate_by_grade <- asNamespace("gtsummary")[["add_ove #' `x$custom_info` (standalone tables) or the first sub-table's `custom_info` (merged tables). #' If no metadata is found, the function aborts with an informative error. #' +#' `add_grade_column()` only works on tables produced by +#' [tbl_hierarchical_rate_by_grade()] — it reads the `custom_info` metadata +#' that function stores. They share a help page because they are designed +#' to be used together: build the table first, optionally merge with +#' [gtsummary::tbl_merge()] or [tbl_with_pools()], then call +#' `add_grade_column()` as the final step. +#' #' @rdname tbl_hierarchical_rate_by_grade #' @export add_grade_column <- function(x) { @@ -529,7 +536,9 @@ add_grade_column <- function(x) { lvls <- info$lvls label_list <- info$label_list + # apply visual formatting to the table body + # TODO: extract anonymous functions into named helpers (#251) x <- x |> gtsummary::modify_table_body( \(table_body) { diff --git a/man/crane-package.Rd b/man/crane-package.Rd index effdaba7..8c7b5804 100644 --- a/man/crane-package.Rd +++ b/man/crane-package.Rd @@ -28,7 +28,7 @@ Authors: \item Emily de la Rua \email{emilydelarua@gmail.com} (\href{https://orcid.org/0009-0000-8738-5561}{ORCID}) \item Davide Garolini \email{davide.garolini@roche.com} (\href{https://orcid.org/0000-0002-1445-1369}{ORCID}) \item Chi Zhang \email{chi.zhang.cz7@roche.com} (\href{https://orcid.org/0000-0003-0501-5909}{ORCID}) - \item Jan Szczypiński \email{jan.szczypinski@external.roche.com} (\href{https://orcid.org/0000-0002-5682-5840}{ORCID}) + \item Jan Szczypiski \email{jan.szczypinski@external.roche.com} (\href{https://orcid.org/0000-0002-5682-5840}{ORCID}) } Other contributors: diff --git a/man/tbl_hierarchical_rate_by_grade.Rd b/man/tbl_hierarchical_rate_by_grade.Rd index 380dab02..3011bb94 100644 --- a/man/tbl_hierarchical_rate_by_grade.Rd +++ b/man/tbl_hierarchical_rate_by_grade.Rd @@ -163,6 +163,13 @@ the \code{label} column prior to merge. The function extracts metadata injected by \code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} via \code{x$custom_info} (standalone tables) or the first sub-table's \code{custom_info} (merged tables). If no metadata is found, the function aborts with an informative error. + +\code{add_grade_column()} only works on tables produced by +\code{\link[=tbl_hierarchical_rate_by_grade]{tbl_hierarchical_rate_by_grade()}} — it reads the \code{custom_info} metadata +that function stores. They share a help page because they are designed +to be used together: build the table first, optionally merge with +\code{\link[gtsummary:tbl_merge]{gtsummary::tbl_merge()}} or \code{\link[=tbl_with_pools]{tbl_with_pools()}}, then call +\code{add_grade_column()} as the final step. } } \examples{ diff --git a/tests/testthat/helper-snapshot_width.R b/tests/testthat/helper-snapshot_width.R deleted file mode 100644 index f78e9835..00000000 --- a/tests/testthat/helper-snapshot_width.R +++ /dev/null @@ -1,6 +0,0 @@ -# Set a wide console width for snapshot tests to prevent line-wrapping -# differences across platforms. Call inside test_that() blocks before -# expect_snapshot() — withr::local_options() resets automatically on exit. -local_wide_snapshot <- function(width = 220, .local_envir = parent.frame()) { - withr::local_options(list(width = width), .local_envir = .local_envir) -} diff --git a/tests/testthat/test-tbl_with_pools.R b/tests/testthat/test-tbl_with_pools.R index 32ff5f23..fb9b9d5c 100644 --- a/tests/testthat/test-tbl_with_pools.R +++ b/tests/testthat/test-tbl_with_pools.R @@ -96,7 +96,7 @@ test_that("tbl_with_pools() works with standard functions like tbl_summary", { expect_true(any(str_detect(header_labels, "All Patients"))) # Snapshot the table output - local_wide_snapshot() + withr::local_options(list(width = 220)) expect_snapshot(as.data.frame(tbl)) }) @@ -119,7 +119,7 @@ test_that("tbl_with_pools() passes the denominator correctly for custom function expect_s3_class(tbl, "tbl_with_pools") # Snapshot the table output - local_wide_snapshot() + withr::local_options(list(width = 220)) expect_snapshot(as.data.frame(tbl)) }) @@ -419,12 +419,12 @@ test_that("tbl_with_pools() skips if an rlang::expr() evaluates to 0 rows", { # --- 13. Pipeline: tbl_with_pools + tbl_hierarchical_rate_by_grade + add_grade_column --- -test_that("tbl_with_pools() + tbl_hierarchical_rate_by_grade() + add_grade_column() pipeline works", { - # Regression test for the Cartesian join explosion. - # Previously, tbl_hierarchical_rate_by_grade() blanked the `label` column for - # grade rows before returning, causing tbl_merge() inside tbl_with_pools() to - # lose row uniqueness and produce a Cartesian cross-join. +test_that("tbl_with_pools() + add_grade_column() pipeline does not duplicate rows (#226)", { + # Regression test: deferred grade-column injection avoids row duplication + # during tbl_merge() inside tbl_with_pools(). + # Full ADSL + filtered ADAE (3 SOCs/AETERMs) — needs enough hierarchical + # depth for tbl_hierarchical_rate_by_grade; file-level subsets are too small. ADSL_pipe <- cards::ADSL ADAE_pipe <- cards::ADAE |> dplyr::filter(