Fix summarize_ancova() contrasts for arm levels with regex metacharacters (#1471)

NEWS.md

@@ -14,6 +14,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
 

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, ]

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")`

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             
 
 ---
 

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)
+    }
+  }
+})