diff --git a/R/test_performance.R b/R/test_performance.R index d30f86035..7c1bbb7d8 100644 --- a/R/test_performance.R +++ b/R/test_performance.R @@ -437,7 +437,7 @@ test_performance.ListNonNestedRegressions <- function(objects, insight::format_error("At least two models are required to test them.") } - if (same_response && !inherits(objects, "ListLavaan") && !attributes(objects)$same_response) { + if (same_response && !inherits(objects, "ListLavaan") && isFALSE(attributes(objects)$same_response)) { insight::format_error( "The models' dependent variables don't have the same data, which is a prerequisite to compare them. Probably the proportion of missing data differs between models." ) diff --git a/R/test_wald.R b/R/test_wald.R index b7ec3cead..c97b81c76 100644 --- a/R/test_wald.R +++ b/R/test_wald.R @@ -69,7 +69,7 @@ test_wald.ListNonNestedRegressions <- function(objects, ...) { out <- data.frame( df = dfs, - df_diff = dfs_diff, + df_diff = round(dfs_diff), stringsAsFactors = FALSE ) diff --git a/tests/testthat/test-test_likelihoodratio.R b/tests/testthat/test-test_likelihoodratio.R index 91b6ec8ce..763f64780 100644 --- a/tests/testthat/test-test_likelihoodratio.R +++ b/tests/testthat/test-test_likelihoodratio.R @@ -1,113 +1,109 @@ -if (requiet("testthat") && - requiet("performance") && - requiet("lavaan")) { - test_that("test_likelihoodratio - regression models", { - m1 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) - m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) - m3 <- lm(mpg ~ wt + cyl, data = mtcars) - - # stats::anova() - rez <- test_likelihoodratio(m1, m2, m3, estimator = "OLS") - ref <- anova(m1, m2, m3, test = "LRT") - expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) - - rez <- test_likelihoodratio(m3, m2, m1, estimator = "OLS") - ref <- anova(m3, m2, m1, test = "LRT") - expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) - - # lmtest::lrtest() - rez <- test_likelihoodratio(m1, m2, m3, estimator = "ML") - p <- c(NA, 0.5302030, 0.4747344) # lmtest::lrtest(m1, m2, m3)$`Pr(>Chisq)` - expect_equal(p, rez$p, tolerance = 1e-03) - - rez <- test_likelihoodratio(m3, m2, m1, estimator = "ML") - p <- c(NA, 0.4747344, 0.5302030) # lmtest::lrtest(m3, m2, m1)$`Pr(>Chisq)` - expect_equal(p, rez$p, tolerance = 1e-03) +test_that("test_likelihoodratio - regression models", { + m1 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) + m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) + m3 <- lm(mpg ~ wt + cyl, data = mtcars) + + # stats::anova() + rez <- test_likelihoodratio(m1, m2, m3, estimator = "OLS") + ref <- anova(m1, m2, m3, test = "LRT") + expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) + + rez <- test_likelihoodratio(m3, m2, m1, estimator = "OLS") + ref <- anova(m3, m2, m1, test = "LRT") + expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) + + # lmtest::lrtest() + rez <- test_likelihoodratio(m1, m2, m3, estimator = "ML") + p <- c(NA, 0.5302030, 0.4747344) # lmtest::lrtest(m1, m2, m3)$`Pr(>Chisq)` + expect_equal(p, rez$p, tolerance = 1e-03) + + rez <- test_likelihoodratio(m3, m2, m1, estimator = "ML") + p <- c(NA, 0.4747344, 0.5302030) # lmtest::lrtest(m3, m2, m1)$`Pr(>Chisq)` + expect_equal(p, rez$p, tolerance = 1e-03) +}) + +test_that("test_likelihoodratio - model names", { + m1 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) + m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) + m3 <- lm(mpg ~ wt + cyl, data = mtcars) + + rez <- test_likelihoodratio(m1, m2, m3) + expect_equal(rez$Name, c("m1", "m2", "m3")) + + rez <- test_likelihoodratio(list(m1, m2, m3)) + expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3")) + + models <- list(m1, m2, m3) + rez <- test_likelihoodratio(models) + expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3")) +}) + +test_that("test_likelihoodratio - reversed order", { + m1 <- lm(mpg ~ wt + cyl, data = mtcars) + m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) + m3 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) + + rez <- test_likelihoodratio(m1, m2, m3, estimator = "OLS") + ref <- anova(m1, m2, m3, test = "LRT") + expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) + + rez <- test_likelihoodratio(m1, m2, m3, estimator = "ML") + p <- c(NA, 0.4747344, 0.5302030) # lmtest::lrtest(m1, m2, m3)$`Pr(>Chisq)` + expect_equal(p, rez$p, tolerance = 1e-03) +}) + +.runThisTest <- Sys.getenv("RunAllperformanceTests") == "yes" + +if (.runThisTest && requiet("lme4")) { + m1 <- lmer(Sepal.Length ~ Petal.Width + (1 | Species), data = iris) + m2 <- lmer(Sepal.Length ~ Petal.Width + Petal.Length + (1 | Species), data = iris) + m3 <- lmer(Sepal.Length ~ Petal.Width * Petal.Length + (1 | Species), data = iris) + + test_that("test_likelihoodratio - lme4 ML", { + t1 <- test_lrt(m1, m2, m3) + t2 <- anova(m1, m2, m3) + expect_equal(attributes(t1)$estimator, "ml") + expect_equal(t1$Chi2, c(NA, 85.26365, 0.84141), tolerance = 1e-3) + expect_equal(t1$p, c(NA, 0, 0.35899), tolerance = 1e-3) + # close, but not the same + expect_equal(t1$p, t2$`Pr(>Chisq)`, tolerance = 1e-1) + expect_equal(t1$Chi2, t2$Chisq, tolerance = 1e-1) }) - test_that("test_likelihoodratio - model names", { - m1 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) - m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) - m3 <- lm(mpg ~ wt + cyl, data = mtcars) + test_that("test_likelihoodratio - lme4 OLS", { + t2 <- test_lrt(m1, m2, m3, estimator = "ols") + expect_equal(attributes(t2)$estimator, "ols") + expect_equal(t2$Chi2, c(NA, 105.73844, 1.04346), tolerance = 1e-3) + expect_equal(t2$p, c(NA, 0, 0.30702), tolerance = 1e-3) + }) - rez <- test_likelihoodratio(m1, m2, m3) - expect_equal(rez$Name, c("m1", "m2", "m3")) + test_that("test_likelihoodratio - lme4 REML", { + expect_warning(t3 <- test_lrt(m1, m2, m3, estimator = "REML")) + expect_equal(attributes(t3)$estimator, "reml") + expect_equal(t3$Chi2, c(NA, 89.32933, 2.85635), tolerance = 1e-3) + expect_equal(t3$p, c(NA, 0, 0.09101), tolerance = 1e-3) + }) - rez <- test_likelihoodratio(list(m1, m2, m3)) - expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3")) + m1 <- glm(am ~ mpg, data = mtcars, family = binomial()) + m2 <- glm(am ~ mpg + hp, data = mtcars, family = binomial()) + m3 <- glm(am ~ mpg + hp + vs, data = mtcars, family = binomial()) - models <- list(m1, m2, m3) - rez <- test_likelihoodratio(models) - expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3")) + test_that("test_likelihoodratio - glm", { + t1 <- anova(m1, m2, m3, test = "LRT") + t2 <- test_lrt(m1, m2, m3) + expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3) + expect_equal(t1$Deviance, t2$Chi2, tolerance = 1e-3) + expect_equal(attributes(t2)$estimator, "ml") }) - test_that("test_likelihoodratio - reversed order", { - m1 <- lm(mpg ~ wt + cyl, data = mtcars) - m2 <- lm(mpg ~ wt + cyl + gear, data = mtcars) - m3 <- lm(mpg ~ wt + cyl + gear + disp, data = mtcars) + m1 <- lm(Sepal.Length ~ Petal.Width, data = iris) + m2 <- lm(Sepal.Length ~ Petal.Width + Species, data = iris) + m3 <- lm(Sepal.Length ~ Petal.Width * Species, data = iris) - rez <- test_likelihoodratio(m1, m2, m3, estimator = "OLS") - ref <- anova(m1, m2, m3, test = "LRT") - expect_equal(ref$`Pr(>Chi)`, rez$p, tolerance = 1e-03) - - rez <- test_likelihoodratio(m1, m2, m3, estimator = "ML") - p <- c(NA, 0.4747344, 0.5302030) # lmtest::lrtest(m1, m2, m3)$`Pr(>Chisq)` - expect_equal(p, rez$p, tolerance = 1e-03) + test_that("test_likelihoodratio - lm", { + t1 <- anova(m1, m2, m3, test = "LRT") + t2 <- test_lrt(m1, m2, m3) + expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3) + expect_equal(attributes(t2)$estimator, "ols") }) - - .runThisTest <- Sys.getenv("RunAllperformanceTests") == "yes" - - if (.runThisTest && requiet("lme4")) { - m1 <- lmer(Sepal.Length ~ Petal.Width + (1 | Species), data = iris) - m2 <- lmer(Sepal.Length ~ Petal.Width + Petal.Length + (1 | Species), data = iris) - m3 <- lmer(Sepal.Length ~ Petal.Width * Petal.Length + (1 | Species), data = iris) - - test_that("test_likelihoodratio - lme4 ML", { - t1 <- test_lrt(m1, m2, m3) - t2 <- anova(m1, m2, m3) - expect_equal(attributes(t1)$estimator, "ml") - expect_equal(t1$Chi2, c(NA, 85.26365, 0.84141), tolerance = 1e-3) - expect_equal(t1$p, c(NA, 0, 0.35899), tolerance = 1e-3) - # close, but not the same - expect_equal(t1$p, t2$`Pr(>Chisq)`, tolerance = 1e-1) - expect_equal(t1$Chi2, t2$Chisq, tolerance = 1e-1) - }) - - test_that("test_likelihoodratio - lme4 OLS", { - t2 <- test_lrt(m1, m2, m3, estimator = "ols") - expect_equal(attributes(t2)$estimator, "ols") - expect_equal(t2$Chi2, c(NA, 105.73844, 1.04346), tolerance = 1e-3) - expect_equal(t2$p, c(NA, 0, 0.30702), tolerance = 1e-3) - }) - - test_that("test_likelihoodratio - lme4 REML", { - expect_warning(t3 <- test_lrt(m1, m2, m3, estimator = "REML")) - expect_equal(attributes(t3)$estimator, "reml") - expect_equal(t3$Chi2, c(NA, 89.32933, 2.85635), tolerance = 1e-3) - expect_equal(t3$p, c(NA, 0, 0.09101), tolerance = 1e-3) - }) - - m1 <- glm(am ~ mpg, data = mtcars, family = binomial()) - m2 <- glm(am ~ mpg + hp, data = mtcars, family = binomial()) - m3 <- glm(am ~ mpg + hp + vs, data = mtcars, family = binomial()) - - test_that("test_likelihoodratio - glm", { - t1 <- anova(m1, m2, m3, test = "LRT") - t2 <- test_lrt(m1, m2, m3) - expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3) - expect_equal(t1$Deviance, t2$Chi2, tolerance = 1e-3) - expect_equal(attributes(t2)$estimator, "ml") - }) - - m1 <- lm(Sepal.Length ~ Petal.Width, data = iris) - m2 <- lm(Sepal.Length ~ Petal.Width + Species, data = iris) - m3 <- lm(Sepal.Length ~ Petal.Width * Species, data = iris) - - test_that("test_likelihoodratio - lm", { - t1 <- anova(m1, m2, m3, test = "LRT") - t2 <- test_lrt(m1, m2, m3) - expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3) - expect_equal(attributes(t2)$estimator, "ols") - }) - } } diff --git a/tests/testthat/test-test_wald.R b/tests/testthat/test-test_wald.R index df11be538..34ecb0ea8 100644 --- a/tests/testthat/test-test_wald.R +++ b/tests/testthat/test-test_wald.R @@ -1,43 +1,37 @@ -if (requiet("testthat") && - requiet("performance") && - requiet("lavaan") && - requiet("lmtest")) { - test_that("test_wald - lm", { - m1 <- lm(Sepal.Length ~ Petal.Width * Species, data = iris) - m2 <- lm(Sepal.Length ~ Petal.Width + Species, data = iris) - m3 <- lm(Sepal.Length ~ Petal.Width, data = iris) - - rez <- test_wald(m1, m2, m3) - ref <- as.data.frame(anova(m1, m2, m3)) - - expect_equal(rez$`F`, ref$`F`) - expect_equal(rez$p, ref$`Pr(>F)`) - - # setting test = "LRT" is not expected, but should at least not fail - expect_warning(rez <- test_wald(m1, m2, test = "LRT")) - expect_equal(rez$Name, c("..1", "..2")) - - # Reversed - m3 <- m1 - m1 <- lm(Sepal.Length ~ Petal.Width, data = iris) - - rez <- test_wald(m1, m2, m3) - ref <- as.data.frame(anova(m1, m2, m3)) - - expect_equal(rez$`F`, ref$`F`) - expect_equal(rez$p, ref$`Pr(>F)`) - }) - - test_that("test_wald - glm", { - m1 <- glm(vs ~ disp + hp + drat, data = mtcars, family = "binomial") - m2 <- glm(vs ~ disp + hp, data = mtcars, family = "binomial") - m3 <- glm(vs ~ disp, data = mtcars, family = "binomial") - - rez <- test_wald(m1, m2, m3) - # Why different? - # ref <- lmtest::waldtest(m1, m2, m3) - # - # expect_equal(rez$`F`, ref$`F`) - # expect_equal(rez$p, ref$`Pr(>F)`) - }) -} +test_that("test_wald - lm", { + m1 <- lm(Sepal.Length ~ Petal.Width * Species, data = iris) + m2 <- lm(Sepal.Length ~ Petal.Width + Species, data = iris) + m3 <- lm(Sepal.Length ~ Petal.Width, data = iris) + + rez <- test_wald(m1, m2, m3) + ref <- as.data.frame(anova(m1, m2, m3)) + + expect_equal(rez$`F`, ref$`F`, tolerance = 1e-4) + expect_equal(rez$p, ref$`Pr(>F)`, tolerance = 1e-4) + + # setting test = "LRT" is not expected, but should at least not fail + expect_warning(rez <- test_wald(m1, m2, test = "LRT")) + expect_equal(rez$Name, c("..1", "..2")) + + # Reversed + m3 <- m1 + m1 <- lm(Sepal.Length ~ Petal.Width, data = iris) + + rez <- test_wald(m1, m2, m3) + ref <- as.data.frame(anova(m1, m2, m3)) + + expect_equal(rez$`F`, ref$`F`, tolerance = 1e-4) + expect_equal(rez$p, ref$`Pr(>F)`, tolerance = 1e-4) +}) + +test_that("test_wald - glm", { + m1 <- glm(vs ~ disp + hp + drat, data = mtcars, family = "binomial") + m2 <- glm(vs ~ disp + hp, data = mtcars, family = "binomial") + m3 <- glm(vs ~ disp, data = mtcars, family = "binomial") + + expect_warning(rez <- test_wald(m1, m2, m3)) + ref <- as.data.frame(anova(m1, m2, m3, test = "LRT")) + + expect_equal(rez$Chi2, abs(ref$Deviance), tolerance = 1e-4) + expect_equal(rez$p, ref$`Pr(>Chi)`, tolerance = 1e-4) +})