From eacd3ac50d4954364440d8fdcd8bc7d535525a91 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 5 Jun 2024 10:38:06 +0200
Subject: [PATCH] warnings/approximation of observation-level variance in
 .get_variance_distributional Fixes #877

---
 DESCRIPTION           |  2 +-
 NEWS.md               | 14 +++++++++++---
 R/compute_variances.R |  5 ++++-
 R/helper_functions.R  | 41 -----------------------------------------
 4 files changed, 16 insertions(+), 46 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 687d1ef555..81fed54ddd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.20.0
+Version: 0.20.0.2
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
diff --git a/NEWS.md b/NEWS.md
index 19bddd4bca..c8815be676 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,14 @@
+# insight 0.20.1
+
+## General
+
+* Improved accuracy of singularity-checks in `get_variance()`.
+
+## Bug fixes
+
+* Fixed issues in `compact_list()` for objects that contained variables of
+  class `vctrs`.
+
 # insight 0.20.0
 
 ## Breaking
@@ -14,9 +25,6 @@
 
 * Fixed errors in CRAN checks.
 
-* Fixed issues in `compact_list()` for objects that contained variables of
-  class `vctrs`.
-
 # insight 0.19.11
 
 ## General
diff --git a/R/compute_variances.R b/R/compute_variances.R
index 260fdf30d0..ac4a448a71 100644
--- a/R/compute_variances.R
+++ b/R/compute_variances.R
@@ -12,6 +12,9 @@
   ## Major revisions and adaption to more complex models and other packages
   ## by Daniel Lüdecke
 
+  # needed for singularity check
+  check_if_installed("performance", reason = "to check for singularity")
+
   faminfo <- model_info(x, verbose = FALSE)
 
   if (any(faminfo$family == "truncated_nbinom1")) {
@@ -36,7 +39,7 @@
 
   # Test for non-zero random effects ((near) singularity)
   no_random_variance <- FALSE
-  if (.is_singular(x, vals, tolerance = tolerance) && !(component %in% c("slope", "intercept"))) {
+  if (performance::check_singularity(x, tolerance = tolerance) && !(component %in% c("slope", "intercept"))) {
     if (verbose) {
       format_warning(
         sprintf("Can't compute %s. Some variance components equal zero. Your model may suffer from singularity (see `?lme4::isSingular` and `?performance::check_singularity`).", name_full),
diff --git a/R/helper_functions.R b/R/helper_functions.R
index ba797bae31..358bb954d2 100644
--- a/R/helper_functions.R
+++ b/R/helper_functions.R
@@ -300,47 +300,6 @@
 
 
 
-
-# checks if a mixed model fit is singular or not. Need own function,
-# because lme4::isSingular() does not work with glmmTMB
-.is_singular <- function(x, vals, tolerance = 1e-5) {
-  check_if_installed("lme4", reason = "to compute variances for mixed models")
-
-  tryCatch(
-    {
-      if (inherits(x, "glmmTMB")) {
-        eigen_values <- list()
-        for (component in c("cond", "zi")) {
-          for (i in seq_along(vals$vc[[component]])) {
-            eigen_values <- c(eigen_values, list(eigen(vals$vc[[component]][[i]], only.values = TRUE)$values))
-          }
-        }
-        is_si <- any(vapply(eigen_values, min, numeric(1), na.rm = TRUE) < tolerance)
-      } else if (inherits(x, c("clmm", "cpglmm"))) {
-        is_si <- any(sapply(vals$vc, function(.x) any(abs(diag(.x)) < tolerance)))
-      } else if (inherits(x, "merMod")) {
-        theta <- lme4::getME(x, "theta")
-        diag.element <- lme4::getME(x, "lower") == 0
-        is_si <- any(abs(theta[diag.element]) < tolerance)
-      } else if (inherits(x, "MixMod")) {
-        vc <- diag(x$D)
-        is_si <- any(sapply(vc, function(.x) any(abs(.x) < tolerance)))
-      } else if (inherits(x, "lme")) {
-        is_si <- any(abs(stats::na.omit(as.numeric(diag(vals$vc))) < tolerance))
-      } else {
-        is_si <- FALSE
-      }
-
-      is_si
-    },
-    error = function(x) {
-      FALSE
-    }
-  )
-}
-
-
-
 # Filter parameters from Stan-model fits
 .filter_pars <- function(l, parameters = NULL, is_mv = NULL) {
   if (!is.null(parameters)) {