Save the effects argument so group-level estimates print as random effects

NEWS.md

@@ -8,6 +8,14 @@
 * Logical variables are now properly formatted when pretty value labels are
   printed.
 
+## Bug fixes
+
+* The `effects` argument is now saved as an attribute of the returned
+  parameters table, and printing uses it to recognize group-level estimates
+  as random effects. Previously, when `effects = "grouplevel"` produced a
+  single-valued `Effects` column that was removed before formatting, the
+  estimates were printed under fixed-effects headers (#1098).
+
 # parameters 0.29.2
 
 ## Changes

R/1_model_parameters.R

@@ -731,6 +731,7 @@ model_parameters.default <- function(
         ci_method = ci_method,
         p_adjust = p_adjust,
         include_info = include_info,
+        effects = effects,
         verbose = verbose,
         ...
       )

R/methods_brms.R

@@ -163,6 +163,7 @@ model_parameters.brmsfit <- function(
       exponentiate,
       ci_method = ci_method,
       group_level = group_level,
+      effects = effects,
       modelinfo = modelinfo,
       verbose = verbose,
       ...

R/methods_coxme.R

@@ -188,6 +188,7 @@ model_parameters.coxme <- function(
     verbose = verbose,
     include_info = include_info,
     group_level = group_level,
+    effects = effects,
     wb_component = wb_component,
     ...
   )

R/methods_glmmTMB.R

@@ -353,6 +353,7 @@
     p_adjust = p_adjust,
     verbose = verbose,
     group_level = group_level,
+    effects = effects,
     include_info = include_info,
     wb_component = wb_component,
     modelinfo = modelinfo,
@@ -595,7 +596,7 @@
 
   if (effects == "random") {
     .se_random_effects_glmmTMB(model)
   } else if (!is.null(vcov)) {
     .se_robust_glmmTMB(model, component, vcov, vcov_args, verbose, ...)
   } else {
     .se_fixed_effects_glmmTMB(model, component, method, verbose)
@@ -643,7 +644,7 @@
 .se_robust_glmmTMB <- function(
   model,
   component = "all",
   vcov,
   vcov_args = NULL,
   verbose = TRUE,
   ...

R/methods_rstan.R

@@ -55,6 +55,7 @@ model_parameters.stanfit <- function(model,
     ci,
     exponentiate,
     ci_method = ci_method,
+    effects = effects,
     verbose = verbose,
     ...
   )

R/methods_rstanarm.R

@@ -68,6 +68,7 @@ model_parameters.stanreg <- function(model,
     exponentiate,
     ci_method = ci_method,
     group_level = group_level,
+    effects = effects,
     verbose = verbose,
     ...
   )

R/print.parameters_model.R

@@ -442,8 +442,13 @@ print.parameters_random <- function(x, digits = 2, ...) {
 
   title_attribute <- attributes(x)$title[1]
 
-  # check effects and component parts
-  if (!is.null(x$Effects) && all(x$Effects == "random")) {
+  # check effects and component parts. the Effects column may already have
+  # been removed when it carried a single unique value, so group-level
+  # estimates are additionally detected from the saved "effects" argument
+  if (
+    (!is.null(x$Effects) && all(x$Effects == "random")) ||
+      identical(attributes(x)$effects, "grouplevel")
+  ) {
     eff_name <- "Random"
   } else {
     eff_name <- "Fixed"

R/utils_format.R

@@ -242,7 +242,7 @@
 # row for them
 # -----------------------------------------------------------------------------
 
 .add_reference_level <- function(params, model = NULL) {
   if (is.null(model)) {
     # check if we have a model object, if not provided by user
     model <- .get_object(params)
@@ -504,14 +504,14 @@
 # helper to format the header / subheader of different model components -------
 # -----------------------------------------------------------------------------
 
 .format_model_component_header <- function(
   x,
   type,
   split_column,
   is_zero_inflated,
   is_ordinal_model,
   is_multivariate = FALSE,
   ran_pars,
   formatted_table = NULL
 ) {
   # prepare component names
@@ -868,7 +868,7 @@
 # or edge cases...
 # -----------------------------------------------------------------------------
 
 .format_columns_multiple_components <- function(
   x,
   pretty_names,
   split_column = "Component",
@@ -977,10 +977,12 @@
   # fix table names for random effects, when we only have random
   # effects. in such cases, the wrong header (fixed effects) is chosen
   # to prevent this, we "fake" the name of the splitted components by
-  # prefixing them with "random."
+  # prefixing them with "random." - the Effects column may already have
+  # been removed when it carried a single unique value, so group-level
+  # estimates are additionally detected from the saved "effects" argument
   if (
-    !is.null(x$Effects) &&
-      all(x$Effects == "random") &&
+    ((!is.null(x$Effects) && all(x$Effects == "random")) ||
+      identical(attributes(x)$effects, "grouplevel")) &&
       !all(startsWith(names(tables), "random."))
   ) {
     wrong_names <- !startsWith(names(tables), "random.")

R/utils_model_parameters.R

@@ -4,7 +4,7 @@
 #'
 #' @keywords internal
 #' @noRd
 .add_model_parameters_attributes <- function(
   params,
   model,
   ci,
@@ -18,6 +18,7 @@
   group_level = FALSE,
   wb_component = FALSE,
   modelinfo = NULL,
+  effects = NULL,
   ...
 ) {
   # these models only have a single table component, hence, we need no caption
@@ -79,6 +80,13 @@
   attr(params, "robust_vcov") <- "vcov" %in% names(list(...))
   attr(params, "ignore_group") <- isFALSE(group_level)
   attr(params, "ran_pars") <- isFALSE(group_level)
+  # some methods resolve the "grouplevel" alias into effects = "random" plus
+  # group_level = TRUE early on; undo that here so the attribute always
+  # records what the user asked for
+  if (isTRUE(group_level) && identical(effects, "random")) {
+    effects <- "grouplevel"
+  }
+  attr(params, "effects") <- effects
   attr(params, "show_summary") <- isTRUE(include_info)
   attr(params, "log_link") <- isTRUE(grepl("log", info$link_function, fixed = TRUE))
   attr(params, "logit_link") <- isTRUE(identical(info$link_function, "logit"))

tests/testthat/test-print-grouplevel.R

@@ -0,0 +1,31 @@
+skip_on_cran()
+
+test_that("print() labels group-level estimates as random effects", {
+  skip_if_not_installed("lme4")
+  m <- lme4::lmer(Reaction ~ Days + (1 | Subject), data = lme4::sleepstudy)
+  mp <- model_parameters(m, effects = "grouplevel")
+  expect_identical(attributes(mp)$effects, "grouplevel")
+  out <- utils::capture.output(print(mp))
+  expect_true(any(startsWith(out, "# Random Effects")))
+})
+
+test_that("group-level estimates print as random effects without an Effects column", {
+  skip_if_not_installed("curl")
+  skip_if_offline()
+  skip_if_not_installed("brms")
+  skip_if_not_installed("httr2")
+
+  m <- insight::download_model("brms_zi_3")
+  skip_if(is.null(m))
+  mp <- model_parameters(m, effects = "grouplevel")
+
+  # the Effects column is dropped upstream because it is single-valued, so
+  # the header decision has to come from the saved `effects` argument
+  expect_false("Effects" %in% colnames(mp))
+  expect_identical(attributes(mp)$effects, "grouplevel")
+
+  out <- utils::capture.output(print(mp))
+  headers <- out[startsWith(out, "#")]
+  expect_length(headers, 2L)
+  expect_true(all(startsWith(headers, "# Random Effects")))
+})