Fix r2() error for glmmTMB negative-binomial models without random effects

NEWS.md

@@ -9,6 +9,10 @@
 * `check_collinearity()` now properly warns when the `vcov` matrix is rank
   deficient (#922).
 
+* `r2()` (and hence `model_performance()`) no longer errors for `glmmTMB`
+  negative-binomial models (`nbinom1`/`nbinom2`) without random effects, and now
+  returns McFadden's R2 for them.
+
 # performance 0.17.1
 
 ## Changes

R/r2.R

@@ -544,6 +544,11 @@ r2.glmmTMB <- function(model, ci = NULL, tolerance = 1e-5, verbose = TRUE, ...)
       names(out$R2_Nagelkerke) <- "Nagelkerke's R2"
       attr(out, "model_type") <- "Generalized Linear"
       class(out) <- c("r2_pseudo", class(out))
+    } else if (info$is_negbin && !info$is_zero_inflated) {
+      # negative-binomial regression uses McFadden's R2. Nagelkerke's is unstable
+      # here (the null-model refit finds a different dispersion, which can yield
+      # nonsensical negative values), so mirror the beta-binomial branch above.
+      out <- r2_mcfadden(model)
     } else if (info$is_zero_inflated) {
       # zero-inflated models use the default method
       out <- r2_zeroinflated(model)

tests/testthat/test-r2_mcfadden.R

@@ -32,7 +32,7 @@
 
 withr::with_environment(
   new.env(),
   {
     test_that("r2_mcfadden, glmmTMB-beta-binomial", {
       skip_if_not_installed("glmmTMB")
       set.seed(101)
@@ -69,3 +69,21 @@
     })
   }
 )
+
+test_that("r2, glmmTMB negative-binomial without random effects", {
+  skip_if_not_installed("glmmTMB")
+  set.seed(101)
+  dd <- data.frame(x = rnorm(200))
+  dd$y <- rnbinom(200, mu = exp(0.5 + 1 * dd$x), size = 2)
+
+  # nbinom2 previously errored ("does not support models of class `glmmTMB`
+  # without random effects and from nbinom2-family ..."); now returns McFadden's.
+  m2 <- glmmTMB::glmmTMB(y ~ 1 + x, data = dd, family = glmmTMB::nbinom2())
+  out <- r2(m2)
+  expect_equal(out$R2, r2_mcfadden(m2)$R2, tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(out$R2, 0.1521543, tolerance = 1e-4, ignore_attr = TRUE)
+
+  # nbinom1 is handled by the same branch.
+  m1 <- glmmTMB::glmmTMB(y ~ 1 + x, data = dd, family = glmmTMB::nbinom1())
+  expect_equal(r2(m1)$R2, 0.1406573, tolerance = 1e-4, ignore_attr = TRUE)
+})