1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
|
skip_if_not_installed("marginaleffects", minimum_version = "0.25.0")
skip_if_not_installed("rstanarm")
test_that("marginaleffects()", {
# Frequentist
x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
out <- parameters(model)
expect_identical(nrow(out), 1L)
cols <- c("Parameter", "Comparison", "Coefficient", "SE", "Statistic", "p", "S", "CI", "CI_low", "CI_high")
expect_true(all(cols %in% colnames(out)))
out <- model_parameters(model, exponentiate = TRUE)
expect_equal(out$Coefficient, 1.394, tolerance = 1e-3)
# Bayesian
x <- suppressWarnings(
rstanarm::stan_glm(
Sepal.Width ~ Species * Petal.Length,
data = iris,
refresh = 0,
iter = 100,
chains = 1
)
)
model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
expect_identical(nrow(parameters(model)), 1L)
})
test_that("predictions()", {
x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
p <- marginaleffects::avg_predictions(x, by = "Species")
out <- parameters(p)
expect_identical(nrow(out), 3L)
expect_named(out, c(
"Predicted", "SE", "CI", "CI_low", "CI_high", "S", "Statistic",
"p", "Species"
))
out <- parameters(p, exponentiate = TRUE)
expect_equal(out$Predicted, c(30.81495, 15.95863, 19.57004), tolerance = 1e-4)
})
test_that("comparisons()", {
data(iris)
# Frequentist
x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
m <- marginaleffects::avg_comparisons(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length")
expect_identical(nrow(parameters(m)), 1L)
out <- parameters(m, exponentiate = TRUE)
expect_equal(out$Coefficient, 1.393999, tolerance = 1e-4)
# Bayesian
x <- suppressWarnings(
rstanarm::stan_glm(
Sepal.Width ~ Species * Petal.Length,
data = iris,
refresh = 0,
iter = 100,
chains = 1
)
)
m <- marginaleffects::avg_slopes(
x,
newdata = insight::get_datagrid(x, by = "Species"),
variables = "Petal.Length"
)
expect_identical(nrow(parameters(m)), 1L)
})
test_that("hypotheses()", {
data(mtcars)
x <- lm(mpg ~ hp + wt, data = mtcars)
m <- marginaleffects::hypotheses(x, "hp = wt")
expect_identical(nrow(parameters(m)), 1L)
})
test_that("multiple contrasts: Issue #779", {
skip_if(getRversion() < "4.0.0")
data(mtcars)
mod <- lm(mpg ~ as.factor(gear) * as.factor(cyl), data = mtcars)
cmp <- suppressWarnings(marginaleffects::comparisons(
mod,
variables = c("gear", "cyl"),
newdata = insight::get_datagrid(mod, by = c("gear", "cyl")),
cross = TRUE
))
cmp <- suppressWarnings(parameters(cmp))
expect_true("Comparison: gear" %in% colnames(cmp))
expect_true("Comparison: cyl" %in% colnames(cmp))
})
test_that("model_parameters defaults to FALSE: Issue #916", {
data(mtcars)
mod <- lm(mpg ~ wt, data = mtcars)
pred <- marginaleffects::predictions(mod, newdata = marginaleffects::datagrid(wt = c(1, 2)))
out1 <- model_parameters(pred)
out2 <- model_parameters(pred, exponentiate = FALSE)
expect_equal(out1$Predicted, out2$Predicted, tolerance = 1e-4)
})
test_that("digits and ci_digits for marginaleffects", {
data(mtcars)
skip_if(getRversion() < "4.2.0")
out <- lm(mpg ~ wt, data = mtcars) |>
marginaleffects::hypotheses(hypothesis = "10*wt = 0") |>
model_parameters(digits = 1)
expect_snapshot(out)
})
test_that("preserve columns with same name as reserved words", {
data(mtcars)
skip_if(getRversion() < "4.2.0")
skip_if_not_installed("modelbased")
set.seed(1234)
x <- rnorm(200)
z <- rnorm(200)
# quadratic relationship
y <- 2 * x + x^2 + 4 * z + rnorm(200)
d <- data.frame(x, y, z)
model <- lm(y ~ x + z, data = d)
pred <- modelbased::estimate_means(model, c("x", "z"))
expect_named(pred, c("x", "z", "Mean", "SE", "CI_low", "CI_high", "t", "df"))
})
|