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

@@ -358,12 +358,14 @@ 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))
+  # strip strata() wrapper only, preserving parentheses in variable names
+  x_terms <- sub("^strata\\(\\s*([^,)]+).*\\)$", "\\1", x_terms)
   if (length(x_terms) > 0L) {
     strata_lvls <- data.frame()
 
     for (i in df_stat[["strata"]]) {
-      i <- gsub(".*\\(", "", gsub("\\)", "", i))
+      # strip strata() wrapper from strata strings if present
+      i <- gsub("strata\\(([^)]+)\\)", "\\1", i)
       terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[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) |>