Nothing
test_that("estimate_means() - core", {
skip_if_not_installed("rstanarm")
skip_if_not_installed("emmeans")
skip_if_not_installed("marginaleffects")
# library(testthat)
dat <- mtcars
dat$gear <- as.factor(dat$gear)
dat$cyl <- as.factor(dat$cyl)
dat <<- dat
# Simple
model <- lm(vs ~ cyl, data = dat)
estim1 <- suppressMessages(estimate_means(model))
expect_identical(dim(estim1), c(3L, 5L))
estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
expect_identical(dim(estim2), c(3L, 5L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
# Interaction (factor * continuous)
model <- lm(mpg ~ wt * gear, data = dat)
estim1 <- suppressMessages(estimate_means(model))
expect_identical(dim(estim1), c(3L, 5L))
estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
expect_identical(dim(estim2), c(3L, 6L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
# At specific levels
model <- lm(Sepal.Width ~ Species, data = iris)
estim1 <- suppressMessages(estimate_means(model, by = "Species=c('versicolor', 'virginica')"))
expect_identical(dim(estim1), c(2L, 5L))
estim2 <- suppressMessages(estimate_means(model, by = "Species=c('versicolor', 'virginica')", backend = "marginaleffects"))
expect_identical(dim(estim2), c(2L, 5L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
# Interactions between factors
dat <- iris
dat$Petal.Length_factor <- ifelse(dat$Petal.Length < 4.2, "A", "B")
dat <<- dat
model <- lm(Sepal.Width ~ Species * Petal.Length_factor, data = dat)
estim1 <- suppressMessages(estimate_means(model, by = "all"))
expect_identical(dim(estim1), c(6L, 6L))
estim2 <- suppressWarnings(suppressMessages(estimate_means(model, by = "all", backend = "marginaleffects")))
expect_identical(dim(estim2), c(6L, 6L))
# No interaction (two factors)
model <- lm(Petal.Length ~ Sepal.Width + Species, data = iris)
estim1 <- suppressMessages(estimate_means(model))
expect_identical(dim(estim1), c(3L, 5L))
estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
expect_identical(dim(estim2), c(3L, 6L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
# At specific levels of continuous
estim1 <- suppressMessages(estimate_means(model, by = "Sepal.Width"))
expect_equal(dim(estim1), c(10, 5))
estim2 <- suppressMessages(estimate_means(model, by = "Sepal.Width", backend = "marginaleffects"))
expect_equal(dim(estim2), c(10, 6))
# Note that the absolute values are different here... for unclear reasons
expect_true(max(diff(estim1$Mean) - diff(estim2$Mean)) < 1e-10)
# TODO: add the marginaleffects comparison for the remaining tests
dat <- iris
dat$y <- as.numeric(as.factor(ifelse(dat$Sepal.Width > 3, "A", "B"))) - 1
dat <<- dat
model <- glm(y ~ Species, family = "binomial", data = dat)
estim <- suppressMessages(estimate_means(model))
expect_identical(dim(estim), c(3L, 5L))
estim <- suppressMessages(estimate_means(model, transform = "response"))
expect_identical(dim(estim), c(3L, 5L))
expect_true(all(estim$Probability >= 0) & all(estim$Probability <= 1))
model <- lm(Petal.Length ~ Sepal.Width + Species, data = iris)
estim <- suppressMessages(estimate_means(model))
expect_identical(dim(estim), c(3L, 5L))
estim <- suppressMessages(estimate_means(model, by = "all"))
expect_equal(dim(estim), c(30, 6))
# In formula modification
# FIXME: this got broken but it seems just to tedious to fix. Don't use in formula transforms.
# model <- lm(mpg ~ wt * as.factor(gear), data = mtcars)
# estim <- suppressMessages(estimate_means(model))
# expect_equal(dim(estim), c(3L, 5L))
# One continuous and one factor
model <- lm(Petal.Length ~ Species * Sepal.Width, data = iris)
estim <- suppressMessages(estimate_means(model))
expect_identical(dim(estim), c(3L, 5L))
estim <- suppressMessages(estimate_means(model, fixed = "Sepal.Width"))
expect_identical(dim(estim), c(3L, 6L))
estim <- suppressMessages(estimate_means(model, by = c("Species", "Sepal.Width"), length = 2))
expect_identical(dim(estim), c(6L, 6L))
estim <- suppressMessages(estimate_means(model, by = "Species=c('versicolor', 'setosa')"))
expect_identical(dim(estim), c(2L, 5L))
estim <- suppressMessages(estimate_means(model, by = "Sepal.Width=c(2, 4)"))
expect_identical(dim(estim), c(2L, 5L))
estim <- suppressMessages(estimate_means(model, by = c("Species", "Sepal.Width=0")))
expect_identical(dim(estim), c(3L, 6L))
estim <- suppressMessages(estimate_means(model, by = "Sepal.Width", length = 5))
expect_equal(dim(estim), c(5, 5))
estim <- suppressMessages(estimate_means(model, by = "Sepal.Width=c(2, 4)"))
expect_identical(dim(estim), c(2L, 5L))
# Two factors
dat <- iris
dat$Petal.Length_factor <- ifelse(dat$Petal.Length < 4.2, "A", "B")
dat <<- dat
model <- lm(Petal.Length ~ Species * Petal.Length_factor, data = dat)
estim <- suppressMessages(estimate_means(model, by = "all"))
expect_identical(dim(estim), c(6L, 6L))
estim <- suppressMessages(estimate_means(model, by = "Petal.Length_factor"))
expect_identical(dim(estim), c(2L, 5L))
estim <- suppressMessages(estimate_means(model, by = "Petal.Length_factor='B'"))
expect_identical(as.character(unique(estim$Petal.Length_factor)), "B")
# Three factors
dat <- mtcars
dat[c("gear", "vs", "am")] <- sapply(dat[c("gear", "vs", "am")], as.factor)
dat <<- dat
model <- lm(mpg ~ gear * vs * am, data = dat)
estim <- suppressMessages(estimate_means(model))
expect_equal(dim(estim), c(12, 7))
estim <- suppressMessages(estimate_means(model, fixed = "am"))
expect_equal(dim(estim), c(6, 7))
estim <- suppressMessages(estimate_means(model, by = c("gear='5'", "vs")))
expect_equal(dim(estim), c(2, 7))
dat <- iris
dat$factor1 <- ifelse(dat$Sepal.Width > 3, "A", "B")
dat$factor2 <- ifelse(dat$Petal.Length > 3.5, "C", "D")
dat$factor3 <- ifelse(dat$Sepal.Length > 5, "E", "F")
dat <<- dat
model <- lm(Petal.Width ~ factor1 * factor2 * factor3, data = dat)
estim <- suppressMessages(estimate_means(model))
expect_equal(dim(estim), c(8, 7))
estim <- suppressMessages(estimate_means(model, fixed = "factor3"))
expect_equal(dim(estim), c(4, 7))
# GLM
dat <- iris
dat$Petal.Length_factor <- as.factor(ifelse(dat$Petal.Length < 4.2, "A", "B"))
dat <<- dat
model <- glm(Petal.Length_factor ~ Species, data = dat, family = "binomial")
estim <- suppressMessages(estimate_means(model))
expect_identical(dim(estim), c(3L, 5L))
estim <- suppressMessages(estimate_means(model, transform = "none"))
expect_identical(dim(estim), c(3L, 5L))
model <- glm(Petal.Length ~ Species, data = iris, family = "Gamma")
estim <- suppressMessages(estimate_means(model))
expect_identical(dim(estim), c(3L, 5L))
})
test_that("estimate_means() - mixed models", {
skip_if_not_installed("rstanarm")
skip_if_not_installed("emmeans")
skip_if_not_installed("lme4")
dat <- iris
dat$Petal.Length_factor <- as.factor(ifelse(dat$Petal.Length < 4.2, "A", "B"))
dat <<- dat
model <- lme4::lmer(Sepal.Width ~ Species + (1 | Petal.Length_factor), data = dat)
estim1 <- suppressMessages(estimate_means(model))
expect_identical(dim(estim1), c(3L, 5L))
estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
expect_identical(dim(estim2), c(3L, 5L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
model <- lme4::glmer(Sepal.Width ~ Species + (1 | Petal.Length_factor), data = dat, family = "Gamma")
estim1 <- suppressMessages(estimate_means(model))
expect_identical(dim(estim1), c(3L, 5L))
estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
expect_identical(dim(estim2), c(3L, 5L))
expect_lt(max(estim1$Mean - estim2$Mean), 1e-10)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.