Fix extract_strata() stripping parentheses from strata level labels

NEWS.md

@@ -1,5 +1,7 @@
 # cardx 0.3.2.9003
 
+* 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`
 
 * Bug fix in `ard_car_vif()` where non-syntactic variable names (e.g. those containing spaces) were returned with backticks in the `variable` column. Since `gtsummary::tbl_regression()` stores variable names without backticks, this mismatch resulted in empty VIF columns in `gtsummary::add_vif()`. (#335, @NourEdinDarwish)

R/ard_survival_survfit.R

@@ -357,26 +357,49 @@ 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))
+  # Safe Subsetting: protect downstream engines from empty datasets
+  if (nrow(df_stat) == 0) {
+    cli::cli_warn("Dataset {.arg df_stat} is empty.")
+    return(df_stat)
+  }
+
+  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) {
-    strata_lvls <- data.frame()
+    # 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 = "|")
+
+    # Factor Safety: explicit coercion prevents hidden evaluation overhead
+    strata_vec <- as.character(df_stat[["strata"]])
+
+    # Replace inefficient rbind() loop with vectorized lapply
+    strata_list <- lapply(strata_vec, function(i) {
+      terms_str <- strsplit(i, split_pattern)[[1]]
+      terms_str[nchar(terms_str) > 0]
+    })
+
+    # Efficiently construct the data frame in one go
+    strata_lvls <- as.data.frame(do.call(rbind, strata_list))
 
-    for (i in df_stat[["strata"]]) {
-      i <- gsub(".*\\(", "", gsub("\\)", "", 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)
-    }
     if (nrow(strata_lvls) > 0) {
       strata_lvls <- cbind(strata_lvls, t(x_terms))
       names(strata_lvls) <- c(
         t(sapply(seq_along(x_terms), function(i) c(paste0("group", i, "_level"), paste0("group", i))))
       )
-      df_stat <- cbind(df_stat, strata_lvls) %>%
-        dplyr::select(-"strata")
+
+      # Bind new columns and drop the old strata column
+      df_stat <- cbind(df_stat, strata_lvls) |>
+	      dplyr::select(-"strata")
     }
   }
+
   df_stat
 }
 

tests/testthat/_snaps/ard_survival_survfit.md

@@ -370,6 +370,10 @@
     Message
       i 4 more variables: context, fmt_fun, warning, error
 
+# extract_strata() returns safely and warns on 0-row datasets
+
+    Dataset `df_stat` is empty.
+
 # ard_survival_survfit() extends to times outside range
 
     Code

tests/testthat/test-ard_survival_survfit.R

@@ -210,6 +210,28 @@ 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("extract_strata() returns safely and warns on 0-row datasets", {
+  mock_fit <- list(call = list(formula = ~ strata(TRT01A)))
+  mock_df <- data.frame(time = numeric(0), strata = character(0))
+
+  expect_snapshot_warning(
+    res <- extract_strata(mock_fit, mock_df) 
+  )
+  expect_equal(nrow(res), 0)
+})
+
 test_that("ard_survival_survfit() follows ard structure", {
   expect_silent(
     survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |>