From 88960c335a5d5447177993e1802584e64f758829 Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 12:34:13 +0200 Subject: [PATCH 1/6] feat: add structured group columns to tidy_pool_obj() output (#51) Add placeholder group columns (group_var, group_level_1, group_level_2) to tidy_pool_obj() output. Placeholders default to NA for group_var, lsm_type/alt for group_level_1 (lsm/trt rows), and NA/ref for group_level_2 (lsm/trt rows). Task 2 will replace placeholders with real names when enrichment inputs present. --- R/tidiers.R | 21 ++++++++++- tests/testthat/test-tidiers.R | 69 ++++++++++++++++++++++++++++++++++- 2 files changed, 87 insertions(+), 3 deletions(-) diff --git a/R/tidiers.R b/R/tidiers.R index 4d5a96d..1bc5bbd 100644 --- a/R/tidiers.R +++ b/R/tidiers.R @@ -169,6 +169,22 @@ tidy_pool_obj <- function(pool_obj) { ) ) + # Structured group columns (issue #51). Placeholders by default; real + # group names when both `vars` and `data` are supplied (see below). + df <- df |> + dplyr::mutate( + group_var = NA_character_, + group_level_1 = dplyr::case_when( + parameter_type == "lsm" ~ lsm_type, + parameter_type == "trt" ~ "alt", + TRUE ~ NA_character_ + ), + group_level_2 = dplyr::case_when( + parameter_type == "trt" ~ "ref", + TRUE ~ NA_character_ + ) + ) + # Select and arrange the columns for the publication-ready table df <- df |> dplyr::select( @@ -181,7 +197,10 @@ tidy_pool_obj <- function(pool_obj) { se, lci, uci, - pval + pval, + group_var, + group_level_1, + group_level_2 ) return(df) diff --git a/tests/testthat/test-tidiers.R b/tests/testthat/test-tidiers.R index 998290f..2208b44 100644 --- a/tests/testthat/test-tidiers.R +++ b/tests/testthat/test-tidiers.R @@ -61,7 +61,10 @@ test_that("positive test tidy_pool_obj", { "se", "lci", "uci", - "pval" + "pval", + "group_var", + "group_level_1", + "group_level_2" ) ) @@ -78,7 +81,10 @@ test_that("positive test tidy_pool_obj", { se = "numeric", lci = "numeric", uci = "numeric", - pval = "numeric" + pval = "numeric", + group_var = "character", + group_level_1 = "character", + group_level_2 = "character" ) ) @@ -456,3 +462,62 @@ test_that("tidy_pool_obj errors with informative message for non-pool input", { class = "rbmiUtils_error" ) }) + + +# ---- Shared fixture for group-column tests (small, fast) ---- +make_pool_fixture <- function() { + data("ADMI", package = "rbmiUtils") + ADMI$TRT <- factor(ADMI$TRT, levels = c("Placebo", "Drug A")) + ADMI$USUBJID <- factor(ADMI$USUBJID) + ADMI$AVISIT <- factor(ADMI$AVISIT) + ADMI <- ADMI[ADMI$IMPID %in% 1:5, ] + + vars <- rbmi::set_vars( + subjid = "USUBJID", + visit = "AVISIT", + group = "TRT", + outcome = "CHG", + covariates = c("BASE", "STRATA", "REGION") + ) + method <- rbmi::method_bayes( + n_samples = 5, + control = rbmi::control_bayes(warmup = 200, thin = 5) + ) + ana <- analyse_mi_data(data = ADMI, vars = vars, method = method, fun = rbmi::ancova) + list(pool = rbmi::pool(ana), vars = vars, data = ADMI) +} +fixture <- make_pool_fixture() + +test_that("tidy_pool_obj adds placeholder group columns by default", { + tidy_df <- tidy_pool_obj(fixture$pool) + + expect_true(all(c("group_var", "group_level_1", "group_level_2") %in% names(tidy_df))) + expect_true(all(is.na(tidy_df$group_var))) + + lsm_rows <- tidy_df[tidy_df$parameter_type == "lsm", ] + expect_identical(lsm_rows$group_level_1, lsm_rows$lsm_type) + expect_true(all(is.na(lsm_rows$group_level_2))) + + trt_rows <- tidy_df[tidy_df$parameter_type == "trt", ] + expect_true(all(trt_rows$group_level_1 == "alt")) + expect_true(all(trt_rows$group_level_2 == "ref")) +}) + +test_that("legacy columns are byte-identical to pre-change output by default", { + tidy_df <- tidy_pool_obj(fixture$pool) + + # Reconstruct the legacy expectations directly from the pool object + expect_identical(tidy_df$parameter, names(fixture$pool$pars)) + expect_identical( + tidy_df$est, + unname(vapply(fixture$pool$pars, function(p) p$est, numeric(1))) + ) + # Legacy description wording unchanged on the default path + expect_true(all( + tidy_df$description[tidy_df$parameter_type == "trt"] == "Treatment Comparison" + )) + expect_true(all(grepl( + "^Least Squares Mean for (Reference|Alternative)", + tidy_df$description[tidy_df$parameter_type == "lsm"] + ))) +}) From 922cab179db9789cdf0856f86f431a940ed61df8 Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 12:42:57 +0200 Subject: [PATCH 2/6] feat: enrich tidy_pool_obj() group columns from vars and data (#51) Add optional vars/data arguments to tidy_pool_obj() that map ref/alt placeholders in group_level_1/2 to real group names (and group_var to the real column name) when exactly two group levels are present. Descriptions are upgraded accordingly. Falls back to placeholders with a cli_warn() when vars/data are missing, incomplete, or the group variable does not have exactly two levels. Uses as.factor() rather than factor() when counting group levels so unused factor levels are not silently dropped (factor() on an already-factor column re-derives levels from observed values only). --- R/tidiers.R | 54 +++++++++++++++++++++++++++++- tests/testthat/test-tidiers.R | 63 +++++++++++++++++++++++++++++++++++ 2 files changed, 116 insertions(+), 1 deletion(-) diff --git a/R/tidiers.R b/R/tidiers.R index 1bc5bbd..7b68127 100644 --- a/R/tidiers.R +++ b/R/tidiers.R @@ -86,7 +86,7 @@ #' print(tidy_df) #' #' @export -tidy_pool_obj <- function(pool_obj) { +tidy_pool_obj <- function(pool_obj, vars = NULL, data = NULL) { # --- Input validation --- if (!inherits(pool_obj, "pool")) { @@ -96,6 +96,31 @@ tidy_pool_obj <- function(pool_obj) { ) } + # --- Resolve optional group enrichment (issue #51) --- + # Both vars and data are needed to map ref/alt placeholders to real + # group names. Reference = first factor level (rbmi convention). + group_info <- NULL + if (!is.null(vars) || !is.null(data)) { + if (is.null(vars) || is.null(data)) { + cli::cli_warn( + "{.arg vars} and {.arg data} must both be supplied for group-name enrichment. Returning placeholder group columns." + ) + } else if (is.null(vars$group) || !vars$group %in% names(data)) { + cli::cli_warn( + "{.arg vars} must contain a {.field group} element naming a column in {.arg data}. Returning placeholder group columns." + ) + } else { + lvls <- levels(as.factor(data[[vars$group]])) + if (length(lvls) != 2) { + cli::cli_warn( + "Group variable {.field {vars$group}} must have exactly two levels for enrichment (found {length(lvls)}). Returning placeholder group columns." + ) + } else { + group_info <- list(var = vars$group, ref = lvls[1], alt = lvls[2]) + } + } + } + # Convert pool_obj to tibble df <- dplyr::as_tibble(pool_obj) @@ -185,6 +210,33 @@ tidy_pool_obj <- function(pool_obj) { ) ) + if (!is.null(group_info)) { + map_level <- function(x) { + dplyr::case_when( + x == "ref" ~ group_info$ref, + x == "alt" ~ group_info$alt, + TRUE ~ x + ) + } + df <- df |> + dplyr::mutate( + group_var = group_info$var, + group_level_1 = map_level(group_level_1), + group_level_2 = map_level(group_level_2), + description = dplyr::case_when( + parameter_type == "trt" & !is.na(visit) ~ + paste0("Difference: ", group_level_1, " vs ", group_level_2, " at ", visit), + parameter_type == "trt" ~ + paste0("Difference: ", group_level_1, " vs ", group_level_2), + parameter_type == "lsm" & !is.na(group_level_1) & !is.na(visit) ~ + paste("Least Squares Mean for", group_level_1, "at", visit), + parameter_type == "lsm" & !is.na(group_level_1) ~ + paste("Least Squares Mean for", group_level_1), + TRUE ~ description + ) + ) + } + # Select and arrange the columns for the publication-ready table df <- df |> dplyr::select( diff --git a/tests/testthat/test-tidiers.R b/tests/testthat/test-tidiers.R index 2208b44..47ad3f6 100644 --- a/tests/testthat/test-tidiers.R +++ b/tests/testthat/test-tidiers.R @@ -521,3 +521,66 @@ test_that("legacy columns are byte-identical to pre-change output by default", { tidy_df$description[tidy_df$parameter_type == "lsm"] ))) }) + +test_that("tidy_pool_obj enriches group columns from vars and data", { + tidy_df <- tidy_pool_obj(fixture$pool, vars = fixture$vars, data = fixture$data) + + expect_true(all(tidy_df$group_var == "TRT")) + + lsm_ref <- tidy_df[tidy_df$parameter_type == "lsm" & tidy_df$lsm_type == "ref", ] + lsm_alt <- tidy_df[tidy_df$parameter_type == "lsm" & tidy_df$lsm_type == "alt", ] + expect_true(all(lsm_ref$group_level_1 == "Placebo")) + expect_true(all(lsm_alt$group_level_1 == "Drug A")) + expect_true(all(is.na(lsm_ref$group_level_2))) + + trt_rows <- tidy_df[tidy_df$parameter_type == "trt", ] + expect_true(all(trt_rows$group_level_1 == "Drug A")) + expect_true(all(trt_rows$group_level_2 == "Placebo")) +}) + +test_that("descriptions upgrade to real names when enriched", { + tidy_df <- tidy_pool_obj(fixture$pool, vars = fixture$vars, data = fixture$data) + + trt_rows <- tidy_df[tidy_df$parameter_type == "trt", ] + expect_true(all(grepl("^Difference: Drug A vs Placebo at ", trt_rows$description))) + + lsm_rows <- tidy_df[tidy_df$parameter_type == "lsm", ] + expect_true(all(grepl("^Least Squares Mean for (Placebo|Drug A) at ", lsm_rows$description))) + + # Legacy columns other than description are unaffected by enrichment + base_df <- tidy_pool_obj(fixture$pool) + expect_identical(tidy_df$est, base_df$est) + expect_identical(tidy_df$parameter, base_df$parameter) + expect_identical(tidy_df$lsm_type, base_df$lsm_type) +}) + +test_that("supplying only one of vars/data warns and returns placeholders", { + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = fixture$vars), + "both" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) + +test_that("group variable without exactly two levels warns and returns placeholders", { + dat3 <- fixture$data + dat3$TRT <- factor( + as.character(dat3$TRT), + levels = c("Placebo", "Drug A", "Drug B") + ) + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = fixture$vars, data = dat3), + "two" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) + +test_that("vars missing the group element warns and returns placeholders", { + vars_nogroup <- fixture$vars + vars_nogroup$group <- NULL + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = vars_nogroup, data = fixture$data), + "group" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) From b29bd79757040ba3187811804536369d0a8a6b10 Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 12:56:30 +0200 Subject: [PATCH 3/6] docs: document tidy_pool_obj() group columns, add NEWS (#51) --- NEWS.md | 7 +++++++ R/tidiers.R | 17 +++++++++++++++++ inst/WORDLIST | 2 ++ man/tidy_pool_obj.Rd | 21 ++++++++++++++++++++- 4 files changed, 46 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index a909227..707c558 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # rbmiUtils (development version) +## New features + +* `tidy_pool_obj()` gains structured group columns (`group_var`, + `group_level_1`, `group_level_2`) and optional `vars`/`data` arguments + that replace the generic `ref`/`alt` labels with real treatment-group + names in both the group columns and the `description` text (#51). + # rbmiUtils 0.3.0 ## CRAN Release diff --git a/R/tidiers.R b/R/tidiers.R index 7b68127..9ffc69a 100644 --- a/R/tidiers.R +++ b/R/tidiers.R @@ -7,6 +7,13 @@ #' #' @param pool_obj A pooled analysis object of class `pool`, typically obtained from [rbmi::pool()] #' after calling [analyse_mi_data()]. +#' @param vars Optional. The `vars` object (from [rbmi::set_vars()]) used in +#' the analysis. Together with `data`, enables mapping of the `ref`/`alt` +#' placeholders in `group_level_1`/`group_level_2` to real group names. +#' @param data Optional. The analysis dataset containing the group variable +#' named by `vars$group`. The first factor level is taken as the reference +#' (matching rbmi convention). Enrichment requires exactly two levels; +#' otherwise placeholders are returned with a warning. #' #' @return A tibble containing the processed pooled analysis results with the following columns: #' \describe{ @@ -20,6 +27,13 @@ #' \item{lci}{Lower confidence interval} #' \item{uci}{Upper confidence interval} #' \item{pval}{P-value} +#' \item{group_var}{Name of the treatment/group variable (`NA` unless `vars` +#' and `data` are supplied)} +#' \item{group_level_1}{For LSM rows the group level of the estimate; for +#' comparison rows the comparator level. `ref`/`alt` placeholders unless +#' enriched} +#' \item{group_level_2}{For comparison rows the reference level; `NA` for +#' LSM rows} #' } #' #' @details The function dynamically processes the `parameter` column by separating it into @@ -85,6 +99,9 @@ #' # Print tidy data frames #' print(tidy_df) #' +#' # With vars and data, group columns carry real treatment names +#' tidy_df2 <- tidy_pool_obj(pool_obj_ancova, vars = vars, data = ADMI) +#' #' @export tidy_pool_obj <- function(pool_obj, vars = NULL, data = NULL) { diff --git a/inst/WORDLIST b/inst/WORDLIST index 64285e6..bdad526 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -37,6 +37,7 @@ characterises cli colour colourblind +comparator condmean conf customisation @@ -71,6 +72,7 @@ rbmi rbmi's recognised responder +responders rhat se standardised diff --git a/man/tidy_pool_obj.Rd b/man/tidy_pool_obj.Rd index 3705e86..8fb656c 100644 --- a/man/tidy_pool_obj.Rd +++ b/man/tidy_pool_obj.Rd @@ -4,11 +4,20 @@ \alias{tidy_pool_obj} \title{Tidy and Annotate a Pooled Object for Publication} \usage{ -tidy_pool_obj(pool_obj) +tidy_pool_obj(pool_obj, vars = NULL, data = NULL) } \arguments{ \item{pool_obj}{A pooled analysis object of class \code{pool}, typically obtained from \code{\link[rbmi:pool]{rbmi::pool()}} after calling \code{\link[=analyse_mi_data]{analyse_mi_data()}}.} + +\item{vars}{Optional. The \code{vars} object (from \code{\link[rbmi:set_vars]{rbmi::set_vars()}}) used in +the analysis. Together with \code{data}, enables mapping of the \code{ref}/\code{alt} +placeholders in \code{group_level_1}/\code{group_level_2} to real group names.} + +\item{data}{Optional. The analysis dataset containing the group variable +named by \code{vars$group}. The first factor level is taken as the reference +(matching rbmi convention). Enrichment requires exactly two levels; +otherwise placeholders are returned with a warning.} } \value{ A tibble containing the processed pooled analysis results with the following columns: @@ -23,6 +32,13 @@ A tibble containing the processed pooled analysis results with the following col \item{lci}{Lower confidence interval} \item{uci}{Upper confidence interval} \item{pval}{P-value} +\item{group_var}{Name of the treatment/group variable (\code{NA} unless \code{vars} +and \code{data} are supplied)} +\item{group_level_1}{For LSM rows the group level of the estimate; for +comparison rows the comparator level. \code{ref}/\code{alt} placeholders unless +enriched} +\item{group_level_2}{For comparison rows the reference level; \code{NA} for +LSM rows} } } \description{ @@ -92,6 +108,9 @@ tidy_df <- tidy_pool_obj(pool_obj_ancova) # Print tidy data frames print(tidy_df) +# With vars and data, group columns carry real treatment names +tidy_df2 <- tidy_pool_obj(pool_obj_ancova, vars = vars, data = ADMI) + } \seealso{ \itemize{ From 82e79a698539348b9794dd847a0f89c801dc8f56 Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 13:01:43 +0200 Subject: [PATCH 4/6] fix: register NSE column bindings for R CMD check (#51) --- R/rbmiUtils-package.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/rbmiUtils-package.R b/R/rbmiUtils-package.R index 667b356..6bdb0cb 100644 --- a/R/rbmiUtils-package.R +++ b/R/rbmiUtils-package.R @@ -5,6 +5,9 @@ utils::globalVariables( "IMPID", "description", "est", + "group_level_1", + "group_level_2", + "group_var", "lci", "lsm_type", "n_miss", From 0a1abf4f97efdd3f7dcbd1ad2b25b9f9b32ec987 Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 13:12:01 +0200 Subject: [PATCH 5/6] fix: harden tidy_pool_obj() group enrichment guards (#51) - Warn and fall back to placeholder group columns when the group variable is not a factor, instead of silently deriving ref/alt via alphabetical sort on a coerced character column (could reverse treatment labels). - Make the vars$group validity guard robust to NULL, non-character, and length != 1 values so malformed input warns instead of erroring. - Add regression tests for both fixes and for two previously-untested guard arms (vars$group absent from data; data supplied without vars). - Fix NEWS.md heading case and @return wording for group_var to match repo convention; regenerate man/tidy_pool_obj.Rd. --- NEWS.md | 2 +- R/tidiers.R | 10 ++++++--- man/tidy_pool_obj.Rd | 2 +- tests/testthat/test-tidiers.R | 38 +++++++++++++++++++++++++++++++++++ 4 files changed, 47 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 707c558..9ae4dd1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # rbmiUtils (development version) -## New features +## New Features * `tidy_pool_obj()` gains structured group columns (`group_var`, `group_level_1`, `group_level_2`) and optional `vars`/`data` arguments diff --git a/R/tidiers.R b/R/tidiers.R index 9ffc69a..8761929 100644 --- a/R/tidiers.R +++ b/R/tidiers.R @@ -28,7 +28,7 @@ #' \item{uci}{Upper confidence interval} #' \item{pval}{P-value} #' \item{group_var}{Name of the treatment/group variable (`NA` unless `vars` -#' and `data` are supplied)} +#' and `data` are supplied and valid)} #' \item{group_level_1}{For LSM rows the group level of the estimate; for #' comparison rows the comparator level. `ref`/`alt` placeholders unless #' enriched} @@ -122,12 +122,16 @@ tidy_pool_obj <- function(pool_obj, vars = NULL, data = NULL) { cli::cli_warn( "{.arg vars} and {.arg data} must both be supplied for group-name enrichment. Returning placeholder group columns." ) - } else if (is.null(vars$group) || !vars$group %in% names(data)) { + } else if (!is.character(vars$group) || length(vars$group) != 1 || !vars$group %in% names(data)) { cli::cli_warn( "{.arg vars} must contain a {.field group} element naming a column in {.arg data}. Returning placeholder group columns." ) + } else if (!is.factor(data[[vars$group]])) { + cli::cli_warn( + "{.field {vars$group}} must be a factor whose first level is the reference group; deriving levels alphabetically from a non-factor column may not match the analysis. Returning placeholder group columns." + ) } else { - lvls <- levels(as.factor(data[[vars$group]])) + lvls <- levels(data[[vars$group]]) if (length(lvls) != 2) { cli::cli_warn( "Group variable {.field {vars$group}} must have exactly two levels for enrichment (found {length(lvls)}). Returning placeholder group columns." diff --git a/man/tidy_pool_obj.Rd b/man/tidy_pool_obj.Rd index 8fb656c..bdc37be 100644 --- a/man/tidy_pool_obj.Rd +++ b/man/tidy_pool_obj.Rd @@ -33,7 +33,7 @@ A tibble containing the processed pooled analysis results with the following col \item{uci}{Upper confidence interval} \item{pval}{P-value} \item{group_var}{Name of the treatment/group variable (\code{NA} unless \code{vars} -and \code{data} are supplied)} +and \code{data} are supplied and valid)} \item{group_level_1}{For LSM rows the group level of the estimate; for comparison rows the comparator level. \code{ref}/\code{alt} placeholders unless enriched} diff --git a/tests/testthat/test-tidiers.R b/tests/testthat/test-tidiers.R index 47ad3f6..8e9bcf1 100644 --- a/tests/testthat/test-tidiers.R +++ b/tests/testthat/test-tidiers.R @@ -584,3 +584,41 @@ test_that("vars missing the group element warns and returns placeholders", { ) expect_true(all(is.na(tidy_df$group_var))) }) + +test_that("vars$group naming a column absent from data warns and returns placeholders", { + vars_bad <- fixture$vars + vars_bad$group <- "NOT_A_COLUMN" + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = vars_bad, data = fixture$data), + "group" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) + +test_that("vars$group of length != 1 warns and returns placeholders", { + vars_bad <- fixture$vars + vars_bad$group <- c("TRT", "AVISIT") + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = vars_bad, data = fixture$data), + "group" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) + +test_that("supplying only data (no vars) warns and returns placeholders", { + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, data = fixture$data), + "both" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) + +test_that("non-factor group column warns and returns placeholders", { + dat_char <- fixture$data + dat_char$TRT <- as.character(dat_char$TRT) + expect_warning( + tidy_df <- tidy_pool_obj(fixture$pool, vars = fixture$vars, data = dat_char), + "factor" + ) + expect_true(all(is.na(tidy_df$group_var))) +}) From 8274d1145ef3bf223ca5d8b329a66fd84cb2371f Mon Sep 17 00:00:00 2001 From: bailliem Date: Thu, 30 Jul 2026 13:13:39 +0200 Subject: [PATCH 6/6] chore: bump RoxygenNote to 7.3.3 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 15f4ca8..c6313fc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,7 @@ Description: Provides utility functions that extend the capabilities of the License: GPL (>= 3) Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Suggests: cards, ggplot2,