Skip to content

Commit

Permalink
fix
Browse files Browse the repository at this point in the history
  • Loading branch information
@strengejacke
strengejacke committed Nov 23, 2023
1 parent 3eec4af commit dddd414
Showing 1 changed file with 71 additions and 65 deletions.
136 changes: 71 additions & 65 deletions tests/testthat/test-r2.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,68 +40,74 @@ test_that("r2 glm, ci", {
)
})

test_that("r2 glmmTMB, no ranef", {
skip_if_not_installed("glmmTMB")
data(Owls, package = "glmmTMB")
# linear ---------------------------------------------------------------
m <- glmmTMB::glmmTMB(NegPerChick ~ BroodSize + ArrivalTime, data = Owls)
out <- r2(m)
expect_equal(out$R2, 0.05597288, tolerance = 1e-3, ignore_attr = TRUE)
# validate against lm
m2 <- lm(NegPerChick ~ BroodSize + ArrivalTime, data = Owls)
out2 <- r2(m2)
expect_equal(out$R2, out2$R2, tolerance = 1e-3, ignore_attr = TRUE)
# binomial -------------------------------------------------------------
data(mtcars)
m <- glmmTMB::glmmTMB(am ~ mpg, data = mtcars, family = binomial())
out <- r2(m)
expect_equal(out[[1]], 0.3677326, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(am ~ mpg, data = mtcars, family = binomial())
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# poisson --------------------------------------------------------------
d <- data.frame(
counts = c(18, 17, 15, 20, 10, 20, 25, 13, 12),
outcome = gl(3, 1, 9),
treatment = gl(3, 3)
)
m <- glmmTMB::glmmTMB(counts ~ outcome + treatment, family = poisson(), data = d)
out <- r2(m)
expect_equal(out[[1]], 0.6571698, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(counts ~ outcome + treatment, family = poisson(), data = d)
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# zero-inflated --------------------------------------------------------------
skip_if_not_installed("pscl")
data(bioChemists, package = "pscl")
m <- glmmTMB::glmmTMB(
art ~ fem + mar + kid5 + ment,
ziformula = ~kid5 + phd,
family = poisson(),
data = bioChemists
)
out <- r2(m)
expect_equal(out[[1]], 0.1797549, tolerance = 1e-3, ignore_attr = TRUE)
# validate against pscl::zeroinfl
m2 <- pscl::zeroinfl(
art ~ fem + mar + kid5 + ment | kid5 + phd,
data = bioChemists
)
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# Gamma --------------------------------------------------------------
clotting <- data.frame(
u = c(5, 10, 15, 20, 30, 40, 60, 80, 100),
lot1 = c(118, 58, 42, 35, 27, 25, 21, 19, 18),
lot2 = c(69, 35, 26, 21, 18, 16, 13, 12, 12)
)
m <- suppressWarnings(glmmTMB::glmmTMB(lot1 ~ log(u), data = clotting, family = Gamma()))
out <- r2(m)
expect_equal(out[[1]], 0.996103, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(lot1 ~ log(u), data = clotting, family = Gamma())
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
})
# glmmTMB, non-mixed --------------------------------------------------------

skip_if_not_installed("withr")
withr::with_environment(
new.env(),
test_that("r2 glmmTMB, no ranef", {
skip_if_not_installed("glmmTMB")
data(Owls, package = "glmmTMB")
# linear ---------------------------------------------------------------
m <- glmmTMB::glmmTMB(NegPerChick ~ BroodSize + ArrivalTime, data = Owls)
out <- r2(m)
expect_equal(out$R2, 0.05597288, tolerance = 1e-3, ignore_attr = TRUE)
# validate against lm
m2 <- lm(NegPerChick ~ BroodSize + ArrivalTime, data = Owls)
out2 <- r2(m2)
expect_equal(out$R2, out2$R2, tolerance = 1e-3, ignore_attr = TRUE)
# binomial -------------------------------------------------------------
data(mtcars)
m <- glmmTMB::glmmTMB(am ~ mpg, data = mtcars, family = binomial())
out <- r2(m)
expect_equal(out[[1]], 0.3677326, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(am ~ mpg, data = mtcars, family = binomial())
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# poisson --------------------------------------------------------------
d <- data.frame(
counts = c(18, 17, 15, 20, 10, 20, 25, 13, 12),
outcome = gl(3, 1, 9),
treatment = gl(3, 3)
)
m <- glmmTMB::glmmTMB(counts ~ outcome + treatment, family = poisson(), data = d)
out <- r2(m)
expect_equal(out[[1]], 0.6571698, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(counts ~ outcome + treatment, family = poisson(), data = d)
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# zero-inflated --------------------------------------------------------------
skip_if_not_installed("pscl")
data(bioChemists, package = "pscl")
m <- glmmTMB::glmmTMB(
art ~ fem + mar + kid5 + ment,
ziformula = ~kid5 + phd,
family = poisson(),
data = bioChemists
)
out <- r2(m)
expect_equal(out[[1]], 0.1797549, tolerance = 1e-3, ignore_attr = TRUE)
# validate against pscl::zeroinfl
m2 <- pscl::zeroinfl(
art ~ fem + mar + kid5 + ment | kid5 + phd,
data = bioChemists
)
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
# Gamma --------------------------------------------------------------
clotting <- data.frame(
u = c(5, 10, 15, 20, 30, 40, 60, 80, 100),
lot1 = c(118, 58, 42, 35, 27, 25, 21, 19, 18),
lot2 = c(69, 35, 26, 21, 18, 16, 13, 12, 12)
)
m <- suppressWarnings(glmmTMB::glmmTMB(lot1 ~ log(u), data = clotting, family = Gamma()))
out <- r2(m)
expect_equal(out[[1]], 0.996103, tolerance = 1e-3, ignore_attr = TRUE)
# validate against glm
m2 <- glm(lot1 ~ log(u), data = clotting, family = Gamma())
out2 <- r2(m2)
expect_equal(out[[1]], out2[[1]], tolerance = 1e-3, ignore_attr = TRUE)
})
)

0 comments on commit dddd414

Please sign in to comment.