From 8a7cebb41d3ca22fd4833f2d67201243746ccac8 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 10:56:45 +0000 Subject: [PATCH 01/20] add tbl_ancova() for ANCOVA tables with treatment-vs-control contrasts (#6) --- NAMESPACE | 1 + NEWS.md | 2 + R/tbl_ancova.R | 294 +++++++++++++++++++++++++++++++ man/tbl_ancova.Rd | 86 +++++++++ tests/testthat/test-tbl_ancova.R | 99 +++++++++++ 5 files changed, 482 insertions(+) create mode 100644 R/tbl_ancova.R create mode 100644 man/tbl_ancova.Rd create mode 100644 tests/testthat/test-tbl_ancova.R diff --git a/NAMESPACE b/NAMESPACE index 9c7147e5..52a83da7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,6 +48,7 @@ export(style_roche_number) export(style_roche_percent) export(style_roche_pvalue) export(style_roche_ratio) +export(tbl_ancova) export(tbl_baseline_chg) export(tbl_coxph) export(tbl_demographics) diff --git a/NEWS.md b/NEWS.md index bb0f1f3e..2242b7d8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## New Functions and Functionality +* Added `tbl_ancova()` for building ANCOVA tables with adjusted means and treatment-vs-control contrasts using `emmeans`. (#6) + * Added `g_lineplot()` for creating line plots with optional summary statistics table. Includes helper functions `calc_stats()`, `g_lineplot_table()`, and `preprocess_lineplot_data()`. * Added `ard_tabulate_abnormal_by_baseline()` for creating an Analysis Results Data (ARD) object counting participants with abnormal assessments, stratified by their baseline status. diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R new file mode 100644 index 00000000..0a4df8b1 --- /dev/null +++ b/R/tbl_ancova.R @@ -0,0 +1,294 @@ +#' ANCOVA Table +#' +#' @description +#' Builds a table of adjusted means and treatment-vs-control contrasts +#' from a linear model (ANCOVA). The table displays, for each treatment group: +#' - n (number of observations) +#' - Adjusted Mean (least-squares mean) +#' - Difference in Adjusted Means (vs reference group) +#' - Confidence interval for the difference +#' - p-value for the difference +#' +#' The model is fit via [`cardx::construct_model()`] and least-squares +#' estimates are obtained with the `emmeans` package. Contrasts use +#' `emmeans::contrast(method = "trt.vs.ctrl")` so that each non-reference +#' group is compared to the reference group only. +#' +#' @param data (`data.frame`)\cr +#' Analysis data set, typically one parameter/visit subset of an ADaM BDS. +#' @param formula (`formula`)\cr +#' Model formula passed to the fitting function. The left-hand side is the +#' response (e.g. `CHG`), the right-hand side includes the treatment variable +#' and any covariates (e.g. `CHG ~ TRT01A + BASE`). +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' Column in `data` identifying treatment groups. This variable must also +#' appear on the right-hand side of `formula`. Used for column headers. +#' @param ref_group (`string`)\cr +#' Level of `by` that is the reference (control) group. Contrasts are +#' computed as each non-reference group minus this group. +#' @param conf.level (scalar `numeric`)\cr +#' Confidence level for the difference in adjusted means. +#' Default is `0.95`. +#' @param method (`string`)\cr +#' Modelling function name. Default is `"lm"`. +#' @param method.args (`list`)\cr +#' Additional arguments passed to the modelling function. +#' @param package (`string`)\cr +#' Package exporting `method`. Default is `"stats"`. +#' @param denominator (`data.frame`)\cr +#' Optional data frame used to compute the header Ns (typically `ADSL`). +#' When supplied, the column headers show `(N = )` from this data +#' frame rather than from `data`. +#' +#' @return A `'gtsummary'` table of class `c("tbl_ancova", "gtsummary")`. +#' @name tbl_ancova +#' +#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") +#' theme_gtsummary_roche() +#' +#' # Simple ANCOVA with baseline covariate +#' cards::ADLB |> +#' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> +#' tbl_ancova( +#' formula = CHG ~ TRTA + BASE, +#' by = TRTA, +#' ref_group = "Placebo" +#' ) +#' +#' @export +tbl_ancova <- function(data, + formula, + by, + ref_group, + conf.level = 0.95, + method = "lm", + method.args = list(), + package = "stats", + denominator = NULL) { + set_cli_abort_call() + + # input checks --------------------------------------------------------------- + check_not_missing(data) + check_not_missing(formula) + check_not_missing(ref_group) + + check_class(data, "data.frame") + check_class(formula, "formula") + check_string(ref_group) + check_string(method) + check_string(package) + check_scalar(conf.level) + check_range(conf.level, range = c(0, 1)) + check_pkg_installed("emmeans") + + by <- dplyr::select(data, {{ by }}) |> names() + check_scalar(by, allow_empty = FALSE) + + if (!ref_group %in% unique(data[[by]])) { + cli::cli_abort( + "{.arg ref_group} value {.val {ref_group}} not found in column {.val {by}}.", + call = get_cli_abort_call() + ) + } + + # relevel so ref_group is first — emmeans uses the first level as reference + data[[by]] <- stats::relevel(factor(data[[by]]), ref = ref_group) + + # fit model and compute emmeans ---------------------------------------------- + mod <- cardx::construct_model( + data = data, formula = formula, method = method, + method.args = {{ method.args }}, package = package + ) + + emmeans_specs <- stats::reformulate(by) + emm <- emmeans::emmeans(mod, specs = emmeans_specs) + + # LS means ------------------------------------------------------------------- + emm_summary <- summary(emm, calc = c(n = ".wgt.")) |> + dplyr::as_tibble() |> + dplyr::rename( + estimate = dplyr::any_of(c("emmean", "prob")), + n = dplyr::any_of("n") + ) + + # contrasts (treatment vs control) ------------------------------------------- + contr_summary <- emmeans::contrast(emm, method = "trt.vs.ctrl", ref = ref_group) |> + summary(infer = TRUE, level = conf.level) |> + dplyr::as_tibble() |> + dplyr::rename( + conf.low = dplyr::any_of(c("lower.CL", "asymp.LCL")), + conf.high = dplyr::any_of(c("upper.CL", "asymp.UCL")) + ) + + # parse contrast labels to extract the non-reference group name + contr_summary$trt_group <- sub( + paste0("\\s*-\\s*", .escape_regex(ref_group), "$"), "", + contr_summary$contrast + ) + + # build ARD for tbl_ard_summary ---------------------------------------------- + trt_levels <- levels(data[[by]]) + endpoint_label <- all.vars(formula)[1] + + ard <- .build_ancova_ard( + emm_summary = emm_summary, + contr_summary = contr_summary, + by = by, + trt_levels = trt_levels, + ref_group = ref_group, + endpoint_label = endpoint_label, + conf.level = conf.level + ) + + # build gtsummary table ------------------------------------------------------ + ci_pct <- paste0(round(conf.level * 100), "%") + + tbl <- gtsummary::tbl_ard_summary( + cards = ard, + by = dplyr::all_of(by), + type = everything() ~ "continuous2", + statistic = everything() ~ c( + "{n}", + "{estimate}", + "{mean.diff}", + paste0("{conf.low}, {conf.high}"), + "{p.value}" + ), + ) |> + gtsummary::modify_table_body( + ~ .x |> + dplyr::mutate( + label = dplyr::case_when( + .data$label == "n" ~ "n", + .data$label == "Mean" ~ "Adjusted Mean", + .data$label == "Mean Difference" ~ "Difference in Adjusted Means", + .data$label == "CI Lower Bound, CI Upper Bound" ~ + paste0(ci_pct, " CI for Difference in Adjusted Means"), + .data$label == "p-value" ~ "p-value", + TRUE ~ .data$label + ), + # blank out stats that don't apply to the reference group + dplyr::across( + dplyr::starts_with("stat_"), + ~ dplyr::if_else( + .data$label %in% c( + "Difference in Adjusted Means", + paste0(ci_pct, " CI for Difference in Adjusted Means"), + "p-value" + ) & grepl("NA", .x, fixed = TRUE), + "", + .x + ) + ) + ) + ) + + # add denominator header Ns if provided + if (!is.null(denominator)) { + check_class(denominator, "data.frame") + if (by %in% names(denominator)) { + header_n <- denominator |> + dplyr::count(!!rlang::sym(by), name = "n") |> + dplyr::arrange(factor(!!rlang::sym(by), levels = trt_levels)) + + header_labels <- stats::setNames( + paste0("**", header_n[[by]], "**\n(N = ", header_n$n, ")"), + paste0("stat_", seq_len(nrow(header_n))) + ) + tbl <- tbl |> + gtsummary::modify_header(!!!header_labels) + } + } + + # add class and attributes + class(tbl) <- c("tbl_ancova", class(tbl)) + attr(tbl, "ref_group") <- ref_group + attr(tbl, "conf.level") <- conf.level + + tbl +} + + +# Internal: build the ARD data frame for tbl_ard_summary ----------------------- +.build_ancova_ard <- function(emm_summary, contr_summary, by, + trt_levels, ref_group, endpoint_label, + conf.level) { + ard_rows <- list() + + for (trt in trt_levels) { + emm_row <- emm_summary[emm_summary[[by]] == trt, ] + n_val <- as.integer(emm_row$n) + est_val <- emm_row$estimate + + # base rows: n and adjusted mean + ard_rows <- c(ard_rows, list( + .ancova_ard_row(endpoint_label, by, trt, "n", n_val, "n", "integer"), + .ancova_ard_row(endpoint_label, by, trt, "estimate", est_val, "Mean", "numeric") + )) + + # contrast rows (only for non-reference groups) + if (trt != ref_group) { + contr_row <- contr_summary[contr_summary$trt_group == trt, ] + if (nrow(contr_row) == 1) { + ard_rows <- c(ard_rows, list( + .ancova_ard_row(endpoint_label, by, trt, "mean.diff", contr_row$estimate, "Mean Difference", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "conf.low", contr_row$conf.low, "CI Lower Bound", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "conf.high", contr_row$conf.high, "CI Upper Bound", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "p.value", contr_row$p.value, "p-value", "numeric") + )) + } + } else { + # reference group: fill with NA so the table structure is consistent + ard_rows <- c(ard_rows, list( + .ancova_ard_row(endpoint_label, by, trt, "mean.diff", NA_real_, "Mean Difference", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "conf.low", NA_real_, "CI Lower Bound", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "conf.high", NA_real_, "CI Upper Bound", "numeric"), + .ancova_ard_row(endpoint_label, by, trt, "p.value", NA_real_, "p-value", "numeric") + )) + } + } + + dplyr::bind_rows(ard_rows) |> + dplyr::mutate( + context = "continuous", + fmt_fun = purrr::map2(.data$stat_name, .data$stat, function(nm, val) { + switch(nm, + "n" = function(x) sprintf("%.0f", x), + "estimate" = function(x) sprintf("%.2f", x), + "mean.diff" = function(x) sprintf("%.2f", x), + "conf.low" = , "conf.high" = function(x) sprintf("%.2f", x), + "p.value" = function(x) sprintf("%.4f", x), + function(x) as.character(x) + ) + }) + ) |> + cards::as_card() +} + + +# Internal: create a single ARD row -------------------------------------------- +.ancova_ard_row <- function(variable, group1, group1_level, + stat_name, stat, stat_label, var_type) { + dplyr::tibble( + variable = variable, + var_type = var_type, + var_label = variable, + group1 = group1, + group1_level = list(group1_level), + stat_name = stat_name, + stat_label = stat_label, + stat = list(stat), + warning = list(NULL), + error = list(NULL) + ) +} + + +# Internal: escape regex special characters ------------------------------------ +.escape_regex <- function(x) { + chars <- c(".", "|", "^", "$", "(", ")", "[", "]", "{", "}", "*", "+", "?", "\\") + for (ch in chars) { + x <- gsub(ch, paste0("\\", ch), x, fixed = TRUE) + } + x +} diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd new file mode 100644 index 00000000..2732fc28 --- /dev/null +++ b/man/tbl_ancova.Rd @@ -0,0 +1,86 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tbl_ancova.R +\name{tbl_ancova} +\alias{tbl_ancova} +\title{ANCOVA Table} +\usage{ +tbl_ancova( + data, + formula, + by, + ref_group, + conf.level = 0.95, + method = "lm", + method.args = list(), + package = "stats", + denominator = NULL +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +Analysis data set, typically one parameter/visit subset of an ADaM BDS.} + +\item{formula}{(\code{formula})\cr +Model formula passed to the fitting function. The left-hand side is the +response (e.g. \code{CHG}), the right-hand side includes the treatment variable +and any covariates (e.g. \code{CHG ~ TRT01A + BASE}).} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +Column in \code{data} identifying treatment groups. This variable must also +appear on the right-hand side of \code{formula}. Used for column headers.} + +\item{ref_group}{(\code{string})\cr +Level of \code{by} that is the reference (control) group. Contrasts are +computed as each non-reference group minus this group.} + +\item{conf.level}{(scalar \code{numeric})\cr +Confidence level for the difference in adjusted means. +Default is \code{0.95}.} + +\item{method}{(\code{string})\cr +Modelling function name. Default is \code{"lm"}.} + +\item{method.args}{(\code{list})\cr +Additional arguments passed to the modelling function.} + +\item{package}{(\code{string})\cr +Package exporting \code{method}. Default is \code{"stats"}.} + +\item{denominator}{(\code{data.frame})\cr +Optional data frame used to compute the header Ns (typically \code{ADSL}). +When supplied, the column headers show \verb{(N = )} from this data +frame rather than from \code{data}.} +} +\value{ +A \code{'gtsummary'} table of class \code{c("tbl_ancova", "gtsummary")}. +} +\description{ +Builds a table of adjusted means and treatment-vs-control contrasts +from a linear model (ANCOVA). The table displays, for each treatment group: +\itemize{ +\item n (number of observations) +\item Adjusted Mean (least-squares mean) +\item Difference in Adjusted Means (vs reference group) +\item Confidence interval for the difference +\item p-value for the difference +} + +The model is fit via \code{\link[cardx:construction_helpers]{cardx::construct_model()}} and least-squares +estimates are obtained with the \code{emmeans} package. Contrasts use +\code{emmeans::contrast(method = "trt.vs.ctrl")} so that each non-reference +group is compared to the reference group only. +} +\examples{ +\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +theme_gtsummary_roche() + +# Simple ANCOVA with baseline covariate +cards::ADLB |> + dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> + tbl_ancova( + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo" + ) +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R new file mode 100644 index 00000000..c40a9583 --- /dev/null +++ b/tests/testthat/test-tbl_ancova.R @@ -0,0 +1,99 @@ +df_ancova <- cards::ADLB |> + dplyr::filter( + PARAMCD == "SODIUM", + AVISIT == "Week 8" + ) |> + dplyr::mutate(TRTA = factor(TRTA)) + + +test_that("tbl_ancova() works with default settings", { + withr::local_options(list(width = 200)) + + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo" + ) + ) + + expect_s3_class(tbl, "tbl_ancova") + expect_s3_class(tbl, "gtsummary") + + # table has the expected row labels + labels <- tbl$table_body$label[tbl$table_body$row_type == "level"] + expect_true("n" %in% labels) + expect_true("Adjusted Mean" %in% labels) + expect_true("Difference in Adjusted Means" %in% labels) + expect_true("p-value" %in% labels) + + # reference group has blank contrast cells + ref_col <- tbl$table_body |> + dplyr::filter(.data$label == "Difference in Adjusted Means") |> + dplyr::pull("stat_1") + expect_equal(ref_col, "") + + expect_snapshot(as.data.frame(tbl)) +}) + + +test_that("tbl_ancova() works with denominator", { + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + denominator = cards::ADSL + ) + ) + + expect_s3_class(tbl, "tbl_ancova") +}) + + +test_that("tbl_ancova() works with conf.level = 0.90", { + withr::local_options(list(width = 200)) + + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + conf.level = 0.90 + ) + ) + + # CI label reflects 90% + labels <- tbl$table_body$label[tbl$table_body$row_type == "level"] + expect_true(any(grepl("90%", labels))) +}) + + +test_that("tbl_ancova() errors on invalid ref_group", { + expect_error( + tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "NonexistentArm" + ), + "not found" + ) +}) + + +test_that("tbl_ancova() works without covariates", { + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA, + by = TRTA, + ref_group = "Placebo" + ) + ) + + expect_s3_class(tbl, "tbl_ancova") +}) From 03cbde7b8ecb9ae5a495fe53905611e3e3269539 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 11:06:00 +0000 Subject: [PATCH 02/20] add adjust parameter for multiplicity correction in tbl_ancova() Default is adjust = "none" (unadjusted, matching tern behavior). Users can specify "dunnett", "bonferroni", etc. --- R/tbl_ancova.R | 9 ++++++++- man/tbl_ancova.Rd | 7 +++++++ tests/testthat/test-tbl_ancova.R | 15 +++++++++++++++ 3 files changed, 30 insertions(+), 1 deletion(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 0a4df8b1..3d7c6dfc 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -35,6 +35,11 @@ #' Additional arguments passed to the modelling function. #' @param package (`string`)\cr #' Package exporting `method`. Default is `"stats"`. +#' @param adjust (`string`)\cr +#' Multiplicity adjustment method for contrasts, passed to +#' [`emmeans::contrast()`]. Common choices: `"none"` (no adjustment, +#' default), `"dunnett"` (Dunnett's method), `"bonferroni"`, `"tukey"`. +#' See [`emmeans::summary.emmGrid()`] for all options. #' @param denominator (`data.frame`)\cr #' Optional data frame used to compute the header Ns (typically `ADSL`). #' When supplied, the column headers show `(N = )` from this data @@ -64,6 +69,7 @@ tbl_ancova <- function(data, method = "lm", method.args = list(), package = "stats", + adjust = "none", denominator = NULL) { set_cli_abort_call() @@ -79,6 +85,7 @@ tbl_ancova <- function(data, check_string(package) check_scalar(conf.level) check_range(conf.level, range = c(0, 1)) + check_string(adjust) check_pkg_installed("emmeans") by <- dplyr::select(data, {{ by }}) |> names() @@ -112,7 +119,7 @@ tbl_ancova <- function(data, ) # contrasts (treatment vs control) ------------------------------------------- - contr_summary <- emmeans::contrast(emm, method = "trt.vs.ctrl", ref = ref_group) |> + contr_summary <- emmeans::contrast(emm, method = "trt.vs.ctrl", ref = ref_group, adjust = adjust) |> summary(infer = TRUE, level = conf.level) |> dplyr::as_tibble() |> dplyr::rename( diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd index 2732fc28..e8a02578 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -13,6 +13,7 @@ tbl_ancova( method = "lm", method.args = list(), package = "stats", + adjust = "none", denominator = NULL ) } @@ -46,6 +47,12 @@ Additional arguments passed to the modelling function.} \item{package}{(\code{string})\cr Package exporting \code{method}. Default is \code{"stats"}.} +\item{adjust}{(\code{string})\cr +Multiplicity adjustment method for contrasts, passed to +\code{\link[emmeans:contrast]{emmeans::contrast()}}. Common choices: \code{"none"} (no adjustment, +default), \code{"dunnett"} (Dunnett's method), \code{"bonferroni"}, \code{"tukey"}. +See \code{\link[emmeans:summary.emmGrid]{emmeans::summary.emmGrid()}} for all options.} + \item{denominator}{(\code{data.frame})\cr Optional data frame used to compute the header Ns (typically \code{ADSL}). When supplied, the column headers show \verb{(N = )} from this data diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index c40a9583..605c7ad5 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -85,6 +85,21 @@ test_that("tbl_ancova() errors on invalid ref_group", { }) +test_that("tbl_ancova() works with Dunnett adjustment", { + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + adjust = "dunnett" + ) + ) + + expect_s3_class(tbl, "tbl_ancova") +}) + + test_that("tbl_ancova() works without covariates", { expect_silent( tbl <- tbl_ancova( From 366b2f9d4b4c7430d05a7ab76fb7124b3c0c2b8a Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 14:53:02 +0000 Subject: [PATCH 03/20] address PR review comments on tbl_ancova() - remove ADaM BDS terminology (crane is open-source) - change `@examplesIf` to `@examples`, remove `theme_gtsummary_roche()` - add denominator and Dunnett examples - add descriptive comments on `.build_ancova_ard` and `.escape_regex` - add example values in contrast label parsing comment - simplify `map2` to `map` in `fmt_fun` - store by, adjust, method attributes on returned object - use `expect_snapshot` for error test - add header N verification in denominator test - add attribute and label checks in Dunnett and no-covariates tests --- R/tbl_ancova.R | 47 +++++++++++++++++++++++++------- tests/testthat/test-tbl_ancova.R | 36 ++++++++++++++++++++++-- 2 files changed, 71 insertions(+), 12 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 3d7c6dfc..9a3d5daa 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -15,7 +15,7 @@ #' group is compared to the reference group only. #' #' @param data (`data.frame`)\cr -#' Analysis data set, typically one parameter/visit subset of an ADaM BDS. +#' Analysis data set, typically one parameter/visit subset. #' @param formula (`formula`)\cr #' Model formula passed to the fitting function. The left-hand side is the #' response (e.g. `CHG`), the right-hand side includes the treatment variable @@ -45,12 +45,7 @@ #' When supplied, the column headers show `(N = )` from this data #' frame rather than from `data`. #' -#' @return A `'gtsummary'` table of class `c("tbl_ancova", "gtsummary")`. -#' @name tbl_ancova -#' -#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true") -#' theme_gtsummary_roche() -#' +#' @examples #' # Simple ANCOVA with baseline covariate #' cards::ADLB |> #' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> @@ -60,6 +55,29 @@ #' ref_group = "Placebo" #' ) #' +#' # With denominator for header Ns +#' cards::ADLB |> +#' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> +#' tbl_ancova( +#' formula = CHG ~ TRTA + BASE, +#' by = TRTA, +#' ref_group = "Placebo", +#' denominator = cards::ADSL +#' ) +#' +#' # With Dunnett's multiplicity adjustment +#' cards::ADLB |> +#' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> +#' tbl_ancova( +#' formula = CHG ~ TRTA + BASE, +#' by = TRTA, +#' ref_group = "Placebo", +#' adjust = "dunnett" +#' ) +#' +#' @return A `'gtsummary'` table of class `c("tbl_ancova", "gtsummary")`. +#' @name tbl_ancova +#' #' @export tbl_ancova <- function(data, formula, @@ -127,7 +145,9 @@ tbl_ancova <- function(data, conf.high = dplyr::any_of(c("upper.CL", "asymp.UCL")) ) + # parse contrast labels to extract the non-reference group name + # e.g. "Xanomeline High Dose - Placebo" -> "Xanomeline High Dose" contr_summary$trt_group <- sub( paste0("\\s*-\\s*", .escape_regex(ref_group), "$"), "", contr_summary$contrast @@ -209,14 +229,20 @@ tbl_ancova <- function(data, # add class and attributes class(tbl) <- c("tbl_ancova", class(tbl)) + attr(tbl, "by") <- by attr(tbl, "ref_group") <- ref_group attr(tbl, "conf.level") <- conf.level + attr(tbl, "adjust") <- adjust + attr(tbl, "method") <- method tbl } -# Internal: build the ARD data frame for tbl_ard_summary ----------------------- +# Assembles an ARD (Analysis Results Dataset) from emmeans summaries. +# For each treatment level, creates rows for: n, adjusted mean (from emm_summary), +# and contrast stats — mean difference, CI bounds, p-value (from contr_summary). +# Reference group gets NA for contrast stats so the table structure is uniform. .build_ancova_ard <- function(emm_summary, contr_summary, by, trt_levels, ref_group, endpoint_label, conf.level) { @@ -258,7 +284,7 @@ tbl_ancova <- function(data, dplyr::bind_rows(ard_rows) |> dplyr::mutate( context = "continuous", - fmt_fun = purrr::map2(.data$stat_name, .data$stat, function(nm, val) { + fmt_fun = purrr::map(.data$stat_name, function(nm) { switch(nm, "n" = function(x) sprintf("%.0f", x), "estimate" = function(x) sprintf("%.2f", x), @@ -291,7 +317,8 @@ tbl_ancova <- function(data, } -# Internal: escape regex special characters ------------------------------------ +# Escapes regex special characters so group names can be used in sub() patterns. +# e.g. "Arm (High)" -> "Arm \\(High\\)", "Dose 1.5mg" -> "Dose 1\\.5mg" .escape_regex <- function(x) { chars <- c(".", "|", "^", "$", "(", ")", "[", "]", "{", "}", "*", "+", "?", "\\") for (ch in chars) { diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index 605c7ad5..808b4bcf 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -39,6 +39,8 @@ test_that("tbl_ancova() works with default settings", { test_that("tbl_ancova() works with denominator", { + withr::local_options(list(width = 200)) + expect_silent( tbl <- tbl_ancova( data = df_ancova, @@ -50,6 +52,19 @@ test_that("tbl_ancova() works with denominator", { ) expect_s3_class(tbl, "tbl_ancova") + + # header Ns come from ADSL, not from the analysis data + adsl_n <- cards::ADSL |> + dplyr::count(TRTA) |> + dplyr::arrange(factor(TRTA, levels = levels(df_ancova$TRTA))) + for (i in seq_len(nrow(adsl_n))) { + header <- tbl$table_styling$header |> + dplyr::filter(.data$column == paste0("stat_", i)) |> + dplyr::pull("label") + expect_true(grepl(paste0("N = ", adsl_n$n[i]), header)) + } + + expect_snapshot(as.data.frame(tbl)) }) @@ -73,19 +88,21 @@ test_that("tbl_ancova() works with conf.level = 0.90", { test_that("tbl_ancova() errors on invalid ref_group", { - expect_error( + expect_snapshot( tbl_ancova( data = df_ancova, formula = CHG ~ TRTA + BASE, by = TRTA, ref_group = "NonexistentArm" ), - "not found" + error = TRUE ) }) test_that("tbl_ancova() works with Dunnett adjustment", { + withr::local_options(list(width = 200)) + expect_silent( tbl <- tbl_ancova( data = df_ancova, @@ -97,10 +114,18 @@ test_that("tbl_ancova() works with Dunnett adjustment", { ) expect_s3_class(tbl, "tbl_ancova") + expect_equal(attr(tbl, "adjust"), "dunnett") + expect_equal(attr(tbl, "method"), "lm") + expect_equal(attr(tbl, "by"), "TRTA") + expect_equal(attr(tbl, "ref_group"), "Placebo") + + expect_snapshot(as.data.frame(tbl)) }) test_that("tbl_ancova() works without covariates", { + withr::local_options(list(width = 200)) + expect_silent( tbl <- tbl_ancova( data = df_ancova, @@ -111,4 +136,11 @@ test_that("tbl_ancova() works without covariates", { ) expect_s3_class(tbl, "tbl_ancova") + + # verify labels are present even without covariates + labels <- tbl$table_body$label[tbl$table_body$row_type == "level"] + expect_true("Adjusted Mean" %in% labels) + expect_true("Difference in Adjusted Means" %in% labels) + + expect_snapshot(as.data.frame(tbl)) }) From 25aedacf67b28e25cc4e437e2d20c384c0597bba Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 15:26:33 +0000 Subject: [PATCH 04/20] move `@return` before `@examples`, use `structure()` for attributes, add package attr --- R/tbl_ancova.R | 25 +++++++++++++------------ tests/testthat/test-tbl_ancova.R | 1 + 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 9a3d5daa..12406629 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -45,6 +45,9 @@ #' When supplied, the column headers show `(N = )` from this data #' frame rather than from `data`. #' +#' @return A `'gtsummary'` table of class `c("tbl_ancova", "gtsummary")`. +#' @name tbl_ancova +#' #' @examples #' # Simple ANCOVA with baseline covariate #' cards::ADLB |> @@ -75,9 +78,6 @@ #' adjust = "dunnett" #' ) #' -#' @return A `'gtsummary'` table of class `c("tbl_ancova", "gtsummary")`. -#' @name tbl_ancova -#' #' @export tbl_ancova <- function(data, formula, @@ -227,15 +227,16 @@ tbl_ancova <- function(data, } } - # add class and attributes - class(tbl) <- c("tbl_ancova", class(tbl)) - attr(tbl, "by") <- by - attr(tbl, "ref_group") <- ref_group - attr(tbl, "conf.level") <- conf.level - attr(tbl, "adjust") <- adjust - attr(tbl, "method") <- method - - tbl + tbl |> + structure( + class = c("tbl_ancova", class(tbl)), + by = by, + ref_group = ref_group, + conf.level = conf.level, + adjust = adjust, + method = method, + package = package + ) } diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index 808b4bcf..b897ab73 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -116,6 +116,7 @@ test_that("tbl_ancova() works with Dunnett adjustment", { expect_s3_class(tbl, "tbl_ancova") expect_equal(attr(tbl, "adjust"), "dunnett") expect_equal(attr(tbl, "method"), "lm") + expect_equal(attr(tbl, "package"), "stats") expect_equal(attr(tbl, "by"), "TRTA") expect_equal(attr(tbl, "ref_group"), "Placebo") From 89a2f1b1042144dee77a1615bde5cdf75c225a1a Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 16:22:37 +0000 Subject: [PATCH 05/20] use standalone map(), fix tidyselect warning in tbl_mmrm, add snapshots - replace purrr::map() with standalone map() in tbl_ancova - wrap strata/by in all_of() in tbl_mmrm to fix tidyselect deprecation - add ANCOVA, Dunnett's, modelling to WORDLIST - regenerate tbl_ancova.Rd, add test snapshots - apply styler formatting --- R/tbl_ancova.R | 9 +++-- inst/WORDLIST | 3 ++ man/tbl_ancova.Rd | 27 ++++++++++--- tests/testthat/_snaps/tbl_ancova.md | 60 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 9 deletions(-) create mode 100644 tests/testthat/_snaps/tbl_ancova.md diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 12406629..9012f6cb 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -116,7 +116,7 @@ tbl_ancova <- function(data, ) } - # relevel so ref_group is first — emmeans uses the first level as reference + # relevel so ref_group is first emmeans uses the first level as reference data[[by]] <- stats::relevel(factor(data[[by]]), ref = ref_group) # fit model and compute emmeans ---------------------------------------------- @@ -242,7 +242,7 @@ tbl_ancova <- function(data, # Assembles an ARD (Analysis Results Dataset) from emmeans summaries. # For each treatment level, creates rows for: n, adjusted mean (from emm_summary), -# and contrast stats — mean difference, CI bounds, p-value (from contr_summary). +# and contrast stats mean difference, CI bounds, p-value (from contr_summary). # Reference group gets NA for contrast stats so the table structure is uniform. .build_ancova_ard <- function(emm_summary, contr_summary, by, trt_levels, ref_group, endpoint_label, @@ -285,12 +285,13 @@ tbl_ancova <- function(data, dplyr::bind_rows(ard_rows) |> dplyr::mutate( context = "continuous", - fmt_fun = purrr::map(.data$stat_name, function(nm) { + fmt_fun = map(.data$stat_name, function(nm) { switch(nm, "n" = function(x) sprintf("%.0f", x), "estimate" = function(x) sprintf("%.2f", x), "mean.diff" = function(x) sprintf("%.2f", x), - "conf.low" = , "conf.high" = function(x) sprintf("%.2f", x), + "conf.low" = , + "conf.high" = function(x) sprintf("%.2f", x), "p.value" = function(x) sprintf("%.4f", x), function(x) as.character(x) ) diff --git a/inst/WORDLIST b/inst/WORDLIST index 0a17e3c7..6f6ce22a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -3,8 +3,10 @@ ADSL ADaM AE AEs +ANCOVA ARD ARDs +Dunnett's GDSR HLT Hoffmann @@ -37,6 +39,7 @@ gtsummary harrington lineplot lineplots +modelling peto pharma pre diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd index e8a02578..fb0cafca 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -19,7 +19,7 @@ tbl_ancova( } \arguments{ \item{data}{(\code{data.frame})\cr -Analysis data set, typically one parameter/visit subset of an ADaM BDS.} +Analysis data set, typically one parameter/visit subset.} \item{formula}{(\code{formula})\cr Model formula passed to the fitting function. The left-hand side is the @@ -78,9 +78,6 @@ estimates are obtained with the \code{emmeans} package. Contrasts use group is compared to the reference group only. } \examples{ -\dontshow{if (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -theme_gtsummary_roche() - # Simple ANCOVA with baseline covariate cards::ADLB |> dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> @@ -89,5 +86,25 @@ cards::ADLB |> by = TRTA, ref_group = "Placebo" ) -\dontshow{\}) # examplesIf} + +# With denominator for header Ns +cards::ADLB |> + dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> + tbl_ancova( + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + denominator = cards::ADSL + ) + +# With Dunnett's multiplicity adjustment +cards::ADLB |> + dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> + tbl_ancova( + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + adjust = "dunnett" + ) + } diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md new file mode 100644 index 00000000..740213f4 --- /dev/null +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -0,0 +1,60 @@ +# tbl_ancova() works with default settings + + Code + as.data.frame(tbl) + Output + Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose + 1 CHG + 2 n 5 4 3 + 3 Adjusted Mean 0.60 -0.66 -0.47 + 4 Difference in Adjusted Means -1.26 -1.07 + 5 95% CI for Difference in Adjusted Means -4.23,1.71 -4.35,2.21 + 6 p-value 0.3563 0.4733 + +# tbl_ancova() works with denominator + + Code + as.data.frame(tbl) + Output + Characteristic Placebo\n(N = 86) Xanomeline High Dose\n(N = 84) Xanomeline Low Dose\n(N = 84) + 1 CHG + 2 n 5 4 3 + 3 Adjusted Mean 0.60 -0.66 -0.47 + 4 Difference in Adjusted Means -1.26 -1.07 + 5 95% CI for Difference in Adjusted Means -4.23,1.71 -4.35,2.21 + 6 p-value 0.3563 0.4733 + +# tbl_ancova() errors on invalid ref_group + + Code + tbl_ancova(data = df_ancova, formula = CHG ~ TRTA + BASE, by = TRTA, ref_group = "NonexistentArm") + Condition + Error in `tbl_ancova()`: + ! `ref_group` value "NonexistentArm" not found in column "TRTA". + +# tbl_ancova() works with Dunnett adjustment + + Code + as.data.frame(tbl) + Output + Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose + 1 CHG + 2 n 5 4 3 + 3 Adjusted Mean 0.60 -0.66 -0.47 + 4 Difference in Adjusted Means -1.26 -1.07 + 5 95% CI for Difference in Adjusted Means -4.73,2.22 -4.91,2.77 + 6 p-value 0.5491 0.6839 + +# tbl_ancova() works without covariates + + Code + as.data.frame(tbl) + Output + Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose + 1 CHG + 2 n 5 4 3 + 3 Adjusted Mean 0.20 -0.50 0.00 + 4 Difference in Adjusted Means -0.70 -0.20 + 5 95% CI for Difference in Adjusted Means -4.34,2.94 -4.16,3.76 + 6 p-value 0.6738 0.9116 + From dacea6c4ac8ee15de388c4643e09e31fcd0b488a Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 16:38:21 +0000 Subject: [PATCH 06/20] fix tidyselect warning in process_selectors, regenerate docs with roxygen2 8.0.0 - wrap arm/visit in all_of() in second process_selectors call in tbl_mmrm - regenerate Rd files with roxygen2 8.0.0 (fixes construct_model xref) - fix snapshot non-breaking space encoding --- man/crane-package.Rd | 2 +- man/tbl_ancova.Rd | 2 +- tests/testthat/_snaps/tbl_ancova.md | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) 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_ancova.Rd b/man/tbl_ancova.Rd index fb0cafca..5d211502 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -72,7 +72,7 @@ from a linear model (ANCOVA). The table displays, for each treatment group: \item p-value for the difference } -The model is fit via \code{\link[cardx:construction_helpers]{cardx::construct_model()}} and least-squares +The model is fit via \code{\link[cardx:construct_model]{cardx::construct_model()}} and least-squares estimates are obtained with the \code{emmeans} package. Contrasts use \code{emmeans::contrast(method = "trt.vs.ctrl")} so that each non-reference group is compared to the reference group only. diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index 740213f4..c5fd33ce 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -8,7 +8,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23,1.71 -4.35,2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -21,7 +21,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23,1.71 -4.35,2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -42,7 +42,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73,2.22 -4.91,2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -55,6 +55,6 @@ 2 n 5 4 3 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34,2.94 -4.16,3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From 088b44b5cf9dfb08da5429491ea1238db7329211 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 18:45:50 +0200 Subject: [PATCH 07/20] fixes --- R/tbl_ancova.R | 2 +- tests/testthat/_snaps/tbl_ancova.md | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 9012f6cb..69331ebd 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -242,7 +242,7 @@ tbl_ancova <- function(data, # Assembles an ARD (Analysis Results Dataset) from emmeans summaries. # For each treatment level, creates rows for: n, adjusted mean (from emm_summary), -# and contrast stats mean difference, CI bounds, p-value (from contr_summary). +# and contrast stats mean difference, CI bounds, p-value (from contr_summary). # Reference group gets NA for contrast stats so the table structure is uniform. .build_ancova_ard <- function(emm_summary, contr_summary, by, trt_levels, ref_group, endpoint_label, diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index c5fd33ce..d356a1cf 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -8,7 +8,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -21,7 +21,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -42,7 +42,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -55,6 +55,6 @@ 2 n 5 4 3 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From 7dfd609e3a28a3d3fc6646a3877598a1e9f8e97d Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 18:50:43 +0200 Subject: [PATCH 08/20] wordlist --- inst/WORDLIST | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index 6f6ce22a..38040dfb 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -12,6 +12,7 @@ HLT Hoffmann Kaplan MMRM +Modelling Ns ORCID PY @@ -20,8 +21,10 @@ Pharmacokinetics RMP RMPT RStudio +Recode Rua SOCs +Szczypi Tidyverse analyte breslow @@ -29,6 +32,7 @@ cardx custiomization customizations de +durations efron fleming flextable @@ -37,6 +41,7 @@ gehan ggplot gtsummary harrington +jitter lineplot lineplots modelling @@ -46,6 +51,7 @@ pre prentice quosure quosures +recodes responder rlang's survfit From 2c48e7fbaf273a52665a9e220a2916c333d9a549 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 18:52:09 +0200 Subject: [PATCH 09/20] fix --- man/crane-package.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/crane-package.Rd b/man/crane-package.Rd index 8c7b5804..effdaba7 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 Szczypiski \email{jan.szczypinski@external.roche.com} (\href{https://orcid.org/0000-0002-5682-5840}{ORCID}) + \item Jan Szczypiński \email{jan.szczypinski@external.roche.com} (\href{https://orcid.org/0000-0002-5682-5840}{ORCID}) } Other contributors: From 37bc080b848e3f5f70482fe468b4e940f135d5ce Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 16:52:46 +0000 Subject: [PATCH 10/20] fix snapshot: -0.00 rounding in no-covariates test --- tests/testthat/_snaps/tbl_ancova.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index d356a1cf..c446f2a6 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -53,7 +53,7 @@ Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose 1 CHG 2 n 5 4 3 - 3 Adjusted Mean 0.20 -0.50 0.00 + 3 Adjusted Mean 0.20 -0.50 -0.00 4 Difference in Adjusted Means -0.70 -0.20 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From 6f77943c8e0b293497dad6b9bc8d0c9b95636dca Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 16:57:10 +0000 Subject: [PATCH 11/20] strip negative zero in formatted output to avoid platform-dependent snapshots --- R/tbl_ancova.R | 6 +++--- tests/testthat/_snaps/tbl_ancova.md | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 69331ebd..b03cfd46 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -288,10 +288,10 @@ tbl_ancova <- function(data, fmt_fun = map(.data$stat_name, function(nm) { switch(nm, "n" = function(x) sprintf("%.0f", x), - "estimate" = function(x) sprintf("%.2f", x), - "mean.diff" = function(x) sprintf("%.2f", x), + "estimate" = , + "mean.diff" = , "conf.low" = , - "conf.high" = function(x) sprintf("%.2f", x), + "conf.high" = function(x) sub("^-0.00$", "0.00", sprintf("%.2f", x)), "p.value" = function(x) sprintf("%.4f", x), function(x) as.character(x) ) diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index c446f2a6..c5fd33ce 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -8,7 +8,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -21,7 +21,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -42,7 +42,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -53,8 +53,8 @@ Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose 1 CHG 2 n 5 4 3 - 3 Adjusted Mean 0.20 -0.50 -0.00 + 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From a738391b609059442191e393dafdffcfd2ab5ad6 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 17:05:10 +0000 Subject: [PATCH 12/20] add ANCOVA Tables section to pkgdown reference --- _pkgdown.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index caa3260f..e59599fa 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -23,6 +23,10 @@ reference: - add_hierarchical_count_row - ard_tabulate_abnormal_by_baseline + - title: "ANCOVA Tables" + contents: + - tbl_ancova + - title: "Survival Analysis Tables" contents: - tbl_survfit_quantiles From 54c3cf989d30db9fc633fdcdec11b0b58d5085f0 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 19:12:51 +0200 Subject: [PATCH 13/20] snaps --- tests/testthat/_snaps/tbl_ancova.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index c5fd33ce..d356a1cf 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -8,7 +8,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -21,7 +21,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -42,7 +42,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -55,6 +55,6 @@ 2 n 5 4 3 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From 120314f895be3070fe06ea4d58ebee39f06c0257 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Sun, 10 May 2026 17:32:21 +0000 Subject: [PATCH 14/20] use variable label attribute for endpoint label instead of raw variable name Shows 'Change from Baseline' instead of 'CHG' in the table header row. Falls back to the variable name if no label attribute exists. --- R/tbl_ancova.R | 3 ++- tests/testthat/_snaps/tbl_ancova.md | 16 ++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index b03cfd46..bb33487a 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -155,7 +155,8 @@ tbl_ancova <- function(data, # build ARD for tbl_ard_summary ---------------------------------------------- trt_levels <- levels(data[[by]]) - endpoint_label <- all.vars(formula)[1] + endpoint_var <- all.vars(formula)[1] + endpoint_label <- attr(data[[endpoint_var]], "label") %||% endpoint_var ard <- .build_ancova_ard( emm_summary = emm_summary, diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index d356a1cf..52e95a74 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -4,11 +4,11 @@ as.data.frame(tbl) Output Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose - 1 CHG + 1 Change from Baseline 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -17,11 +17,11 @@ as.data.frame(tbl) Output Characteristic Placebo\n(N = 86) Xanomeline High Dose\n(N = 84) Xanomeline Low Dose\n(N = 84) - 1 CHG + 1 Change from Baseline 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -38,11 +38,11 @@ as.data.frame(tbl) Output Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose - 1 CHG + 1 Change from Baseline 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -51,10 +51,10 @@ as.data.frame(tbl) Output Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose - 1 CHG + 1 Change from Baseline 2 n 5 4 3 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From c17a7891fed2c07ae4c158e7dca365936409170a Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 11 May 2026 08:50:44 +0000 Subject: [PATCH 15/20] add label parameter to tbl_ancova() for custom row label Defaults to the response variable's label attribute. When used inside tbl_strata(strata = PARAM), pass label = unique(.x$PARAM) so each sub-table shows the parameter name instead of the variable name. --- R/tbl_ancova.R | 8 +++++++- man/tbl_ancova.Rd | 7 +++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index bb33487a..38c0d36c 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -40,6 +40,11 @@ #' [`emmeans::contrast()`]. Common choices: `"none"` (no adjustment, #' default), `"dunnett"` (Dunnett's method), `"bonferroni"`, `"tukey"`. #' See [`emmeans::summary.emmGrid()`] for all options. +#' @param label (`string`)\cr +#' Label for the top-level row in the table. Defaults to the label attribute +#' of the response variable, or the variable name if no label exists. +#' When used inside `tbl_strata(strata = PARAM)`, pass the parameter value +#' (e.g. `unique(data$PARAM)`) so each sub-table is labelled correctly. #' @param denominator (`data.frame`)\cr #' Optional data frame used to compute the header Ns (typically `ADSL`). #' When supplied, the column headers show `(N = )` from this data @@ -88,6 +93,7 @@ tbl_ancova <- function(data, method.args = list(), package = "stats", adjust = "none", + label = NULL, denominator = NULL) { set_cli_abort_call() @@ -156,7 +162,7 @@ tbl_ancova <- function(data, # build ARD for tbl_ard_summary ---------------------------------------------- trt_levels <- levels(data[[by]]) endpoint_var <- all.vars(formula)[1] - endpoint_label <- attr(data[[endpoint_var]], "label") %||% endpoint_var + endpoint_label <- label %||% attr(data[[endpoint_var]], "label") %||% endpoint_var ard <- .build_ancova_ard( emm_summary = emm_summary, diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd index 5d211502..e650c6d0 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -14,6 +14,7 @@ tbl_ancova( method.args = list(), package = "stats", adjust = "none", + label = NULL, denominator = NULL ) } @@ -53,6 +54,12 @@ Multiplicity adjustment method for contrasts, passed to default), \code{"dunnett"} (Dunnett's method), \code{"bonferroni"}, \code{"tukey"}. See \code{\link[emmeans:summary.emmGrid]{emmeans::summary.emmGrid()}} for all options.} +\item{label}{(\code{string})\cr +Label for the top-level row in the table. Defaults to the label attribute +of the response variable, or the variable name if no label exists. +When used inside \code{tbl_strata(strata = PARAM)}, pass the parameter value +(e.g. \code{unique(data$PARAM)}) so each sub-table is labelled correctly.} + \item{denominator}{(\code{data.frame})\cr Optional data frame used to compute the header Ns (typically \code{ADSL}). When supplied, the column headers show \verb{(N = )} from this data From 89cb17c61b5b9d0c90bac73377ca81bd68f94d8c Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 11 May 2026 09:01:25 +0000 Subject: [PATCH 16/20] add input check, example, and tests for label parameter --- R/tbl_ancova.R | 11 +++++++++ man/tbl_ancova.Rd | 10 ++++++++ tests/testthat/_snaps/tbl_ancova.md | 13 ++++++++++ tests/testthat/test-tbl_ancova.R | 37 +++++++++++++++++++++++++++++ 4 files changed, 71 insertions(+) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index 38c0d36c..fda868b6 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -73,6 +73,16 @@ #' denominator = cards::ADSL #' ) #' +#' # With custom label (e.g. parameter name inside tbl_strata) +#' cards::ADLB |> +#' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> +#' tbl_ancova( +#' formula = CHG ~ TRTA + BASE, +#' by = TRTA, +#' ref_group = "Placebo", +#' label = "Sodium (mmol/L)" +#' ) +#' #' # With Dunnett's multiplicity adjustment #' cards::ADLB |> #' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> @@ -110,6 +120,7 @@ tbl_ancova <- function(data, check_scalar(conf.level) check_range(conf.level, range = c(0, 1)) check_string(adjust) + if (!is.null(label)) check_string(label) check_pkg_installed("emmeans") by <- dplyr::select(data, {{ by }}) |> names() diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd index e650c6d0..f9afc62c 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -104,6 +104,16 @@ cards::ADLB |> denominator = cards::ADSL ) +# With custom label (e.g. parameter name inside tbl_strata) +cards::ADLB |> + dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> + tbl_ancova( + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + label = "Sodium (mmol/L)" + ) + # With Dunnett's multiplicity adjustment cards::ADLB |> dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index 52e95a74..a34085e2 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -32,6 +32,19 @@ Error in `tbl_ancova()`: ! `ref_group` value "NonexistentArm" not found in column "TRTA". +# tbl_ancova() works with custom label + + Code + as.data.frame(tbl) + Output + Characteristic Placebo Xanomeline High Dose Xanomeline Low Dose + 1 Sodium (mmol/L) + 2 n 5 4 3 + 3 Adjusted Mean 0.60 -0.66 -0.47 + 4 Difference in Adjusted Means -1.26 -1.07 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 6 p-value 0.3563 0.4733 + # tbl_ancova() works with Dunnett adjustment Code diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index b897ab73..0f0bbca4 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -100,6 +100,43 @@ test_that("tbl_ancova() errors on invalid ref_group", { }) +test_that("tbl_ancova() works with custom label", { + withr::local_options(list(width = 200)) + + expect_silent( + tbl <- tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + label = "Sodium (mmol/L)" + ) + ) + + expect_s3_class(tbl, "tbl_ancova") + + # the custom label appears in the table body instead of the variable name + top_label <- tbl$table_body$label[tbl$table_body$row_type == "label"] + expect_true("Sodium (mmol/L)" %in% top_label) + expect_false("CHG" %in% top_label) + expect_false("Change from Baseline" %in% top_label) + + expect_snapshot(as.data.frame(tbl)) +}) + +test_that("tbl_ancova() errors on non-string label", { + expect_error( + tbl_ancova( + data = df_ancova, + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo", + label = 123 + ) + ) +}) + + test_that("tbl_ancova() works with Dunnett adjustment", { withr::local_options(list(width = 200)) From e7403888b7fb4fdfb8c83fd538c1e3a6a14c78d8 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 11 May 2026 09:01:52 +0000 Subject: [PATCH 17/20] use expect_snapshot for label type error test --- tests/testthat/_snaps/tbl_ancova.md | 9 +++++++++ tests/testthat/test-tbl_ancova.R | 5 +++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index a34085e2..5e9d9bdb 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -45,6 +45,15 @@ 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 +# tbl_ancova() errors on non-string label + + Code + tbl_ancova(data = df_ancova, formula = CHG ~ TRTA + BASE, by = TRTA, ref_group = "Placebo", + label = 123) + Condition + Error in `tbl_ancova()`: + ! The `label` argument must be a string, not a number. + # tbl_ancova() works with Dunnett adjustment Code diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index 0f0bbca4..e13d5ce4 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -125,14 +125,15 @@ test_that("tbl_ancova() works with custom label", { }) test_that("tbl_ancova() errors on non-string label", { - expect_error( + expect_snapshot( tbl_ancova( data = df_ancova, formula = CHG ~ TRTA + BASE, by = TRTA, ref_group = "Placebo", label = 123 - ) + ), + error = TRUE ) }) From d88dc159e84df57b1584dbaf4c7bec19313cb3d1 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 11 May 2026 11:14:01 +0200 Subject: [PATCH 18/20] fixes --- inst/WORDLIST | 2 +- tests/testthat/_snaps/tbl_ancova.md | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index 38040dfb..2e94b4b5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -24,7 +24,6 @@ RStudio Recode Rua SOCs -Szczypi Tidyverse analyte breslow @@ -42,6 +41,7 @@ ggplot gtsummary harrington jitter +labelled lineplot lineplots modelling diff --git a/tests/testthat/_snaps/tbl_ancova.md b/tests/testthat/_snaps/tbl_ancova.md index 5e9d9bdb..0e86e37f 100644 --- a/tests/testthat/_snaps/tbl_ancova.md +++ b/tests/testthat/_snaps/tbl_ancova.md @@ -8,7 +8,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() works with denominator @@ -21,7 +21,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on invalid ref_group @@ -42,7 +42,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 + 5 95% CI for Difference in Adjusted Means -4.23, 1.71 -4.35, 2.21 6 p-value 0.3563 0.4733 # tbl_ancova() errors on non-string label @@ -64,7 +64,7 @@ 2 n 5 4 3 3 Adjusted Mean 0.60 -0.66 -0.47 4 Difference in Adjusted Means -1.26 -1.07 - 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 + 5 95% CI for Difference in Adjusted Means -4.73, 2.22 -4.91, 2.77 6 p-value 0.5491 0.6839 # tbl_ancova() works without covariates @@ -77,6 +77,6 @@ 2 n 5 4 3 3 Adjusted Mean 0.20 -0.50 0.00 4 Difference in Adjusted Means -0.70 -0.20 - 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 + 5 95% CI for Difference in Adjusted Means -4.34, 2.94 -4.16, 3.76 6 p-value 0.6738 0.9116 From 2827a1461fbe571180286031efa13419f463d3da Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 26 May 2026 16:25:11 +0000 Subject: [PATCH 19/20] fix: align denominator headers with tbl_ard_summary column order tbl_ard_summary() assigns stat columns alphabetically by group level, but the denominator header logic ordered by factor levels (ref first). When the reference group was not alphabetically first (e.g. 'B: Placebo' vs 'A: Drug X'), headers were assigned to the wrong columns, making values appear under incorrect treatment arms. Fix reads the actual column-to-group mapping from the table styling instead of assuming factor level order. --- R/tbl_ancova.R | 22 +++++++++--- tests/testthat/test-tbl_ancova.R | 59 ++++++++++++++++++++++++++++---- 2 files changed, 70 insertions(+), 11 deletions(-) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index fda868b6..b33980e3 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -232,13 +232,25 @@ tbl_ancova <- function(data, if (!is.null(denominator)) { check_class(denominator, "data.frame") if (by %in% names(denominator)) { - header_n <- denominator |> - dplyr::count(!!rlang::sym(by), name = "n") |> - dplyr::arrange(factor(!!rlang::sym(by), levels = trt_levels)) + # read the column-to-group mapping that tbl_ard_summary assigned + col_map <- tbl$table_body |> + dplyr::select(dplyr::starts_with("stat_")) |> + names() + # extract group labels from existing headers (format: "**Group**") + existing_headers <- tbl$table_styling$header |> + dplyr::filter(.data$column %in% col_map) |> + dplyr::mutate(group = gsub("^\\*\\*|\\*\\*$", "", .data$label)) |> + dplyr::select("column", "group") + + denom_n <- denominator |> + dplyr::count(!!rlang::sym(by), name = "n") + + header_df <- existing_headers |> + dplyr::left_join(denom_n, by = stats::setNames(by, "group")) header_labels <- stats::setNames( - paste0("**", header_n[[by]], "**\n(N = ", header_n$n, ")"), - paste0("stat_", seq_len(nrow(header_n))) + paste0("**", header_df$group, "**\n(N = ", header_df$n, ")"), + header_df$column ) tbl <- tbl |> gtsummary::modify_header(!!!header_labels) diff --git a/tests/testthat/test-tbl_ancova.R b/tests/testthat/test-tbl_ancova.R index e13d5ce4..9e43ce1f 100644 --- a/tests/testthat/test-tbl_ancova.R +++ b/tests/testthat/test-tbl_ancova.R @@ -55,19 +55,66 @@ test_that("tbl_ancova() works with denominator", { # header Ns come from ADSL, not from the analysis data adsl_n <- cards::ADSL |> - dplyr::count(TRTA) |> - dplyr::arrange(factor(TRTA, levels = levels(df_ancova$TRTA))) + dplyr::count(TRTA) + headers <- tbl$table_styling$header |> + dplyr::filter(grepl("^stat_", .data$column)) for (i in seq_len(nrow(adsl_n))) { - header <- tbl$table_styling$header |> - dplyr::filter(.data$column == paste0("stat_", i)) |> - dplyr::pull("label") - expect_true(grepl(paste0("N = ", adsl_n$n[i]), header)) + matching_header <- headers$label[grepl(adsl_n$TRTA[i], headers$label, fixed = TRUE)] + expect_true( + length(matching_header) == 1 && grepl(paste0("N = ", adsl_n$n[i]), matching_header), + label = paste("Header for", adsl_n$TRTA[i], "should show N =", adsl_n$n[i]) + ) } expect_snapshot(as.data.frame(tbl)) }) +test_that("tbl_ancova() denominator headers align when ref_group is not alphabetically first", { + withr::local_options(list(width = 200)) + + # Arms where the reference group ("B: Placebo") sorts after "A: Drug X" + df_alpha <- df_ancova |> + dplyr::mutate(ARM = dplyr::case_when( + TRTA == "Placebo" ~ "B: Placebo", + TRTA == "Xanomeline High Dose" ~ "A: Drug X", + TRTA == "Xanomeline Low Dose" ~ "C: Combination" + )) + adsl_alpha <- cards::ADSL |> + dplyr::mutate(ARM = dplyr::case_when( + TRTA == "Placebo" ~ "B: Placebo", + TRTA == "Xanomeline High Dose" ~ "A: Drug X", + TRTA == "Xanomeline Low Dose" ~ "C: Combination" + )) + + expect_silent( + tbl <- tbl_ancova( + data = df_alpha, + formula = CHG ~ ARM + BASE, + by = ARM, + ref_group = "B: Placebo", + denominator = adsl_alpha + ) + ) + + # verify each column header matches its data: + # the reference group column must show blank contrast rows + headers <- tbl$table_styling$header |> + dplyr::filter(grepl("^stat_", .data$column)) + ref_col <- headers$column[grepl("B: Placebo", headers$label)] + + diff_row <- tbl$table_body |> + dplyr::filter(.data$label == "Difference in Adjusted Means") + # reference column must be blank + + expect_equal(diff_row[[ref_col]], "") + # non-reference columns must have numeric values + non_ref_cols <- setdiff(headers$column, ref_col) + for (col in non_ref_cols) { + expect_false(diff_row[[col]] == "", label = paste("column", col, "should not be blank")) + } +}) + test_that("tbl_ancova() works with conf.level = 0.90", { withr::local_options(list(width = 200)) From fc1ce0fe30a44e09d36394e28af2891f53f63c51 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Tue, 26 May 2026 16:30:02 +0000 Subject: [PATCH 20/20] docs: add example showing custom column order via factor levels --- R/tbl_ancova.R | 12 ++++++++++++ man/tbl_ancova.Rd | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/R/tbl_ancova.R b/R/tbl_ancova.R index b33980e3..c50dd67d 100644 --- a/R/tbl_ancova.R +++ b/R/tbl_ancova.R @@ -93,6 +93,18 @@ #' adjust = "dunnett" #' ) #' +#' # Custom column order — set factor levels on the input data +#' cards::ADLB |> +#' dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> +#' dplyr::mutate(TRTA = factor(TRTA, levels = c( +#' "Placebo", "Xanomeline Low Dose", "Xanomeline High Dose" +#' ))) |> +#' tbl_ancova( +#' formula = CHG ~ TRTA + BASE, +#' by = TRTA, +#' ref_group = "Placebo" +#' ) +#' #' @export tbl_ancova <- function(data, formula, diff --git a/man/tbl_ancova.Rd b/man/tbl_ancova.Rd index f9afc62c..c76857e7 100644 --- a/man/tbl_ancova.Rd +++ b/man/tbl_ancova.Rd @@ -124,4 +124,16 @@ cards::ADLB |> adjust = "dunnett" ) +# Custom column order — set factor levels on the input data +cards::ADLB |> + dplyr::filter(PARAMCD == "SODIUM", AVISIT == "Week 8") |> + dplyr::mutate(TRTA = factor(TRTA, levels = c( + "Placebo", "Xanomeline Low Dose", "Xanomeline High Dose" + ))) |> + tbl_ancova( + formula = CHG ~ TRTA + BASE, + by = TRTA, + ref_group = "Placebo" + ) + }