From 32d8f56456913e07943e5ca9299159d3a78a3b46 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 2 Oct 2026 05:18:23 +0000 Subject: [PATCH] Fix summarize_ancova() contrasts for arm levels with regex metacharacters (#1471) The reference arm level was pasted unescaped into a regular expression when extracting the treatment level from the emmeans contrast labels, so levels such as "Tirzepatide + Placebo" gave empty difference, CI and p-value cells. Escape it with a new internal escape_regex() helper. Also match the extracted level with or without the parentheses emmeans adds, instead of stripping a trailing ")" unconditionally, which dropped the contrast for treatment levels such as "ARM B (x)" (snapshot updated). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01VgDfDKtUjnHDRwMAo5HAdo --- NEWS.md | 3 +++ R/summarize_ancova.R | 5 ++-- R/utils.R | 11 ++++++++ man/escape_regex.Rd | 18 +++++++++++++ tests/testthat/_snaps/summarize_ancova.md | 18 ++++++------- tests/testthat/test-summarize_ancova.R | 31 +++++++++++++++++++++++ 6 files changed, 75 insertions(+), 11 deletions(-) create mode 100644 man/escape_regex.Rd diff --git a/NEWS.md b/NEWS.md index 5516a00a6e..02cc7d844e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,9 @@ both groups. (#1535) * `prop_cmh()` returns `NA` instead of `1` for the Sato p-value when the response has no variation. (#1535) +* Fixed `summarize_ancova()` returning empty difference, confidence interval and + p-value cells when arm levels contain regular expression metacharacters such as + `+`, `(` or `.`. (#1471) # tern 0.9.11 diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index db8e731404..788db1ce35 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -204,12 +204,13 @@ s_ancova <- function(df, ) contrast_lvls <- gsub( - "^\\(|\\)$", "", gsub(paste0(" - \\(*", .ref_group[[arm]][1], ".*"), "", sum_contrasts$contrast) + paste0(" - \\(*", escape_regex(.ref_group[[arm]][1]), ".*"), "", sum_contrasts$contrast ) if (!is.null(interaction_item)) { sum_contrasts_level <- sum_contrasts[grepl(sum_level, contrast_lvls, fixed = TRUE), ] } else { - sum_contrasts_level <- sum_contrasts[sum_level == contrast_lvls, ] + # emmeans wraps some levels in parentheses in the contrast labels. + sum_contrasts_level <- sum_contrasts[contrast_lvls %in% c(sum_level, paste0("(", sum_level, ")")), ] } if (interaction_y != FALSE) { sum_contrasts_level <- sum_contrasts_level[interaction_y, ] diff --git a/R/utils.R b/R/utils.R index f6a89ed01d..d592d1f5c2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -187,6 +187,17 @@ make_names <- function(nams) { gsub(".", "", x = orig, fixed = TRUE) } +#' Escape regular expression metacharacters +#' +#' @param x (`character`)\cr strings to be used literally inside a regular expression. +#' +#' @return A `character` `vector` where all regular expression metacharacters in `x` are escaped. +#' +#' @keywords internal +escape_regex <- function(x) { + gsub("([.\\\\|()[{}^$*+?]|\\])", "\\\\\\1", x) +} + #' Conversion of months to days #' #' @description `r lifecycle::badge("stable")` diff --git a/man/escape_regex.Rd b/man/escape_regex.Rd new file mode 100644 index 0000000000..5282bec607 --- /dev/null +++ b/man/escape_regex.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{escape_regex} +\alias{escape_regex} +\title{Escape regular expression metacharacters} +\usage{ +escape_regex(x) +} +\arguments{ +\item{x}{(\code{character})\cr strings to be used literally inside a regular expression.} +} +\value{ +A \code{character} \code{vector} where all regular expression metacharacters in \code{x} are escaped. +} +\description{ +Escape regular expression metacharacters +} +\keyword{internal} diff --git a/tests/testthat/_snaps/summarize_ancova.md b/tests/testthat/_snaps/summarize_ancova.md index 2f39e02ca7..498a740e77 100644 --- a/tests/testthat/_snaps/summarize_ancova.md +++ b/tests/testthat/_snaps/summarize_ancova.md @@ -139,15 +139,15 @@ Code res Output - ARM A ARM B (x) ARM C - (N=69) (N=73) (N=58) - —————————————————————————————————————————————————————————— - Unadjusted comparison - n 552 584 464 - Mean 0.01 0.01 -0.05 - Difference in Means 0.06 - 95% CI (-0.07, 0.19) - p-value 0.3442 + ARM A ARM B (x) ARM C + (N=69) (N=73) (N=58) + —————————————————————————————————————————————————————————————— + Unadjusted comparison + n 552 584 464 + Mean 0.01 0.01 -0.05 + Difference in Means 0.06 0.06 + 95% CI (-0.07, 0.19) (-0.06, 0.19) + p-value 0.3442 0.3186 --- diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index a86463476d..ab57015d0b 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -249,3 +249,34 @@ testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { testthat::expect_true(all(is.na(result$lsmean_diff_with_ci))) testthat::expect_length(result$lsmean_diff, 0) }) + +testthat::test_that("s_ancova works with regex metacharacters in arm levels", { + arm_lvls <- c("Tirzepatide + Placebo", "Tirzepatide", "Drug (1.5 mg)") + df <- iris + df$Species <- factor(df$Species, levels = levels(iris$Species), labels = arm_lvls) + variables <- list(arm = "Species", covariates = "Petal.Length") + emmeans_fit <- h_ancova(.var = "Sepal.Length", variables = variables, .df_row = df) + + for (ref in seq_along(arm_lvls)) { + expected <- summary( + emmeans::contrast(emmeans_fit, method = "trt.vs.ctrl", ref = ref), + infer = TRUE, + adjust = "none" + ) + for (trt in setdiff(seq_along(arm_lvls), ref)) { + result <- s_ancova( + df = df[df$Species == arm_lvls[trt], ], + .var = "Sepal.Length", + .df_row = df, + variables = variables, + .ref_group = df[df$Species == arm_lvls[ref], ], + .in_ref_col = FALSE, + conf_level = 0.95 + ) + exp_row <- expected[match(trt, setdiff(seq_along(arm_lvls), ref)), ] + testthat::expect_equal(result$lsmean_diff, exp_row$estimate, ignore_attr = TRUE) + testthat::expect_equal(result$lsmean_diff_ci, c(exp_row$lower.CL, exp_row$upper.CL), ignore_attr = TRUE) + testthat::expect_equal(result$pval, exp_row$p.value, ignore_attr = TRUE) + } + } +})