From 5adb9e2ee00c2c6ba6f28c92d718809c1efefc8d Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Fri, 23 Aug 2024 23:28:18 +0200
Subject: [PATCH] `get_variance()` Triggers Model Recompilation and Returns
 `NULL` for `brms` Mixed Models in v0.20.3 Fixes #915

---
 R/compute_variances.R      | 21 +++++++++++++--------
 R/get_modelmatrix.R        | 27 ++++++++++++++++++---------
 tests/testthat/test-brms.R | 19 +++++++++++++++++++
 3 files changed, 50 insertions(+), 17 deletions(-)

diff --git a/R/compute_variances.R b/R/compute_variances.R
index ece7b6dbd..4067295a4 100644
--- a/R/compute_variances.R
+++ b/R/compute_variances.R
@@ -78,15 +78,20 @@
 
   # we also need necessary model information, like fixed and random effects,
   # variance-covariance matrix etc. for the null model
-  if (is.null(model_null)) {
-    model_null <- .safe(null_model(model, verbose = FALSE))
+  if (faminfo$is_linear && !faminfo$is_tweedie) {
+    # we don't need these for linear models
+    me_info_null <- NULL
+  } else {
+    if (is.null(model_null)) {
+      model_null <- .safe(null_model(model, verbose = FALSE))
+    }
+    me_info_null <- .get_variance_information(
+      model_null,
+      faminfo = faminfo,
+      name_fun = name_fun,
+      verbose = verbose
+    )
   }
-  me_info_null <- .get_variance_information(
-    model_null,
-    faminfo = faminfo,
-    name_fun = name_fun,
-    verbose = verbose
-  )
 
   # Test for non-zero random effects ((near) singularity)
   no_random_variance <- FALSE
diff --git a/R/get_modelmatrix.R b/R/get_modelmatrix.R
index c14605ffd..a7a4849c3 100644
--- a/R/get_modelmatrix.R
+++ b/R/get_modelmatrix.R
@@ -158,15 +158,24 @@ get_modelmatrix.svyglm <- function(x, ...) {
 #' @export
 get_modelmatrix.brmsfit <- function(x, ...) {
   formula_rhs <- safe_deparse(find_formula(x)$conditional[[3]])
-  formula_rhs <- stats::as.formula(paste0("~", formula_rhs))
-  # the formula used in model.matrix() is not allowed to have special functions,
-  # like brms::mo() and similar. Thus, we reformulate after using "all.vars()",
-  # which will only keep the variable names.
-  .data_in_dots(
-    ...,
-    object = stats::reformulate(all.vars(formula_rhs)),
-    default_data = get_data(x, verbose = FALSE)
-  )
+  # exception: for null-models, we need different handling, else `reformulate()`
+  # will not work.
+  if (identical(formula_rhs, "1")) {
+    mm <- get_data(x, verbose = FALSE)
+    mm[[1]] <- 1
+    colnames(mm)[1] <- "(Intercept)"
+    mm[1]
+  } else {
+    formula_rhs <- stats::as.formula(paste0("~", formula_rhs))
+    # the formula used in model.matrix() is not allowed to have special functions,
+    # like brms::mo() and similar. Thus, we reformulate after using "all.vars()",
+    # which will only keep the variable names.
+    .data_in_dots(
+      ...,
+      object = stats::reformulate(all.vars(formula_rhs)),
+      default_data = get_data(x, verbose = FALSE)
+    )
+  }
 }
 
 #' @export
diff --git a/tests/testthat/test-brms.R b/tests/testthat/test-brms.R
index 3a061a44b..79fafbfc3 100644
--- a/tests/testthat/test-brms.R
+++ b/tests/testthat/test-brms.R
@@ -900,3 +900,22 @@ test_that("get_modelmatrix", {
     )
   )
 })
+
+# get variance
+test_that("get_variance works", {
+  mdl <- brms::brm(mpg ~ hp + (1 | cyl), data = mtcars)
+  out <- get_variance(mdl)
+  expect_equal(
+    out,
+    list(
+      var.fixed = 5.0734440813087,
+      var.random = 22.887162197839,
+      var.residual = 14.9024565369,
+      var.distribution = 14.9024565369,
+      var.dispersion = 0,
+      var.intercept = c(cyl = 22.8871621978389)
+    ),
+    tolerance = 1e-4,
+    ignore_attr = TRUE
+  )
+})