add brms method

Author: strengejacke

R/group_level_total.R

@@ -85,18 +85,48 @@
 
 .group_level_total.brmsfit <- function(x, ...) {
   # extract random effects information
-  group_factors <- insight::find_random(x)
+  group_factors <- insight::find_random(x, split_nested = TRUE, flatten = TRUE)
   random_slopes <- insight::find_random_slopes(x)
+  params <- NULL
 
-  for (i in group_factors) {
+  # create full data frame of all random effects retrieved from coef()
+  params <- do.call(rbind, lapply(group_factors, function(i) {
+    # we want the posterior distribution from coef(), so we can
+    # use bayestestR
     ranef <- stats::coef(x, summary = FALSE)[[i]]
     parameter_names <- dimnames(ranef)[[3]]
     out <- lapply(
       parameter_names,
-      function(pn) bayestestR::describe_posterior(as.data.frame(x[, , pn]), ...)
+      function(pn) {
+        # summary of posterior
+        d <- bayestestR::describe_posterior(as.data.frame(ranef[, , pn]), verbose = FALSE, ...)
+        # add information about group factor and levels
+        d$Group <- i
+        # Parameters in the returned data frame are actually the levels
+        # # from the group factors
+        d$Level <- d$Parameter
+        # the parameter names can be taken from dimnames
+        d$Parameter <- pn
+        d
+      }
     )
     names(out) <- parameter_names
-  }
+    do.call(rbind, out)
+  }))
+
+  # select parameters to keep. We want all intercepts, and all random slopes
+  # from conditional and potential zero-inflation component
+  parameters_to_keep <- params$Parameter %in% c("Intercept", random_slopes$random)
+  parameters_to_keep <- parameters_to_keep | params$Parameter %in% c("zi_Intercept", random_slopes$zero_inflated_random)
+  # furthermore, categorical random slopes have levels in their name, so we
+  # try to find those parameters here, too
+  parameters_to_keep <- parameters_to_keep | startsWith(params$Parameter, random_slopes$random)
+  parameters_to_keep <- parameters_to_keep | startsWith(params$Parameter, random_slopes$zero_inflated_random)
+
+  # clean names
+  params$Parameter <- gsub("^zi_", "", params$Parameter)
+
+  params
 }
 
 

R/methods_brms.R

@@ -52,16 +52,14 @@
 #'
 #' @inheritSection model_parameters.zcpglm Model components
 #'
-#' @examples
+#' @examplesIf require("rstanarm")
 #' \donttest{
 #' library(parameters)
-#' if (require("rstanarm")) {
-#'   model <- suppressWarnings(stan_glm(
-#'     Sepal.Length ~ Petal.Length * Species,
-#'     data = iris, iter = 500, refresh = 0
-#'   ))
-#'   model_parameters(model)
-#' }
+#' model <- suppressWarnings(stan_glm(
+#'   Sepal.Length ~ Petal.Length * Species,
+#'   data = iris, iter = 500, refresh = 0
+#' ))
+#' model_parameters(model)
 #' }
 #' @return A data frame of indices related to the model's parameters.
 #' @export
@@ -107,6 +105,12 @@ model_parameters.brmsfit <- function(model,
       drop_parameters = drop,
       ...
     )
+  } else if (identical(effects, "total")) {
+    # group level total effects (coef())
+    params <- .group_level_total(model, centrality, dispersion, ci, ci_method, test, rope_range, rope_ci, ...)
+    params$Effects <- "total"
+    class(params) <- c("parameters_coef", "see_parameters_coef", class(params))
+    return(params)
   } else {
     # Processing
     params <- .extract_parameters_bayesian(