skip_on_os("mac") # error: FreeADFunObject
osx <- tryCatch(
{
si <- Sys.info()
if (!is.null(si["sysname"])) {
si["sysname"] == "Darwin" || startsWith(R.version$os, "darwin")
} else {
FALSE
}
},
error = function(e) {
FALSE
}
)
if (requiet("TMB") && requiet("glmmTMB") && getRversion() >= "4.0.0") {
# fish <- read.csv("https://stats.idre.ucla.edu/stat/data/fish.csv")
# fish$nofish <- as.factor(fish$nofish)
# fish$livebait <- as.factor(fish$livebait)
# fish$camper <- as.factor(fish$camper)
data("fish")
m1 <- glmmTMB(
count ~ child + camper + (1 | persons),
ziformula = ~ child + camper + (1 | persons),
data = fish,
family = truncated_poisson()
)
m2 <- glmmTMB(
count ~ child + camper + (1 | persons),
data = fish,
family = poisson()
)
m3 <- glmmTMB(
count ~ child + camper + (1 | persons),
ziformula = ~ child + livebait + (1 | persons),
data = fish,
family = poisson()
)
m4 <- glmmTMB(
count ~ child + camper + (1 | persons),
ziformula = ~ child + livebait + (1 | ID),
dispformula = ~xb,
data = fish,
family = truncated_poisson()
)
m7 <- suppressWarnings(glmmTMB(
count ~ child + camper + (1 + xb | persons),
ziformula = ~ child + livebait + (1 + zg + nofish | ID),
dispformula = ~xb,
data = fish,
family = truncated_poisson()
))
data(Salamanders)
m5 <- glmmTMB(
count ~ mined + (1 | site),
ziformula = ~mined,
family = poisson,
data = Salamanders
)
m6 <-
glmmTMB(count ~ 1,
ziformula = ~1,
family = poisson(),
data = Salamanders
)
test_that("find_weights", {
expect_null(find_weights(m2))
})
test_that("get_weights", {
expect_null(get_weights(m2))
})
test_that("get_deviance + logLik", {
expect_equal(get_deviance(m2), 1697.449311, tolerance = 1e-3)
expect_equal(get_loglikelihood(m2), logLik(m2), tolerance = 1e-3, ignore_attr = TRUE)
expect_identical(get_df(m2, type = "model"), 4L)
})
test_that("get_df", {
expect_equal(
get_df(m2, type = "residual"),
df.residual(m2),
ignore_attr = TRUE
)
expect_equal(
get_df(m2, type = "normal"),
Inf,
ignore_attr = TRUE
)
expect_equal(
get_df(m2, type = "wald"),
Inf,
ignore_attr = TRUE
)
expect_equal(
get_df(m2, type = "ml1"),
c(`(Intercept)` = 247, child = 247, camper1 = 247),
ignore_attr = TRUE
)
})
test_that("model_info", {
expect_true(model_info(m1)$is_zero_inflated)
expect_false(model_info(m2)$is_zero_inflated)
expect_true(model_info(m3)$is_count)
expect_true(model_info(m3)$is_pois)
expect_false(model_info(m3)$is_negbin)
expect_true(model_info(m6)$is_count)
expect_false(model_info(m1)$is_linear)
})
test_that("clean_names", {
expect_identical(clean_names(m1), c("count", "child", "camper", "persons"))
expect_identical(clean_names(m2), c("count", "child", "camper", "persons"))
expect_identical(
clean_names(m3),
c("count", "child", "camper", "persons", "livebait")
)
expect_identical(
clean_names(m4),
c(
"count",
"child",
"camper",
"persons",
"livebait",
"ID",
"xb"
)
)
expect_identical(clean_names(m6), "count")
})
test_that("find_predictors", {
expect_identical(
find_predictors(m1, effects = "all"),
list(
conditional = c("child", "camper"),
random = "persons",
zero_inflated = c("child", "camper"),
zero_inflated_random = "persons"
)
)
expect_identical(
find_predictors(m1, effects = "all", flatten = TRUE),
c("child", "camper", "persons")
)
expect_identical(
find_predictors(m1, effects = "random"),
list(random = "persons", zero_inflated_random = "persons")
)
expect_identical(
find_predictors(m1, effects = "random", flatten = TRUE),
"persons"
)
expect_identical(
find_predictors(m1, effects = "random", component = "conditional"),
list(random = "persons")
)
expect_identical(
find_predictors(
m1,
effects = "random",
component = "conditional",
flatten = TRUE
),
"persons"
)
expect_identical(
find_predictors(m1),
list(
conditional = c("child", "camper"),
zero_inflated = c("child", "camper")
)
)
expect_identical(find_predictors(m1, flatten = TRUE), c("child", "camper"))
expect_identical(
find_predictors(m2, effects = "all"),
list(
conditional = c("child", "camper"),
random = "persons"
)
)
expect_identical(
find_predictors(m2, effects = "all", flatten = TRUE),
c("child", "camper", "persons")
)
expect_identical(
find_predictors(m2, effects = "random"),
list(random = "persons")
)
expect_identical(
find_predictors(m2, effects = "random", flatten = TRUE),
"persons"
)
expect_identical(find_predictors(m2), list(conditional = c("child", "camper")))
expect_null(find_predictors(m6))
})
test_that("find_response", {
expect_identical(find_response(m1), "count")
expect_identical(find_response(m2), "count")
expect_identical(find_response(m6), "count")
})
test_that("link_inverse", {
expect_identical(link_inverse(m1)(0.2), exp(0.2))
expect_identical(link_inverse(m2)(0.2), exp(0.2))
})
test_that("get_data", {
expect_identical(
colnames(get_data(m1)),
c("count", "child", "camper", "persons")
)
expect_identical(
colnames(get_data(m1, effects = "all")),
c("count", "child", "camper", "persons")
)
expect_identical(colnames(get_data(m1, effects = "random")), "persons")
expect_identical(
colnames(get_data(m2)),
c("count", "child", "camper", "persons")
)
expect_identical(
colnames(get_data(m2, effects = "all")),
c("count", "child", "camper", "persons")
)
expect_identical(colnames(get_data(m2, effects = "random", verbose = FALSE)), "persons")
get_data(m3)
expect_identical(colnames(get_data(m6, verbose = FALSE)), "count")
expect_null(get_data(m6, effects = "random", verbose = FALSE))
})
test_that("find_predictors", {
expect_identical(
find_predictors(m3, effects = "fixed", component = "conditional"),
list(conditional = c("child", "camper"))
)
expect_identical(
find_predictors(
m3,
effects = "fixed",
component = "conditional",
flatten = TRUE
),
c("child", "camper")
)
expect_identical(
find_predictors(m3, effects = "fixed", component = "zero_inflated"),
list(zero_inflated = c("child", "livebait"))
)
expect_identical(
find_predictors(
m3,
effects = "fixed",
component = "zero_inflated",
flatten = TRUE
),
c("child", "livebait")
)
expect_identical(
find_predictors(m3, effects = "all", component = "conditional"),
list(
conditional = c("child", "camper"),
random = "persons"
)
)
expect_identical(
find_predictors(
m3,
effects = "all",
component = "conditional",
flatten = TRUE
),
c("child", "camper", "persons")
)
expect_identical(
find_predictors(m3, effects = "all", component = "zero_inflated"),
list(
zero_inflated = c("child", "livebait"),
zero_inflated_random = "persons"
)
)
expect_identical(
find_predictors(
m3,
effects = "all",
component = "zero_inflated",
flatten = TRUE
),
c("child", "livebait", "persons")
)
expect_identical(
find_predictors(m3, effects = "random", component = "conditional"),
list(random = "persons")
)
expect_identical(
find_predictors(
m3,
effects = "random",
component = "conditional",
flatten = TRUE
),
"persons"
)
expect_identical(
find_predictors(m3, effects = "random", component = "zero_inflated"),
list(zero_inflated_random = "persons")
)
expect_identical(
find_predictors(
m3,
effects = "random",
component = "zero_inflated",
flatten = TRUE
),
"persons"
)
expect_identical(
find_predictors(m3, effects = "fixed", component = "all"),
list(
conditional = c("child", "camper"),
zero_inflated = c("child", "livebait")
)
)
expect_identical(
find_predictors(
m3,
effects = "fixed",
component = "all",
flatten = TRUE
),
c("child", "camper", "livebait")
)
expect_identical(
find_predictors(m3, effects = "all", component = "all"),
list(
conditional = c("child", "camper"),
random = "persons",
zero_inflated = c("child", "livebait"),
zero_inflated_random = "persons"
)
)
expect_identical(
find_predictors(
m3,
effects = "all",
component = "all",
flatten = TRUE
),
c("child", "camper", "persons", "livebait")
)
expect_identical(
find_predictors(m3, effects = "random", component = "all"),
list(random = "persons", zero_inflated_random = "persons")
)
expect_identical(
find_predictors(
m3,
effects = "random",
component = "all",
flatten = TRUE
),
"persons"
)
expect_null(find_predictors(
m6,
effects = "random",
component = "all",
flatten = TRUE
))
})
test_that("find_formula", {
expect_length(find_formula(m4), 5)
expect_equal(
find_formula(m4),
list(
conditional = as.formula("count ~ child + camper"),
random = as.formula("~1 | persons"),
zero_inflated = as.formula("~child + livebait"),
zero_inflated_random = as.formula("~1 | ID"),
dispersion = as.formula("~xb")
),
ignore_attr = TRUE
)
expect_equal(find_formula(m6), list(conditional = as.formula("count ~ 1")), ignore_attr = TRUE)
})
test_that("find_predictors", {
expect_identical(
find_predictors(m4),
list(
conditional = c("child", "camper"),
zero_inflated = c("child", "livebait"),
dispersion = "xb"
)
)
expect_identical(
find_predictors(m4, flatten = TRUE),
c("child", "camper", "livebait", "xb")
)
expect_identical(
find_predictors(m4, effects = "random"),
list(random = "persons", zero_inflated_random = "ID")
)
expect_identical(
find_predictors(m4, effects = "all", flatten = TRUE),
c("child", "camper", "persons", "livebait", "ID", "xb")
)
expect_identical(
find_predictors(m4, effects = "all"),
list(
conditional = c("child", "camper"),
random = "persons",
zero_inflated = c("child", "livebait"),
zero_inflated_random = "ID",
dispersion = "xb"
)
)
expect_identical(
find_predictors(m4, component = "conditional", flatten = TRUE),
c("child", "camper")
)
expect_identical(
find_predictors(m4, component = "conditional", flatten = FALSE),
list(conditional = c("child", "camper"))
)
expect_identical(
find_predictors(m4, effects = "random", component = "conditional"),
list(random = "persons")
)
expect_identical(
find_predictors(m4, effects = "all", component = "conditional"),
list(
conditional = c("child", "camper"),
random = "persons"
)
)
expect_identical(
find_predictors(m4, component = "zero_inflated"),
list(zero_inflated = c("child", "livebait"))
)
expect_identical(
find_predictors(m4, effects = "random", component = "zero_inflated"),
list(zero_inflated_random = "ID")
)
expect_identical(
find_predictors(
m4,
effects = "all",
component = "zero_inflated",
flatten = TRUE
),
c("child", "livebait", "ID")
)
expect_identical(
find_predictors(m4, component = "dispersion"),
list(dispersion = "xb")
)
expect_identical(
find_predictors(m4, component = "dispersion", flatten = TRUE),
"xb"
)
expect_null(find_predictors(m4, effects = "random", component = "dispersion"))
expect_identical(
find_predictors(m4, effects = "all", component = "dispersion"),
list(dispersion = "xb")
)
expect_identical(
find_predictors(
m4,
effects = "all",
component = "dispersion",
flatten = TRUE
),
"xb"
)
})
test_that("find_random", {
expect_identical(
find_random(m4),
list(random = "persons", zero_inflated_random = "ID")
)
expect_identical(find_random(m4, flatten = TRUE), c("persons", "ID"))
expect_null(find_random(m6, flatten = TRUE))
})
test_that("find_respone", {
expect_identical(find_response(m4), "count")
expect_identical(find_response(m6), "count")
})
test_that("find_terms", {
expect_identical(
find_terms(m4),
list(
response = "count",
conditional = c("child", "camper"),
random = "persons",
zero_inflated = c("child", "livebait"),
zero_inflated_random = "ID",
dispersion = "xb"
)
)
expect_identical(
find_terms(m4, flatten = TRUE),
c(
"count",
"child",
"camper",
"persons",
"livebait",
"ID",
"xb"
)
)
expect_identical(find_terms(m6), list(response = "count", conditional = "1"))
expect_identical(find_terms(m6, flatten = TRUE), c("count", "1"))
})
test_that("find_variables", {
expect_identical(
find_variables(m4),
list(
response = "count",
conditional = c("child", "camper"),
random = "persons",
zero_inflated = c("child", "livebait"),
zero_inflated_random = "ID",
dispersion = "xb"
)
)
expect_identical(
find_variables(m4, flatten = TRUE),
c(
"count",
"child",
"camper",
"persons",
"livebait",
"ID",
"xb"
)
)
expect_identical(find_variables(m6), list(response = "count"))
expect_identical(find_variables(m6, flatten = TRUE), "count")
})
test_that("get_response", {
expect_identical(get_response(m4), fish$count)
expect_identical(get_response(m6), Salamanders$count)
})
test_that("get_predictors", {
expect_identical(
colnames(get_predictors(m4)),
c("child", "camper", "livebait", "xb")
)
expect_null(get_predictors(m6, verbose = FALSE))
})
test_that("get_random", {
expect_identical(colnames(get_random(m4)), c("persons", "ID"))
expect_warning(expect_null(get_random(m6)))
})
test_that("get_data", {
expect_identical(
colnames(get_data(m4)),
c(
"count",
"child",
"camper",
"persons",
"livebait",
"ID",
"xb"
)
)
expect_identical(
colnames(get_data(m4, effects = "fixed")),
c("count", "child", "camper", "livebait", "xb")
)
expect_identical(colnames(get_data(m4, effects = "random")), c("persons", "ID"))
expect_identical(colnames(get_data(m4, component = "zi")), c("child", "livebait", "ID", "count"))
expect_identical(colnames(get_data(
m4,
component = "zi", effects = "fixed"
)), c("child", "livebait", "count"))
expect_identical(colnames(get_data(
m4,
component = "zi", effects = "random"
)), "ID")
expect_identical(
colnames(get_data(m4, component = "cond")),
c("count", "child", "camper", "persons")
)
expect_identical(colnames(get_data(
m4,
component = "cond", effects = "fixed"
)), c("count", "child", "camper"))
expect_identical(colnames(get_data(
m4,
component = "cond", effects = "random"
)), "persons")
expect_identical(colnames(get_data(m4, component = "disp")), c("xb", "count"))
expect_identical(colnames(get_data(
m4,
component = "disp", effects = "fixed"
)), c("xb", "count"))
expect_null(get_data(m4, component = "disp", effects = "random", verbose = FALSE))
})
test_that("find_paramaters", {
expect_identical(
find_parameters(m4),
list(
conditional = c("(Intercept)", "child", "camper1"),
random = list(persons = "(Intercept)"),
zero_inflated = c("(Intercept)", "child", "livebait1"),
zero_inflated_random = list(ID = "(Intercept)")
)
)
expect_identical(
find_parameters(m4, flatten = TRUE),
c("(Intercept)", "child", "camper1", "livebait1")
)
expect_identical(
find_parameters(m6),
list(
conditional = "(Intercept)",
zero_inflated = "(Intercept)"
)
)
expect_identical(
find_parameters(m3),
list(
conditional = c("(Intercept)", "child", "camper1"),
random = list(persons = "(Intercept)"),
zero_inflated = c("(Intercept)", "child", "livebait1"),
zero_inflated_random = list(persons = "(Intercept)")
)
)
expect_identical(
find_parameters(m3),
list(
conditional = c("(Intercept)", "child", "camper1"),
random = list(persons = "(Intercept)"),
zero_inflated = c("(Intercept)", "child", "livebait1"),
zero_inflated_random = list(persons = "(Intercept)")
)
)
expect_identical(
find_parameters(m3, effects = "fixed"),
list(
conditional = c("(Intercept)", "child", "camper1"),
zero_inflated = c("(Intercept)", "child", "livebait1")
)
)
expect_identical(
find_parameters(m3, effects = "random", component = "zi"),
list(zero_inflated_random = list(persons = "(Intercept)"))
)
expect_identical(
find_parameters(
m3,
effects = "fixed",
component = "zi",
flatten = TRUE
),
c("(Intercept)", "child", "livebait1")
)
})
test_that("get_paramaters", {
expect_identical(nrow(get_parameters(m4)), 6L)
expect_identical(
colnames(get_parameters(m4)),
c("Parameter", "Estimate", "Component")
)
expect_identical(
get_parameters(m4)$Parameter,
c(
"(Intercept)",
"child",
"camper1",
"(Intercept)",
"child",
"livebait1"
)
)
expect_identical(
get_parameters(m4)$Component,
c(
"conditional",
"conditional",
"conditional",
"zero_inflated",
"zero_inflated",
"zero_inflated"
)
)
expect_identical(
get_parameters(m6)$Parameter,
c("(Intercept)", "(Intercept)")
)
expect_identical(
get_parameters(m2)$Parameter,
c("(Intercept)", "child", "camper1")
)
expect_identical(
get_parameters(m2, component = "all")$Parameter,
c("(Intercept)", "child", "camper1")
)
expect_null(get_parameters(m2, component = "zi"))
})
test_that("linkfun", {
expect_false(is.null(link_function(m1)))
expect_false(is.null(link_function(m2)))
expect_false(is.null(link_function(m3)))
expect_false(is.null(link_function(m4)))
})
test_that("is_multivariate", {
expect_false(is_multivariate(m1))
expect_false(is_multivariate(m2))
expect_false(is_multivariate(m3))
expect_false(is_multivariate(m4))
})
data("Salamanders")
mpred <- glmmTMB(
count ~ mined + (1 | site),
zi = ~mined,
family = poisson, data = Salamanders
)
test_that("get_predicted with new levels", {
pr <- get_predicted(mpred, data = head(Salamanders), allow.new.levels = TRUE)
expect_equal(as.vector(pr), c(0.252, 0.39207, 0.21119, 2.20128, 2.39424, 2.28901), tolerance = 1e-3)
})
# test_that("get_variance", {
#
# expect_warning(expect_equal(get_variance(m5), list(
# var.fixed = 0.32588694431268194762,
# var.random = 0.07842738279575413307,
# var.residual = 0.41218000030914692111,
# var.distribution = 0.41218000030914692111,
# var.dispersion = 0,
# var.intercept = c(site = 0.07842738279575474369)
# ),
# tolerance = 1e-3))
#
# expect_warning(expect_equal(get_variance_fixed(m1), c(var.fixed = 1.09712435712435052437), tolerance = 1e-3))
# expect_warning(expect_equal(get_variance_random(m1), c(var.random = 0.86712737445492238386), tolerance = 1e-3))
# expect_warning(expect_equal(get_variance_residual(m1), c(var.residual = 0.02634500773355940087 ), tolerance = 1e-3))
# expect_warning(expect_equal(get_variance_distribution(m1), c(var.distribution = 0.02634500773355940087 ), tolerance = 1e-3))
# expect_warning(expect_equal(get_variance_dispersion(m1), c(var.dispersion = 0), tolerance = 1e-3))
# })
test_that("find_algorithm", {
expect_identical(
find_algorithm(m1),
list(algorithm = "ML", optimizer = "nlminb")
)
})
test_that("find_random_slopes", {
skip_on_cran()
skip_on_travis()
expect_null(find_random_slopes(m6))
expect_identical(
find_random_slopes(m7),
list(
random = "xb",
zero_inflated_random = c("zg", "nofish")
)
)
})
test_that("clean_parameters", {
expect_identical(
clean_parameters(m1),
structure(
list(
Parameter = c(
"(Intercept)",
"child",
"camper1",
"(Intercept)",
"(Intercept)",
"child",
"camper1",
"(Intercept)"
),
Effects = c(
"fixed",
"fixed",
"fixed",
"random",
"fixed",
"fixed",
"fixed",
"random"
),
Component = c(
"conditional",
"conditional",
"conditional",
"conditional",
"zero_inflated",
"zero_inflated",
"zero_inflated",
"zero_inflated"
),
Group = c("", "", "", "persons", "", "", "", "persons"),
Cleaned_Parameter = c(
"(Intercept)",
"child",
"camper1",
"(Intercept)",
"(Intercept)",
"child",
"camper1",
"(Intercept)"
)
),
class = c("clean_parameters", "data.frame"),
row.names = c(NA, -8L)
)
)
})
test_that("find_statistic", {
expect_identical(find_statistic(m1), "z-statistic")
expect_identical(find_statistic(m2), "z-statistic")
expect_identical(find_statistic(m3), "z-statistic")
expect_identical(find_statistic(m4), "z-statistic")
expect_identical(find_statistic(m5), "z-statistic")
expect_identical(find_statistic(m6), "z-statistic")
expect_identical(find_statistic(m7), "z-statistic")
})
# dispersion model, example from ?glmmTMB
sim1 <- function(nfac = 40, nt = 100, facsd = 0.1, tsd = 0.15, mu = 0, residsd = 1) {
dat <- expand.grid(fac = factor(letters[1:nfac]), t = 1:nt)
n <- nrow(dat)
dat$REfac <- rnorm(nfac, sd = facsd)[dat$fac]
dat$REt <- rnorm(nt, sd = tsd)[dat$t]
dat$x <- rnorm(n, mean = mu, sd = residsd) + dat$REfac + dat$REt
dat
}
set.seed(101)
d1 <- sim1(mu = 100, residsd = 10)
d2 <- sim1(mu = 200, residsd = 5)
d1$sd <- "ten"
d2$sd <- "five"
dat <- rbind(d1, d2)
m0 <- glmmTMB(x ~ sd + (1 | t), dispformula = ~sd, data = dat)
test_that("get_paramaters", {
expect_identical(nrow(get_parameters(m0)), 4L)
expect_identical(
colnames(get_parameters(m0)),
c("Parameter", "Estimate", "Component")
)
expect_identical(
get_parameters(m0)$Parameter,
c(
"(Intercept)",
"sdten",
"(Intercept)",
"sdten"
)
)
expect_equal(
get_parameters(m0)$Estimate,
c(200.03431, -99.71491, 3.20287, 1.38648),
tolerance = 1e-3
)
expect_identical(
get_parameters(m0)$Component,
c("conditional", "conditional", "dispersion", "dispersion")
)
})
if (!osx && packageVersion("glmmTMB") > "1.1.4") {
test_that("get_predicted", {
# response
x <- get_predicted(m1, predict = "expectation", verbose = FALSE, include_random = TRUE)
y <- get_predicted(m1, predict = "response", include_random = TRUE)
z <- predict(m1, type = "response")
expect_equal(x, y, ignore_attr = TRUE)
expect_equal(x, z, ignore_attr = TRUE)
expect_equal(y, z, ignore_attr = TRUE)
get_predicted(m1, predict = NULL, type = "response")
# should be the same, when include_random = "default"
x <- get_predicted(m1, predict = "expectation", verbose = FALSE)
y <- get_predicted(m1, predict = "response")
z <- predict(m1, type = "response")
expect_equal(x, y, ignore_attr = TRUE)
expect_equal(x, z, ignore_attr = TRUE)
expect_equal(y, z, ignore_attr = TRUE)
# link
x <- get_predicted(m1, predict = "link", include_random = TRUE)
y <- get_predicted(m1, predict = NULL, type = "link", include_random = TRUE)
z <- predict(m1, type = "link")
expect_equal(x, y, ignore_attr = TRUE)
expect_equal(y, z, ignore_attr = TRUE)
expect_equal(x, z, ignore_attr = TRUE)
# unsupported: zprob
x <- suppressWarnings(get_predicted(m1, predict = "zprob", include_random = TRUE))
y <- get_predicted(m1, predict = NULL, type = "zprob", include_random = TRUE)
z <- predict(m1, type = "zprob")
expect_identical(x, y)
expect_equal(x, z, ignore_attr = TRUE)
## TODO
# not official supported raise warning
# expect_warning(get_predicted(m1, predict = "zprob"))
# expect_warning(get_predicted(m1, predict = "zprob", verbose = FALSE), NA)
# the second warning is raised for zero-inflation models only. remove when
# the zprob correction is implemented
expect_warning(get_predicted(m1, predict = "prediction"))
expect_warning(get_predicted(m1, predict = "classification"))
})
}
}
Generated by dwww version 1.15 on Sat May 18 10:07:10 CEST 2024.