Fix extract_strata() stripping parentheses from strata level labels

The greedy regex gsub('.*\\(', ...) in extract_strata() was intended
to strip strata() wrappers but also destroyed parentheses in factor
level values, e.g. 'Drug (B)' became 'B'.

Replace with targeted patterns that only strip the strata() wrapper.

Fixes ddsjoberg/gtsummary#2388

Co-authored-by: Ona <no-reply@ona.com>

Author: ddsjoberg

NEWS.md

@@ -1,5 +1,7 @@
 # cardx 0.3.2.9001
 
+* Fixed bug in `extract_strata()` where parentheses in strata level labels were incorrectly stripped, e.g. `"Drug (B)"` was truncated to `"B"`. (#2388)
+
 * Added fix to ensure `as_card` does not error after update to `cards`
 
 # cardx 0.3.2

R/ard_survival_survfit.R

@@ -357,14 +357,22 @@ ard_survival_survfit.data.frame <- function(x, y,
 
 # process stratifying variables
 extract_strata <- function(x, df_stat) {
-  x_terms <- attr(stats::terms(stats::as.formula(x$call$formula)), "term.labels")
-  x_terms <- gsub(".*\\(", "", gsub("\\)", "", x_terms))
+  x_terms_raw <- attr(stats::terms(stats::as.formula(x$call$formula)), "term.labels")
+  # strip function wrappers like strata(), factor() from term labels,
+  # extracting only the first argument (the variable name)
+  x_terms <- sub("^\\w+\\(\\s*([^,)]+).*\\)$", "\\1", x_terms_raw)
   if (length(x_terms) > 0L) {
+    # build split pattern using the raw term labels (as they appear in strata strings)
+    # escape each term for regex, then join with | alternation
+    escaped_terms <- vapply(x_terms_raw, function(t) {
+      paste0("(^|, )", gsub("([()|.^$*+?{}\\[\\]\\\\])", "\\\\\\1", t, perl = TRUE), "=")
+    }, character(1), USE.NAMES = FALSE)
+    split_pattern <- paste(escaped_terms, collapse = "|")
+
     strata_lvls <- data.frame()
 
     for (i in df_stat[["strata"]]) {
-      i <- gsub(".*\\(", "", gsub("\\)", "", i))
-      terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[1]]
+      terms_str <- strsplit(i, split_pattern)[[1]]
       s_lvl <- terms_str[nchar(terms_str) > 0]
       strata_lvls <- rbind(strata_lvls, s_lvl)
     }

tests/testthat/test-ard_survival_survfit.R

@@ -210,6 +210,18 @@ test_that("ard_survival_survfit() works with '=' in strata variable level labels
   )
 })
 
+test_that("ard_survival_survfit() preserves parentheses in strata level labels", {
+  lung2 <- survival::lung %>%
+    dplyr::mutate(sex_lbl = factor(ifelse(sex == 1, "Male (M)", "Female (F)")))
+
+  res <- survival::survfit(survival::Surv(time, status) ~ sex_lbl, data = lung2) |>
+    ard_survival_survfit(times = 100)
+
+  levels <- unique(unlist(res$group1_level))
+  levels <- levels[!is.na(levels)]
+  expect_setequal(as.character(levels), c("Female (F)", "Male (M)"))
+})
+
 test_that("ard_survival_survfit() follows ard structure", {
   expect_silent(
     survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>