skip_if_not_installed("withr") skip_if_not_installed("glmmTMB") skip_if_not(getRversion() >= "4.0.0") data("fish") data("Salamanders", package = "glmmTMB") skip_on_cran() withr::with_options( list(parameters_exponentiate = FALSE), { m1 <- suppressWarnings(glmmTMB::glmmTMB( count ~ child + camper + (1 | persons), ziformula = ~ child + camper + (1 | persons), data = fish, family = glmmTMB::truncated_poisson() )) m2 <- suppressWarnings(glmmTMB::glmmTMB( count ~ child + camper + (1 | persons), data = fish, family = poisson() )) m3 <- suppressWarnings(glmmTMB::glmmTMB( count ~ spp + mined + (1 | site), ziformula = ~ spp + mined, family = glmmTMB::nbinom2, data = Salamanders )) test_that("unsupported args", { expect_message(model_parameters(m1, vcov = "HC3", effects = "fixed", component = "conditional")) expect_message(model_parameters(m1, vcov = "HC3")) }) test_that("ci", { expect_equal( ci(m1)$CI_low, c(0.33067, -1.32402, 0.55037, -1.66786, 1.44667, -1.64177), tolerance = 1e-3 ) expect_equal( ci(m1, component = "cond")$CI_low, c(0.33067, -1.32402, 0.55037), tolerance = 1e-3 ) expect_equal( ci(m1, component = "zi")$CI_low, c(-1.66786, 1.44667, -1.64177), tolerance = 1e-3 ) expect_equal( ci(m2)$CI_low, c(-0.47982, -1.85096, 0.76044), tolerance = 1e-3 ) expect_equal( ci(m2, component = "cond")$CI_low, c(-0.47982, -1.85096, 0.76044), tolerance = 1e-3 ) expect_message( expect_null(ci(m2, component = "zi")), "no zero-inflation component" ) }) test_that("se", { expect_equal( standard_error(m1)$SE, c(0.47559, 0.09305, 0.09346, 0.65229, 0.3099, 0.32324), tolerance = 1e-3 ) expect_equal( standard_error(m1, component = "cond")$SE, c(0.47559, 0.09305, 0.09346), tolerance = 1e-3 ) expect_equal( standard_error(m1, component = "zi")$SE, c(0.65229, 0.3099, 0.32324), tolerance = 1e-3 ) expect_equal( standard_error(m2)$SE, c(0.62127, 0.08128, 0.08915), tolerance = 1e-3 ) expect_equal( standard_error(m2, component = "cond")$SE, c(0.62127, 0.08128, 0.08915), tolerance = 1e-3 ) expect_message( expect_null(standard_error(m2, component = "zi")), "no zero-inflation component" ) }) test_that("p_value", { expect_equal( p_value(m1)$p, c(0.00792, 0, 0, 0.55054, 0, 0.00181), tolerance = 1e-3 ) expect_equal( p_value(m1, component = "cond")$p, c(0.00792, 0, 0), tolerance = 1e-3 ) expect_equal( p_value(m1, component = "zi")$p, c(0.55054, 0, 0.00181), tolerance = 1e-3 ) expect_equal( p_value(m2)$p, c(0.23497, 0, 0), tolerance = 1e-3 ) expect_equal( p_value(m2, component = "cond")$p, c(0.23497, 0, 0), tolerance = 1e-3 ) expect_message( expect_null(p_value(m2, component = "zi")), "no zero-inflation component" ) }) test_that("model_parameters", { expect_equal( model_parameters(m1, effects = "fixed")$Coefficient, c(1.2628, -1.14165, 0.73354, -0.38939, 2.05407, -1.00823), tolerance = 1e-3 ) expect_equal( model_parameters(m1, effects = "all")$Coefficient, c(1.2628, -1.14165, 0.73354, -0.38939, 2.05407, -1.00823, 0.9312, 1.17399), tolerance = 1e-3 ) expect_equal( model_parameters(m2, effects = "fixed")$Coefficient, c(0.73785, -1.69166, 0.93516), tolerance = 1e-3 ) expect_equal( model_parameters(m3, effects = "fixed")$Coefficient, c( -0.61038, -0.9637, 0.17068, -0.38706, 0.48795, 0.58949, -0.11327, 1.42935, 0.91004, 1.16141, -0.93932, 1.04243, -0.56231, -0.893, -2.53981, -2.56303, 1.51165 ), tolerance = 1e-2 ) expect_identical( model_parameters(m1)$Component, c( "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "conditional", "zero_inflated" ) ) expect_null(model_parameters(m2, effects = "fixed")$Component) expect_identical( model_parameters(m2)$Component, c("conditional", "conditional", "conditional", "conditional") ) expect_identical( model_parameters(m3, effects = "fixed")$Component, c( "conditional", "conditional", "conditional", "conditional", "conditional", "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated", "dispersion" ) ) expect_equal( model_parameters(m3, effects = "fixed")$SE, c( 0.4052, 0.6436, 0.2353, 0.3424, 0.2383, 0.2278, 0.2439, 0.3666, 0.6279, 1.3346, 0.8005, 0.714, 0.7263, 0.7535, 2.1817, 0.6045, NA ), tolerance = 1e-2 ) }) test_that("model_parameters.mixed-random", { params <- model_parameters(m1, effects = "random", group_level = TRUE) expect_identical(c(nrow(params), ncol(params)), c(8L, 10L)) expect_named( params, c( "Parameter", "Level", "Coefficient", "SE", "CI", "CI_low", "CI_high", "Component", "Effects", "Group" ) ) expect_identical( as.vector(params$Parameter), c( "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)" ) ) expect_identical( params$Component, c( "conditional", "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated" ) ) expect_equal( params$Coefficient, c(-1.24, -0.3456, 0.3617, 1.2553, 1.5719, 0.3013, -0.3176, -1.5665), tolerance = 1e-2 ) }) test_that("model_parameters.mixed-ran_pars", { params <- model_parameters(m1, effects = "random") expect_identical(c(nrow(params), ncol(params)), c(2L, 9L)) expect_named( params, c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "Effects", "Group", "Component") ) expect_identical( params$Parameter, c("SD (Intercept)", "SD (Intercept)") ) expect_identical( params$Component, c("conditional", "zero_inflated") ) expect_equal( params$Coefficient, c(0.9312, 1.17399), tolerance = 1e-2 ) }) test_that("model_parameters.mixed-all_pars", { params <- model_parameters(m1, effects = "all") expect_identical(c(nrow(params), ncol(params)), c(8L, 12L)) expect_named( params, c( "Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "z", "df_error", "p", "Effects", "Group", "Component" ) ) expect_identical( params$Parameter, c( "(Intercept)", "child", "camper1", "(Intercept)", "child", "camper1", "SD (Intercept)", "SD (Intercept)" ) ) expect_identical( params$Component, c( "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "conditional", "zero_inflated" ) ) expect_equal( params$Coefficient, c(1.2628, -1.14165, 0.73354, -0.38939, 2.05407, -1.00823, 0.9312, 1.17399), tolerance = 1e-2 ) }) test_that("model_parameters.mixed-all", { params <- model_parameters(m1, effects = "all", group_level = TRUE) expect_identical(c(nrow(params), ncol(params)), c(14L, 13L)) expect_named( params, c( "Parameter", "Level", "Coefficient", "SE", "CI", "CI_low", "CI_high", "z", "df_error", "p", "Component", "Effects", "Group" ) ) expect_identical( params$Parameter, c( "(Intercept)", "child", "camper1", "(Intercept)", "child", "camper1", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)", "(Intercept)" ) ) expect_identical( params$Component, c( "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "conditional", "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "zero_inflated" ) ) expect_equal( params$Coefficient, c( 1.2628, -1.1417, 0.7335, -0.3894, 2.0541, -1.0082, -1.24, -0.3456, 0.3617, 1.2553, 1.5719, 0.3013, -0.3176, -1.5665 ), tolerance = 1e-2 ) }) data(mtcars) mdisp <- glmmTMB::glmmTMB(hp ~ 0 + wt / mpg, mtcars) test_that("model_parameters, dispersion", { mp <- model_parameters(mdisp) expect_equal(mp$Coefficient, c(59.50992, -0.80396, 48.97731), tolerance = 1e-2) expect_identical(mp$Parameter, c("wt", "wt:mpg", "(Intercept)")) expect_identical(mp$Component, c("conditional", "conditional", "dispersion")) }) mdisp <- glmmTMB::glmmTMB(hp ~ 0 + wt / mpg + (1 | gear), mtcars) test_that("model_parameters, dispersion", { mp <- model_parameters(mdisp) expect_equal(mp$Coefficient, c(58.25869, -0.87868, 47.01676, 36.99492), tolerance = 1e-2) expect_identical(mp$Parameter, c("wt", "wt:mpg", "SD (Intercept)", "SD (Observations)")) expect_identical(mp$Component, c("conditional", "conditional", "conditional", "conditional")) }) m4 <- suppressWarnings(glmmTMB::glmmTMB( count ~ child + camper + (1 + xb | persons), ziformula = ~ child + camper + (1 + zg | persons), data = fish, family = glmmTMB::truncated_poisson() )) test_that("model_parameters.mixed-ran_pars", { expect_message( { params <- model_parameters(m4, effects = "random") }, regex = "Your model may" ) expect_identical(c(nrow(params), ncol(params)), c(6L, 9L)) expect_named( params, c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "Effects", "Group", "Component") ) expect_identical( params$Parameter, c( "SD (Intercept)", "SD (xb)", "Cor (Intercept~xb)", "SD (Intercept)", "SD (zg)", "Cor (Intercept~zg)" ) ) expect_identical( params$Component, c( "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated" ) ) expect_equal( params$Coefficient, c(3.40563, 1.21316, -1, 2.73583, 1.56833, 1), tolerance = 1e-2 ) }) # exponentiate for dispersion = sigma parameters ----------------------- set.seed(101) ## rbeta() function parameterized by mean and shape my_rbeta <- function(n, mu, shape0) { rbeta(n, shape1 = mu * shape0, shape2 = (1 - mu) * shape0) } n <- 100 ng <- 10 dd <- data.frame(x = rnorm(n), f = factor(rep(1:(n / ng), ng))) dd <- transform(dd, y = my_rbeta(n, mu = plogis(-1 + 2 * x + rnorm(ng)[f]), shape0 = 5)) m_exp <- glmmTMB::glmmTMB(y ~ x + (1 | f), family = glmmTMB::beta_family(), dd) test_that("model_parameters, exp, glmmTMB", { mp1 <- model_parameters(m_exp, exponentiate = TRUE) mp2 <- model_parameters(m_exp, exponentiate = FALSE) expect_equal(mp1$Coefficient, c(0.49271, 6.75824, 5.56294, 1.14541), tolerance = 1e-3) expect_equal(mp1$Coefficient[3:4], mp2$Coefficient[3:4], tolerance = 1e-3) }) test_that("model_parameters, no dispersion, glmmTMB", { mp1 <- model_parameters(m_exp, effects = "fixed", component = "conditional", exponentiate = TRUE) mp2 <- model_parameters(m_exp, effects = "fixed", component = "conditional", exponentiate = FALSE) expect_equal(mp1$Coefficient, unname(exp(unlist(glmmTMB::fixef(m_exp)$cond))), tolerance = 1e-3) expect_equal(mp2$Coefficient, unname(unlist(glmmTMB::fixef(m_exp)$cond)), tolerance = 1e-3) }) # proper printing --------------------- test_that("print-model_parameters glmmTMB", { skip_on_os(c("mac", "linux", "solaris")) skip_if_not(getRversion() >= "4.3.3") mp <- model_parameters(m4, effects = "fixed", component = "conditional") out <- utils::capture.output(print(mp)) expect_snapshot(out[-5]) mp <- model_parameters(m4, ci_random = TRUE, effects = "random", component = "conditional", verbose = FALSE) out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c( `SD (Intercept)` = "SD (Intercept)", `SD (xb)` = "SD (xb)", `Cor (Intercept~xb)` = "Cor (Intercept~xb)" ) ) expect_identical( substr(out, 1, 30), c( "# Random Effects", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (xb: persons) | ", "Cor (Intercept~xb: persons) | " ) ) expect_equal(mp$Coefficient, c(3.40563, 1.21316, -1), tolerance = 1e-3) expect_equal(mp$CI_low, c(1.64567, 0.5919, -1), tolerance = 1e-3) mp <- model_parameters(m4, ci_random = TRUE, effects = "fixed", component = "zero_inflated") out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c(`(Intercept)` = "(Intercept)", child = "child", camper1 = "camper [1]") ) expect_identical( substr(out, 1, 12), c( "# Fixed Effe", "", "Parameter ", "------------", "(Intercept) ", "child ", "camper [1] " ) ) expect_equal(mp$Coefficient, c(1.88964, 0.15712, -0.17007), tolerance = 1e-3) expect_equal(mp$CI_low, c(0.5878, -0.78781, -0.92836), tolerance = 1e-3) mp <- model_parameters(m4, ci_random = TRUE, effects = "random", component = "zero_inflated", verbose = FALSE) out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c( `SD (Intercept)` = "SD (Intercept)", `SD (zg)` = "SD (zg)", `Cor (Intercept~zg)` = "Cor (Intercept~zg)" ) ) expect_identical( substr(out, 1, 30), c( "# Random Effects (Zero-Inflati", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (zg: persons) | ", "Cor (Intercept~zg: persons) | " ) ) expect_equal(mp$Coefficient, c(2.73583, 1.56833, 1), tolerance = 1e-3) expect_equal(mp$CI_low, c(1.16329, 0.64246, -1), tolerance = 1e-3) mp <- model_parameters(m4, ci_random = TRUE, effects = "all", component = "conditional", verbose = FALSE) out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c( `(Intercept)` = "(Intercept)", child = "child", camper1 = "camper [1]", `SD (Intercept)` = "SD (Intercept)", `SD (xb)` = "SD (xb)", `Cor (Intercept~xb)` = "Cor (Intercept~xb)" ) ) expect_identical( substr(out, 1, 30), c( "# Fixed Effects", "", "Parameter | Log-Mean | SE ", "------------------------------", "(Intercept) | 2.55 | 0.25 ", "child | -1.09 | 0.10 ", "camper [1] | 0.27 | 0.10 ", "", "# Random Effects", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (xb: persons) | ", "Cor (Intercept~xb: persons) | " ) ) expect_equal(mp$Coefficient, c(2.54713, -1.08747, 0.2723, 3.40563, 1.21316, -1), tolerance = 1e-3) expect_equal(mp$CI_low, c(2.06032, -1.27967, 0.07461, 1.64567, 0.5919, -1), tolerance = 1e-3) mp <- model_parameters(m4, effects = "all", ci_random = TRUE, component = "zero_inflated", verbose = FALSE) out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c( `(Intercept)` = "(Intercept)", child = "child", camper1 = "camper [1]", `SD (Intercept)` = "SD (Intercept)", `SD (zg)` = "SD (zg)", `Cor (Intercept~zg)` = "Cor (Intercept~zg)" ) ) expect_identical( substr(out, 1, 30), c( "# Fixed Effects (Zero-Inflatio", "", "Parameter | Log-Mean | SE ", "------------------------------", "(Intercept) | 1.89 | 0.66 ", "child | 0.16 | 0.48 ", "camper [1] | -0.17 | 0.39 ", "", "# Random Effects (Zero-Inflati", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (zg: persons) | ", "Cor (Intercept~zg: persons) | " ) ) expect_equal(mp$Coefficient, c(1.88964, 0.15712, -0.17007, 2.73583, 1.56833, 1), tolerance = 1e-3) expect_equal(mp$CI_low, c(0.5878, -0.78781, -0.92836, 1.16329, 0.64246, -1), tolerance = 1e-3) mp <- model_parameters(m4, effects = "all", component = "all", ci_random = TRUE, verbose = FALSE) out <- utils::capture.output(print(mp)) expect_identical( attributes(mp)$pretty_labels, c( `(Intercept)` = "(Intercept)", child = "child", camper1 = "camper [1]", `(Intercept)` = "(Intercept)", child = "child", camper1 = "camper1", # nolint `SD (Intercept)` = "SD (Intercept)", `SD (xb)` = "SD (xb)", `Cor (Intercept~xb)` = "Cor (Intercept~xb)", `SD (Intercept)` = "SD (Intercept)", `SD (zg)` = "SD (zg)", # nolint `Cor (Intercept~zg)` = "Cor (Intercept~zg)" ) ) expect_identical( substr(out, 1, 30), c( "# Fixed Effects (Count Model)", "", "Parameter | Log-Mean | SE ", "------------------------------", "(Intercept) | 2.55 | 0.25 ", "child | -1.09 | 0.10 ", "camper [1] | 0.27 | 0.10 ", "", "# Fixed Effects (Zero-Inflatio", "", "Parameter | Log-Odds | SE ", "------------------------------", "(Intercept) | 1.89 | 0.66 ", "child | 0.16 | 0.48 ", "camper [1] | -0.17 | 0.39 ", "", "# Random Effects Variances", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (xb: persons) | ", "Cor (Intercept~xb: persons) | ", "", "# Random Effects (Zero-Inflati", "", "Parameter | ", "------------------------------", "SD (Intercept: persons) | ", "SD (zg: persons) | ", "Cor (Intercept~zg: persons) | " ) ) expect_equal( mp$Coefficient, c( 2.54713, -1.08747, 0.2723, 1.88964, 0.15712, -0.17007, 3.40563, 1.21316, -1, 2.73583, 1.56833, 1 ), tolerance = 1e-3 ) expect_equal( mp$CI_low, c( 2.06032, -1.27967, 0.07461, 0.5878, -0.78781, -0.92836, 1.64567, 0.5919, -1, 1.16329, 0.64246, -1 ), tolerance = 1e-3 ) }) # proper printing of digits --------------------- test_that("print-model_parameters glmmTMB digits", { skip_on_os(c("mac", "linux", "solaris")) skip_if_not(getRversion() >= "4.3.3") mp <- model_parameters(m4, ci_random = TRUE, effects = "all", component = "all") out <- utils::capture.output(print(mp, digits = 4, ci_digits = 5)) expect_snapshot(out[-c(5, 14)]) mp <- model_parameters(m4, effects = "all", component = "all", ci_random = TRUE, digits = 4, ci_digits = 5) out <- utils::capture.output(print(mp)) expect_snapshot(out[-c(5, 14)]) }) # proper alignment of CIs --------------------- test_that("print-model_parameters glmmTMB CI alignment", { skip_if_not_installed("curl") skip_if_offline() skip_on_os(c("mac", "linux", "solaris")) skip_if_not(getRversion() >= "4.3.3") model_pr <- tryCatch( { load(url("https://github.com/d-morrison/parameters/raw/glmmTMB/data/pressure_durations.RData")) glmmTMB::glmmTMB( formula = n_samples ~ Surface + Side + Jaw + (1 | Participant / Session), ziformula = ~ Surface + Side + Jaw + (1 | Participant / Session), dispformula = ~1, family = glmmTMB::nbinom2(), data = pressure_durations ) }, error = function(e) { NULL } ) mp <- model_parameters(model_pr, effects = "random", component = "all", ci_random = TRUE) expect_snapshot(print(mp)) mp <- model_parameters(model_pr, effects = "fixed", component = "all") expect_snapshot(print(mp)) }) test_that("model_parameters.mixed-all", { skip_on_os(c("mac", "linux", "solaris")) skip_if_not(getRversion() >= "4.3.3") params <- model_parameters(m4, effects = "all") expect_identical(c(nrow(params), ncol(params)), c(12L, 12L)) expect_identical( colnames(params), c( "Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "z", "df_error", "p", "Effects", "Group", "Component" ) ) expect_identical( params$Parameter, c( "(Intercept)", "child", "camper1", "(Intercept)", "child", "camper1", "SD (Intercept)", "SD (xb)", "Cor (Intercept~xb)", "SD (Intercept)", "SD (zg)", "Cor (Intercept~zg)" ) ) expect_identical( params$Component, c( "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated", "conditional", "conditional", "conditional", "zero_inflated", "zero_inflated", "zero_inflated" ) ) expect_equal( params$Coefficient, c( 2.54713, -1.08747, 0.2723, 1.88964, 0.15712, -0.17007, 3.40563, 1.21316, -1, 2.73583, 1.56833, 1 ), tolerance = 1e-2 ) }) test_that("print-model_parameters", { skip_on_os(c("mac", "linux", "solaris")) skip_if_not(getRversion() >= "4.3.3") mp <- model_parameters(m1, effects = "fixed", verbose = FALSE) expect_snapshot(mp) mp <- model_parameters(m1, effects = "fixed", exponentiate = TRUE, verbose = FALSE) expect_snapshot(mp) mp <- model_parameters(m1, effects = "all", verbose = FALSE) expect_snapshot(mp) }) } )