Skip to content

Commit

Permalink
check_singularity doesn't work for glmmTMB (#684)
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke authored Feb 16, 2024
1 parent b46c7d1 commit 3250fd7
Show file tree
Hide file tree
Showing 4 changed files with 39 additions and 7 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: performance
Title: Assessment of Regression Models Performance
Version: 0.10.8.13
Version: 0.10.8.14
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down
3 changes: 3 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,9 @@
* Improved plots for overdispersion-checks for negative-binomial models from
package *glmmTMB* (affects `check_overdispersion()` and `check_mnodel()`).

* Improved detection rates for singularity in `check_singularity()` for models
from package *glmmTMB*.

* For model of class `glmmTMB`, deviance residuals are now used in the
`check_model()` plot.

Expand Down
15 changes: 12 additions & 3 deletions R/check_singularity.R
Original file line number Diff line number Diff line change
Expand Up @@ -101,15 +101,24 @@ check_singularity.merMod <- function(x, tolerance = 1e-5, ...) {
check_singularity.rlmerMod <- check_singularity.merMod



#' @export
check_singularity.glmmTMB <- function(x, tolerance = 1e-5, ...) {
insight::check_if_installed("lme4")

vc <- .collapse_cond(lme4::VarCorr(x))
any(sapply(vc, function(.x) any(abs(diag(.x)) < tolerance)))
eigen_values <- list()
vv <- lme4::VarCorr(x)
for (component in c("cond", "zi")) {
for (i in seq_along(vv[[component]])) {
eigen_values <- c(
eigen_values,
list(eigen(vv[[component]][[i]], only.values = TRUE)$values)
)
}
}
any(vapply(eigen_values, min, numeric(1), na.rm = TRUE) < tolerance)
}


#' @export
check_singularity.glmmadmb <- check_singularity.glmmTMB

Expand Down
26 changes: 23 additions & 3 deletions tests/testthat/test-check_singularity.R
Original file line number Diff line number Diff line change
@@ -1,14 +1,14 @@
test_that("check_singularity", {
test_that("check_singularity, lme4", {
skip_on_cran()
skip_if_not_installed("lme4")
data(sleepstudy, package = "lme4")
set.seed(123)
sleepstudy$mygrp <- sample(1:5, size = 180, replace = TRUE)
sleepstudy$mygrp <- sample.int(5, size = 180, replace = TRUE)
sleepstudy$mysubgrp <- NA
for (i in 1:5) {
filter_group <- sleepstudy$mygrp == i
sleepstudy$mysubgrp[filter_group] <-
sample(1:30, size = sum(filter_group), replace = TRUE)
sample.int(30, size = sum(filter_group), replace = TRUE)
}

model <- suppressMessages(lme4::lmer(
Expand All @@ -17,3 +17,23 @@ test_that("check_singularity", {
))
expect_true(check_singularity(model))
})


test_that("check_singularity", {
skip_on_cran()
skip_if_not_installed("glmmTMB")
set.seed(101)
dd <- expand.grid(x = factor(1:6), f = factor(1:20), rep = 1:5)
dd$y <- glmmTMB::simulate_new(~ 1 + (x | f),
newdata = dd,
newparam = list(
beta = 0,
theta = rep(0, 21),
betad = 0
)
)[[1]]
expect_warning(expect_warning({
m2 <- glmmTMB::glmmTMB(y ~ 1 + (x | f), data = dd, REML = FALSE)
}))
expect_true(check_singularity(m2))
})

0 comments on commit 3250fd7

Please sign in to comment.