brms::gr() is not supported (#832)

* `brms::gr()` is not supported
Fixes #831

* see if this works

* fix

* lintr

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.19.6.6
+Version: 0.19.6.7
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -4,6 +4,9 @@
 
 * Support for objects of class `ggcomparisons` from `ggeffects::hypothesis_test()`.
 
+* `brms::gr()` is now supported, meaning that functions like `get_data()` or
+  `find_predictors()` now also work for models with group-specific random effects.
+
 ## Changes to functions
 
 * `get_varcov()` for models of class `pgmm` (package *plm*) now also supported

R/clean_names.R

@@ -121,7 +121,7 @@ clean_names.character <- function(x, include_names = FALSE, ...) {
     "asis", "matrx", "pol", "strata", "strat", "scale", "scored", "interaction",
     "sqrt", "sin", "cos", "tan", "acos", "asin", "atan", "atan2", "exp", "lsp",
     "rcs", "pb", "lo", "bs", "ns", "mSpline", "bSpline", "t2", "te", "ti", "tt", # need to be fixed first "mmc", "mm",
-    "mi", "mo", "gp", "s", "I", "relevel(as.factor", "relevel"
+    "mi", "mo", "gp", "s", "I", "gr", "relevel(as.factor", "relevel"
   )
 
   # sometimes needed for panelr models, where we need to preserve "lag()"

R/find_formula.R

@@ -194,13 +194,7 @@ find_formula.gamlss <- function(x, verbose = TRUE, ...) {
       } else if (grepl("random\\((.*)\\)", safe_deparse(f.cond))) {
         f.cond <- safe_deparse(f.cond)
         # remove namespace prefixes
-        if (grepl("::", f.cond, fixed = TRUE)) {
-          # Here's a regular expression pattern in R that removes any word
-          # followed by two colons from a string: This pattern matches a word
-          # boundary (\\b), followed by one or more word characters (\\w+),
-          # followed by two colons (::)
-          f.cond <- gsub("\\b\\w+::", "\\2", f.cond)
-        }
+        f.cond <- .remove_namespace_from_string(f.cond)
         re <- gsub("(.*)random\\((.*)\\)", "\\2", f.cond)
         f.random <- stats::as.formula(paste0("~1|", re))
         f.cond <- stats::update.formula(

R/find_predictors.R

@@ -296,15 +296,8 @@ find_predictors.afex_aov <- function(x,
     # for survival models, separate out strata element
     if (inherits(x, "coxph")) {
       f_cond <- safe_deparse(f[["conditional"]])
-
       # remove namespace prefixes
-      if (grepl("::", f_cond, fixed = TRUE)) {
-        # Here's a regular expression pattern in R that removes any word
-        # followed by two colons from a string: This pattern matches a word
-        # boundary (\\b), followed by one or more word characters (\\w+),
-        # followed by two colons (::)
-        f_cond <- gsub("\\b\\w+::", "\\2", f_cond)
-      }
+      f_cond <- .remove_namespace_from_string(f_cond)
 
       if (grepl("strata(", f_cond, fixed = TRUE)) {
         # create regular expressions to find strata terms

R/find_random.R

@@ -87,12 +87,12 @@ find_random.afex_aov <- function(x, split_nested = FALSE, flatten = FALSE) {
       r1 <- unique(unlist(lapply(
         f$random,
         .get_model_random,
-        split_nested,
-        model = x
+        model = x,
+        split_nested = split_nested
       ), use.names = FALSE))
     } else {
       r1 <- unique(unlist(
-        .get_model_random(f$random, split_nested, x),
+        .get_model_random(f$random, model = x, split_nested),
         use.names = FALSE
       ))
     }
@@ -104,11 +104,11 @@ find_random.afex_aov <- function(x, split_nested = FALSE, flatten = FALSE) {
   if (object_has_names(f, "zero_inflated_random")) {
     if (is.list(f$zero_inflated_random)) {
       r2 <- unique(unlist(
-        lapply(f$zero_inflated_random, .get_model_random, split_nested, model = x),
+        lapply(f$zero_inflated_random, .get_model_random, model = x, split_nested = split_nested),
         use.names = FALSE
       ))
     } else {
-      r2 <- unique(.get_model_random(f$zero_inflated_random, split_nested, x))
+      r2 <- unique(.get_model_random(f$zero_inflated_random, model = x, split_nested))
     }
   } else {
     r2 <- NULL

R/helper_functions.R

@@ -21,7 +21,6 @@
 }
 
 
-
 # is string empty?
 .is_empty_string <- function(x) {
   x <- x[!is.na(x)]
@@ -39,6 +38,19 @@
 }
 
 
+.remove_namespace_from_string <- function(x) {
+  # remove namespace prefixes
+  if (grepl("::", x, fixed = TRUE)) {
+    # Here's a regular expression pattern in R that removes any word
+    # followed by two colons from a string: This pattern matches a word
+    # boundary (\\b), followed by one or more word characters (\\w+),
+    # followed by two colons (::)
+    x <- gsub("\\b\\w+::", "\\2", x)
+  }
+  x
+}
+
+
 # checks if a brms-models is a multi-membership-model
 .is_multi_membership <- function(x) {
   if (inherits(x, "brmsfit")) {
@@ -109,7 +121,7 @@
 
 
 # extract random effects from formula
-.get_model_random <- function(f, split_nested = FALSE, model) {
+.get_model_random <- function(f, model, split_nested = FALSE) {
   is_special <- inherits(
     model,
     c(
@@ -135,8 +147,16 @@
   }
 
   # check for multi-membership models
-  if (inherits(model, "brmsfit") && grepl("mm\\((.*)\\)", re)) {
-    re <- trim_ws(unlist(strsplit(gsub("mm\\((.*)\\)", "\\1", re), ",", fixed = TRUE)))
+  if (inherits(model, "brmsfit")) {
+    if (grepl("mm\\((.*)\\)", re)) {
+      re <- trim_ws(unlist(strsplit(gsub("mm\\((.*)\\)", "\\1", re), ",", fixed = TRUE)))
+    }
+    if (grepl("gr\\((.*)\\)", re)) {
+      # remove namespace prefixes
+      re <- .remove_namespace_from_string(re)
+      # extract random effects term
+      re <- trim_ws(gsub("gr\\((\\w+)(,.*|)\\)", "\\1", re))
+    }
   }
 
   if (split_nested) {
@@ -177,9 +197,9 @@
 # .get_model_random()
 .get_group_factor <- function(x, f) {
   if (is.list(f)) {
-    f <- lapply(f, .get_model_random, split_nested = TRUE, model = x)
+    f <- lapply(f, .get_model_random, model = x, split_nested = TRUE)
   } else {
-    f <- .get_model_random(f, split_nested = TRUE, x)
+    f <- .get_model_random(f, model = x, split_nested = TRUE)
   }
 
   if (is.null(f)) {
@@ -629,9 +649,7 @@
       }
       list(slashTerms(x[[2]]), slashTerms(x[[3]]))
     }
-    if (!is.list(bb)) {
-      expandSlash(list(bb))
-    } else {
+    if (is.list(bb)) {
       unlist(lapply(bb, function(x) {
         trms <- slashTerms(x[[3]])
         if (length(x) > 2 && is.list(trms)) {
@@ -642,6 +660,8 @@
           x
         }
       }))
+    } else {
+      expandSlash(list(bb))
     }
   }
   modterm <- .expandDoubleVerts(if (methods::is(term, "formula")) {

tests/testthat/test-brms_gr_random_effects.R

@@ -0,0 +1,28 @@
+skip_on_cran()
+skip_on_os("mac")
+skip_if_not_installed("brms")
+skip_if_not_installed("withr")
+
+withr::with_environment(
+  new.env(),
+  test_that("correctly handle brms::gr()", {
+    data(epilepsy, package = "brms")
+    # assign function, without loading the package
+    gr <- brms::gr
+    m <- suppressWarnings(suppressMessages(
+      brms::brm(count ~ Trt + (1 | gr(patient, by = Trt)), data = epilepsy, refresh = 0)
+    ))
+    expect_equal(
+      find_formula(m),
+      list(
+        conditional = count ~ Trt,
+        random = ~ 1 | gr(patient, by = Trt)
+      ),
+      ignore_attr = TRUE
+    )
+    expect_identical(find_predictors(m, "all"), list(conditional = "Trt", random = "patient"))
+    expect_identical(find_random(m), list(random = "patient"))
+    d <- get_data(m)
+    expect_named(d, c("count", "Trt", "patient"))
+  })
+)