Fix estimate_contrasts() error for multivariate models with many observations

NEWS.md

@@ -116,6 +116,11 @@
   x-axis, e.g. for predictions from intercept-only models, or for
   `estimate_prediction()` without the `by` argument.
 
+* Fixed an "invalid regular expression" error in `estimate_contrasts()` for
+  multivariate models (for example from *brms*) with many observations.
+  `estimate_contrasts()` now uses the names of the response variables, not
+  their observed values, to find the response in the contrast labels.
+
 * The `grid` argument of `visualisation_recipe()` and `plot()` now changes the
   facet grid of plots with four or more `by` variables. Before, these functions
   applied the `facet` argument to the facet grid instead. If `facet` was not

R/format.R

@@ -624,7 +624,11 @@ format.marginaleffects_contrasts <- function(
   # the response levels (e.g., factor level order), so that "Response1" and
   # "Response2" use a meaningful, consistent level order
   response <- .safe(insight::get_response(model, verbose = FALSE))
-  if (is.factor(response)) {
+  # for multivariate models, the response is a data frame or matrix, and the
+  # response levels are its column names, not the observed values
+  if (is.matrix(response) || is.data.frame(response)) {
+    response_levels <- colnames(response)
+  } else if (is.factor(response)) {
     response_levels <- levels(response)
   } else {
     response_levels <- unique(as.character(response))

tests/testthat/test-brms.R

@@ -87,6 +87,36 @@ test_that("estimate_means - brms, multivariate", {
 })
 
 
+test_that("estimate_contrasts - brms, multivariate, many observations", {
+  # the response values must not be used as response levels, else the
+  # regular expressions built from them grow too long and fail
+  set.seed(123)
+  d <- data.frame(
+    y1 = rnorm(600),
+    y2 = rnorm(600),
+    g = factor(sample(c("a", "b", "c"), 600, replace = TRUE))
+  )
+  m <- suppressWarnings(brms::brm(
+    brms::mvbind(y1, y2) ~ g,
+    data = d,
+    refresh = 0,
+    iter = 500,
+    chains = 1,
+    seed = 123
+  ))
+
+  out <- estimate_contrasts(m, "g", resp = "y1")
+  expect_identical(nrow(out), 3L)
+  expect_identical(as.character(out$Level1), c("b", "c", "c"))
+  expect_identical(as.character(out$Level2), c("a", "a", "b"))
+
+  out <- estimate_contrasts(m, "g")
+  expect_identical(nrow(out), 15L)
+  expect_true(all(c("Response1", "Response2") %in% colnames(out)))
+  expect_identical(levels(out$Response1), c("y1", "y2"))
+})
+
+
 test_that("estimate_means - brms, Wiener", {
   skip_if_not_installed("curl")
   skip_if_offline()