add for glmmTMB

NAMESPACE

@@ -453,6 +453,7 @@ S3method(r2_coxsnell,svycoxph)
 S3method(r2_coxsnell,truncreg)
 S3method(r2_efron,default)
 S3method(r2_ferrari,default)
+S3method(r2_ferrari,glmmTMB)
 S3method(r2_kullback,default)
 S3method(r2_kullback,glm)
 S3method(r2_loo_posterior,BFBayesFactor)

R/r2.R

@@ -527,6 +527,9 @@ r2.glmmTMB <- function(model, ci = NULL, tolerance = 1e-5, verbose = TRUE, ...)
     } else if (info$is_zero_inflated) {
       # zero-inflated models use the default method
       out <- r2_zeroinflated(model)
+    } else if (info$is_beta) {
+      # beta-regression
+      out <- r2_ferarri(model)
     } else {
       insight::format_error("`r2()` does not support models of class `glmmTMB` without random effects and this link-function.") # nolint
     }

R/r2_ferarri.R

@@ -28,7 +28,22 @@ r2_ferrari.default <- function(model, ...) {
   # coefficients, but remove phi parameter
   x <- stats::coef(model)
   x <- x[names(x) != "(phi)"]
+  .r2_ferrari(model, x)
+}
+
+#' @export
+r2_ferrari.glmmTMB <- function(model, ...) {
+  insight::check_if_installed("lme4")
+  # coefficients, but remove phi parameter
+  x <- .collapse_cond(lme4::fixef(model))
+  x <- x[names(x) != "(phi)"]
+  .r2_ferrari(model, x)
+}
+
+
+# helper -----------------------------
 
+.r2_ferrari <- function(model, x) {
   # model matrix, check dimensions / length
   mm <- insight::get_modelmatrix(model)
 
@@ -39,7 +54,7 @@ r2_ferrari.default <- function(model, ...) {
 
   # linear predictor for the mean
   eta <- as.vector(x %*% t(mm))
-  y <- insight::get_response(m)
+  y <- insight::get_response(model)
 
   ferrari <- stats::cor(eta, insight::link_function(model)(y))^2
   out <- list(R2 = c(`Ferrari's R2` = ferrari))

tests/testthat/test-r2_ferrari.R

@@ -5,3 +5,17 @@ test_that("r2_ferarri", {
   out <- r2_ferrari(model)
   expect_equal(out$R2, summary(model)$pseudo.r.squared, tolerance = 1e-3, ignore_attr = TRUE)
 })
+
+
+test_that("r2_ferarri", {
+  skip_if_not_installed("betareg")
+  skip_if_not_installed("glmmTMB")
+  data("GasolineYield", package = "betareg")
+  model <- glmmTMB::glmmTMB(
+    yield ~ batch + temp,
+    data = GasolineYield,
+    family = glmmTMB::beta_family()
+  )
+  out <- r2_ferrari(model)
+  expect_equal(out$R2, c(`Ferrari's R2` = 0.96173), tolerance = 1e-3, ignore_attr = TRUE)
+})