diff --git a/DESCRIPTION b/DESCRIPTION index d5a92b018..7525cb501 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.22.0.4 +Version: 0.22.0.5 Authors@R: c(person(given = "Daniel", family = "Lüdecke", @@ -204,6 +204,7 @@ Suggests: tinytable (>= 0.1.0), TMB, truncreg, + vdiffr, VGAM, withr, WRS2 diff --git a/NEWS.md b/NEWS.md index 1d86aeaa6..e278b7e67 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,9 @@ ## Bug fixes +* Fixed issue with `equivalence_test()` when ROPE range was not symmetrically + centered around zero (e.g., `range = c(-99, 0.1)`). + * `model_parameters()` for `anova()` from mixed models now also includes the denominator degrees of freedom in the output (`df_error`). diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 1f5c9cab0..3be162035 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -62,14 +62,17 @@ bayestestR::equivalence_test #' - "classic" - The TOST rule (Lakens 2017) #' #' This rule follows the "TOST rule", i.e. a two one-sided test procedure -#' (_Lakens 2017_). Following this rule, practical equivalence of an effect -#' (i.e. H0) is *rejected*, when the coefficient is statistically significant -#' *and* the narrow confidence intervals (i.e. `1-2*alpha`) *include* or -#' *exceed* the ROPE boundaries. Practical equivalence is assumed -#' (i.e. H0 "accepted") when the narrow confidence intervals are completely -#' inside the ROPE, no matter if the effect is statistically significant -#' or not. Else, the decision whether to accept or reject practical -#' equivalence is undecided. +#' (_Lakens 2017_). Following this rule... +#' - practical equivalence is assumed (i.e. H0 *"accepted"*) when the narrow +#' confidence intervals are completely inside the ROPE, no matter if the +#' effect is statistically significant or not; +#' - practical equivalence (i.e. H0) is *rejected*, when the coefficient is +#' statistically significant, both when the narrow confidence intervals +#' (i.e. `1-2*alpha`) include or exclude the the ROPE boundaries, but the +#' narrow confidence intervals are *not fully covered* by the ROPE; +#' - else the decision whether to accept or reject practical equivalence is +#' undecided (i.e. when effects are *not* statistically significant *and* +#' the narrow confidence intervals overlaps the ROPE). #' #' - "cet" - Conditional Equivalence Testing (Campbell/Gustafson 2018) #' @@ -559,20 +562,14 @@ equivalence_test.ggeffects <- function(x, if (rule == "classic") { final_ci <- ci_narrow - # significant result? - if (min(ci_narrow) > 0 || max(ci_narrow) < 0) { - # check if CI are entirely inside ROPE. If CI crosses ROPE, reject H0, else accept - if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { - decision <- "Accepted" - } else { - decision <- "Rejected" - } - # non-significant results - } else if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { - # check if CI are entirely inside ROPE. If CI crosses ROPE, reject H0, else accept + if (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(range_rope))) { + # narrow CI is fully inside ROPE - always accept decision <- "Accepted" - } else { + } else if (min(ci_narrow) < 0 && max(ci_narrow) > 0) { + # non-significant results - undecided decision <- "Undecided" + } else { + decision <- "Rejected" } } @@ -585,7 +582,7 @@ equivalence_test.ggeffects <- function(x, if (min(ci_wide) > 0 || max(ci_wide) < 0) { decision <- "Rejected" # non-significant results, all narrow CI inside ROPE - } else if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { + } else if (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(range_rope))) { decision <- "Accepted" } else { decision <- "Undecided" @@ -741,14 +738,12 @@ print.equivalence_test_lm <- function(x, orig_x <- x rule <- attributes(x)$rule - if (!is.null(rule)) { - if (rule == "cet") { - insight::print_color("# Conditional Equivalence Testing\n\n", "blue") - } else if (rule == "classic") { - insight::print_color("# TOST-test for Practical Equivalence\n\n", "blue") - } else { - insight::print_color("# Test for Practical Equivalence\n\n", "blue") - } + if (is.null(rule)) { + insight::print_color("# Test for Practical Equivalence\n\n", "blue") + } else if (rule == "cet") { + insight::print_color("# Conditional Equivalence Testing\n\n", "blue") + } else if (rule == "classic") { + insight::print_color("# TOST-test for Practical Equivalence\n\n", "blue") } else { insight::print_color("# Test for Practical Equivalence\n\n", "blue") } diff --git a/man/equivalence_test.lm.Rd b/man/equivalence_test.lm.Rd index 1d4ab94d4..f58df1735 100644 --- a/man/equivalence_test.lm.Rd +++ b/man/equivalence_test.lm.Rd @@ -100,14 +100,19 @@ better). \item "classic" - The TOST rule (Lakens 2017) This rule follows the "TOST rule", i.e. a two one-sided test procedure -(\emph{Lakens 2017}). Following this rule, practical equivalence of an effect -(i.e. H0) is \emph{rejected}, when the coefficient is statistically significant -\emph{and} the narrow confidence intervals (i.e. \code{1-2*alpha}) \emph{include} or -\emph{exceed} the ROPE boundaries. Practical equivalence is assumed -(i.e. H0 "accepted") when the narrow confidence intervals are completely -inside the ROPE, no matter if the effect is statistically significant -or not. Else, the decision whether to accept or reject practical -equivalence is undecided. +(\emph{Lakens 2017}). Following this rule... +\itemize{ +\item practical equivalence is assumed (i.e. H0 \emph{"accepted"}) when the narrow +confidence intervals are completely inside the ROPE, no matter if the +effect is statistically significant or not; +\item practical equivalence (i.e. H0) is \emph{rejected}, when the coefficient is +statistically significant, both when the narrow confidence intervals +(i.e. \code{1-2*alpha}) include or exclude the the ROPE boundaries, but the +narrow confidence intervals are \emph{not fully covered} by the ROPE; +\item else the decision whether to accept or reject practical equivalence is +undecided (i.e. when effects are \emph{not} statistically significant \emph{and} +the narrow confidence intervals overlaps the ROPE). +} \item "cet" - Conditional Equivalence Testing (Campbell/Gustafson 2018) The Conditional Equivalence Testing as described by \emph{Campbell and diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg new file mode 100644 index 000000000..533976c27 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Speciesvirginica +Speciesversicolor + + + + + + +0.0 +0.5 +1.0 +1.5 + +Equivalence + + + +Rejected +Equivalence-Test 1 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg new file mode 100644 index 000000000..a987aae10 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Speciesvirginica +Speciesversicolor + + + + + + + +-100 +-75 +-50 +-25 +0 + +Equivalence + + + +Rejected +Equivalence-Test 2 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg new file mode 100644 index 000000000..f6d783bb3 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 3 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg new file mode 100644 index 000000000..6f6c286e7 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 4 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg new file mode 100644 index 000000000..5a9d29a42 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 5 + + diff --git a/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index cd9ab72bb..6c43953db 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -7,3 +7,76 @@ test_that("equivalence_test", { expect_type(capture.output(equivalence_test(m)), "character") expect_snapshot(print(x)) }) + +test_that("equivalence_test, unequal rope-range", { + data(iris) + m <- lm(Sepal.Length ~ Species, data = iris) + rez <- equivalence_test(m, range = c(-Inf, 0.1)) + expect_identical(rez$ROPE_Equivalence, c("Rejected", "Rejected", "Rejected")) + expect_identical(rez$ROPE_low, c(-Inf, -Inf, -Inf)) + + rez <- equivalence_test(m, range = c(-99, 0.1)) + expect_identical(rez$ROPE_Equivalence, c("Rejected", "Rejected", "Rejected")) + expect_identical(rez$ROPE_low, c(-99, -99, -99)) + + data(mtcars) + mtcars[c("gear", "cyl")] <- lapply(mtcars[c("gear", "cyl")], as.factor) + m <- lm(mpg ~ hp + gear + cyl, data = mtcars) + + rez <- equivalence_test(m, range = c(-Inf, 0.5)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Accepted", "Undecided") + ) + rez <- equivalence_test(m, range = c(-0.5, 0.5)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Rejected", "Undecided") + ) + + rez <- equivalence_test(m, range = c(-2, 2)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Rejected", "Undecided") + ) +}) + +test_that("equivalence_test, unequal rope-range, plots", { + skip_on_cran() + skip_if_not_installed("vdiffr") + data(iris) + m <- lm(Sepal.Length ~ Species, data = iris) + rez <- equivalence_test(m, range = c(-Inf, 0.1)) + vdiffr::expect_doppelganger( + "Equivalence-Test 1", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-99, 0.1)) + vdiffr::expect_doppelganger( + "Equivalence-Test 2", + plot(rez) + ) + + data(mtcars) + mtcars[c("gear", "cyl")] <- lapply(mtcars[c("gear", "cyl")], as.factor) + m <- lm(mpg ~ hp + gear + cyl, data = mtcars) + + rez <- equivalence_test(m, range = c(-Inf, 0.5)) + vdiffr::expect_doppelganger( + "Equivalence-Test 3", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-0.5, 0.5)) + vdiffr::expect_doppelganger( + "Equivalence-Test 4", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-2, 2)) + vdiffr::expect_doppelganger( + "Equivalence-Test 5", + plot(rez) + ) +})