Skip to content

Commit 014ee4a

Browse files
authored
Error for R2 for beta binomial glmmTMB model (#788)
1 parent 2dfeea2 commit 014ee4a

8 files changed

+83
-4
lines changed

DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: performance
33
Title: Assessment of Regression Models Performance
4-
Version: 0.12.4.14
4+
Version: 0.12.4.15
55
Authors@R:
66
c(person(given = "Daniel",
77
family = "Lüdecke",

NAMESPACE

+1
Original file line numberDiff line numberDiff line change
@@ -473,6 +473,7 @@ S3method(r2_mcfadden,clm)
473473
S3method(r2_mcfadden,clm2)
474474
S3method(r2_mcfadden,cpglm)
475475
S3method(r2_mcfadden,glm)
476+
S3method(r2_mcfadden,glmmTMB)
476477
S3method(r2_mcfadden,glmx)
477478
S3method(r2_mcfadden,logitmfx)
478479
S3method(r2_mcfadden,logitor)

NEWS.md

+3
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,9 @@
1616

1717
* Increased accuracy for `check_convergence()` for *glmmTMB* models.
1818

19+
* `r2()` and `r2_mcfadden()` now support beta-binomial (non-mixed) models from
20+
package *glmmTMB*.
21+
1922
## Bug fixes
2023

2124
* `check_outliers()` did not warn that no numeric variables were found when only

R/r2.R

+12
Original file line numberDiff line numberDiff line change
@@ -516,6 +516,7 @@ r2.glmmTMB <- function(model, ci = NULL, tolerance = 1e-5, verbose = TRUE, ...)
516516
}
517517
# calculate r2 for non-mixed glmmTMB models here -------------------------
518518
info <- insight::model_info(model, verbose = FALSE)
519+
matrix_response <- grepl("cbind", insight::find_response(model), fixed = TRUE)
519520

520521
if (info$is_linear) {
521522
# for linear models, use the manual calculation
@@ -526,6 +527,17 @@ r2.glmmTMB <- function(model, ci = NULL, tolerance = 1e-5, verbose = TRUE, ...)
526527
attr(out, "model_type") <- "Logistic"
527528
names(out$R2_Tjur) <- "Tjur's R2"
528529
class(out) <- c("r2_pseudo", class(out))
530+
} else if (info$is_betabinomial) {
531+
# currently, beta-binomial models without proportion response are not supported
532+
if (matrix_response) {
533+
if (verbose) {
534+
insight::format_warning("Can't calculate accurate R2 for beta-binomial models with matrix-response formulation.")
535+
}
536+
out <- NULL
537+
} else {
538+
# betabinomial default to mcfadden, see pscl:::pR2Work
539+
out <- r2_mcfadden(model)
540+
}
529541
} else if (info$is_binomial && !info$is_bernoulli) {
530542
# currently, non-bernoulli binomial models are not supported
531543
if (verbose) {

R/r2_coxsnell.R

+11-2
Original file line numberDiff line numberDiff line change
@@ -69,13 +69,22 @@ r2_coxsnell.glm <- function(model, verbose = TRUE, ...) {
6969
if (is.null(info)) {
7070
info <- suppressWarnings(insight::model_info(model, verbose = FALSE))
7171
}
72+
matrix_response <- grepl("cbind", insight::find_response(model), fixed = TRUE)
73+
7274
# Cox & Snell's R2 is not defined for binomial models that are not Bernoulli models
73-
if (info$is_binomial && !info$is_bernoulli && class(model)[1] == "glm") {
75+
if (info$is_binomial && !info$is_betabinomial && !info$is_bernoulli && class(model)[1] %in% c("glm", "glmmTMB")) {
7476
if (verbose) {
7577
insight::format_alert("Can't calculate accurate R2 for binomial models that are not Bernoulli models.")
7678
}
7779
return(NULL)
7880
}
81+
# currently, beta-binomial models without proportion response are not supported
82+
if (info$is_betabinomial && matrix_response) {
83+
if (verbose) {
84+
insight::format_warning("Can't calculate accurate R2 for beta-binomial models with matrix-response formulation.")
85+
}
86+
return(NULL)
87+
}
7988
# if no deviance, return NULL
8089
if (is.null(model$deviance)) {
8190
return(NULL)
@@ -96,7 +105,7 @@ r2_coxsnell.glmmTMB <- function(model, verbose = TRUE, ...) {
96105
info <- suppressWarnings(insight::model_info(model, verbose = FALSE))
97106
}
98107
# Cox & Snell's R2 is not defined for binomial models that are not Bernoulli models
99-
if (info$is_binomial && !info$is_bernoulli) {
108+
if (info$is_binomial && !info$is_bernoulli && !info$is_betabinomial) {
100109
if (verbose) {
101110
insight::format_alert("Can't calculate accurate R2 for binomial models that are not Bernoulli models.")
102111
}

R/r2_mcfadden.R

+12-1
Original file line numberDiff line numberDiff line change
@@ -63,13 +63,21 @@ r2_mcfadden.glm <- function(model, verbose = TRUE, ...) {
6363
if (is.null(info)) {
6464
info <- suppressWarnings(insight::model_info(model, verbose = FALSE))
6565
}
66+
matrix_response <- grepl("cbind", insight::find_response(model), fixed = TRUE)
6667

67-
if (info$is_binomial && !info$is_bernoulli && class(model)[1] == "glm") {
68+
if (info$is_binomial && !info$is_betabinomial && !info$is_bernoulli && class(model)[1] %in% c("glm", "glmmTMB")) {
6869
if (verbose) {
6970
insight::format_warning("Can't calculate accurate R2 for binomial models that are not Bernoulli models.")
7071
}
7172
return(NULL)
7273
}
74+
# currently, beta-binomial models without proportion response are not supported
75+
if (info$is_betabinomial && matrix_response) {
76+
if (verbose) {
77+
insight::format_warning("Can't calculate accurate R2 for beta-binomial models with matrix-response formulation.")
78+
}
79+
return(NULL)
80+
}
7381

7482
l_null <- insight::get_loglikelihood(stats::update(model, ~1))
7583
.r2_mcfadden(model, l_null)
@@ -99,6 +107,9 @@ r2_mcfadden.brmultinom <- r2_mcfadden.glm
99107
#' @export
100108
r2_mcfadden.censReg <- r2_mcfadden.glm
101109

110+
#' @export
111+
r2_mcfadden.glmmTMB <- r2_mcfadden.glm
112+
102113
#' @export
103114
r2_mcfadden.truncreg <- r2_mcfadden.glm
104115

performance.Rproj

+1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
Version: 1.0
2+
ProjectId: af6facf3-033e-40d4-ac22-2830774814a9
23

34
RestoreWorkspace: No
45
SaveWorkspace: No

tests/testthat/test-r2_mcfadden.R

+42
Original file line numberDiff line numberDiff line change
@@ -26,3 +26,45 @@ test_that("r2_mcfadden", {
2626
}
2727
)
2828
})
29+
30+
skip_if_not_installed("withr")
31+
32+
withr::with_environment(
33+
new.env(),
34+
{
35+
test_that("r2_mcfadden, glmmTMB-beta-binomial", {
36+
skip_if_not_installed("glmmTMB")
37+
set.seed(101)
38+
dd <- data.frame(x = rnorm(200))
39+
dd$y <- glmmTMB::simulate_new(
40+
~ 1 + x,
41+
newdata = dd,
42+
newparams = list(beta = c(0,1), betadisp = -1),
43+
weights = rep(10, nrow(dd)),
44+
family = glmmTMB::betabinomial()
45+
)[[1]]
46+
dd$success <- round(runif(nrow(dd), 0, dd$y))
47+
d <<- dd
48+
49+
m <- glmmTMB::glmmTMB(
50+
y/10 ~ 1 + x,
51+
data = d,
52+
weights = rep(10, nrow(d)),
53+
family = glmmTMB::betabinomial()
54+
)
55+
out1 <- r2(m)
56+
out2 <- r2_mcfadden(m)
57+
expect_equal(out1$R2, out2$R2, tolerance = 1e-4, ignore_attr = TRUE)
58+
expect_equal(out1$R2, 0.06892733, tolerance = 1e-4, ignore_attr = TRUE)
59+
60+
m <- glmmTMB::glmmTMB(
61+
cbind(y, success) ~ 1 + x,
62+
data = d,
63+
weights = rep(10, nrow(d)),
64+
family = glmmTMB::betabinomial()
65+
)
66+
expect_warning(r2(m), regex = "calculate accurate")
67+
expect_warning(r2_mcfadden(m), regex = "calculate accurate")
68+
})
69+
}
70+
)

0 commit comments

Comments
 (0)