nbinom

easystats · Jun 12, 2024 · bfd87e3 · bfd87e3
1 parent 105dd7c
commit bfd87e3
Show file tree

Hide file tree

Showing 2 changed files with 51 additions and 4 deletions.
diff --git a/R/compute_variances.R b/R/compute_variances.R
@@ -558,7 +558,7 @@
 
     resid.variance <- switch(faminfo$link_function,
       log = .variance_distributional(x, faminfo, sig, model_null, revar_null, name = name, verbose = verbose),
-      sqrt = 0.25,
+      sqrt = 0.25 * sig,
       .badlink(faminfo$link_function, faminfo$family, verbose = verbose)
     )
   } else if (faminfo$family %in% c("Gamma", "gamma")) {
@@ -674,7 +674,8 @@
     mu <- switch(faminfo$family,
       beta = mu,
       ordbeta = stats::plogis(mu),
-      poisson = sqrt(exp(mu + 0.5 * as.vector(revar_null))),
+      poisson = ,
+      nbinom1 = sqrt(exp(mu + 0.5 * as.vector(revar_null))),
       exp(mu)
     )
   }
@@ -700,10 +701,10 @@
 
         # (zero-inflated) negative binomial ----
         # --------------------------------------
+        nbinom1 = sig,
         `zero-inflated negative binomial` = ,
         `negative binomial` = ,
         genpois = ,
-        nbinom1 = ,
         nbinom2 = .variance_family_nbinom(x, mu, sig, faminfo),
         truncated_nbinom2 = stats::family(x)$variance(mu, sig),
 

diff --git a/tests/testthat/test-r2_nakagawa_MuMIn.R b/tests/testthat/test-r2_nakagawa_MuMIn.R
@@ -355,7 +355,7 @@ test_that("glmmTMB, Poisson", {
 
 
 # ==============================================================================
-# Poisson mixed models, glmmTMB
+# Poisson mixed models, lme4
 # ==============================================================================
 
 test_that("lme4, Poisson", {
@@ -382,3 +382,49 @@ test_that("lme4, Poisson", {
   expect_equal(out1[1, "R2m"], out2$R2_marginal, ignore_attr = TRUE, tolerance = 1e-4)
   expect_equal(out1[1, "R2c"], out2$R2_conditional, ignore_attr = TRUE, tolerance = 1e-4)
 })
+
+
+# ==============================================================================
+# Poisson mixed models, glmmTMB
+# ==============================================================================
+
+test_that("glmmTMB, Nbinom1", {
+  # dataset ---------------------------------
+  data(Salamanders, package = "glmmTMB")
+
+  # no random slopes
+  m <- glmmTMB::glmmTMB(
+    count ~ mined + spp + (1 | site),
+    family = glmmTMB::nbinom1(),
+    data = Salamanders
+  )
+  out1 <- suppressWarnings(MuMIn::r.squaredGLMM(m))
+  out2 <- performance::r2_nakagawa(m)
+  # matches theoretical values
+  expect_equal(out1[2, "R2m"], out2$R2_marginal, ignore_attr = TRUE, tolerance = 1e-4)
+  expect_equal(out1[2, "R2c"], out2$R2_conditional, ignore_attr = TRUE, tolerance = 1e-4)
+
+  # with random slopes
+  m <- suppressWarnings(glmmTMB::glmmTMB(
+    count ~ mined + spp + cover + (1 + cover | site),
+    family = glmmTMB::nbinom1(),
+    data = Salamanders
+  ))
+  out1 <- suppressWarnings(MuMIn::r.squaredGLMM(m))
+  out2 <- performance::r2_nakagawa(m, tolerance = 1e-8)
+  # matches theoretical values
+  expect_equal(out1[2, "R2m"], out2$R2_marginal, ignore_attr = TRUE, tolerance = 1e-1)
+  expect_equal(out1[2, "R2c"], out2$R2_conditional, ignore_attr = TRUE, tolerance = 1e-1)
+
+  # no random slopes, sqrt
+  m <- glmmTMB::glmmTMB(
+    count ~ mined + spp + (1 | site),
+    family = glmmTMB::nbinom1("sqrt"),
+    data = Salamanders
+  )
+  out1 <- suppressWarnings(MuMIn::r.squaredGLMM(m))
+  out2 <- performance::r2_nakagawa(m)
+  # matches delta values
+  expect_equal(out1[1, "R2m"], out2$R2_marginal, ignore_attr = TRUE, tolerance = 1e-4)
+  expect_equal(out1[1, "R2c"], out2$R2_conditional, ignore_attr = TRUE, tolerance = 1e-4)
+})