From e9eaabad4b095b1f73f1c41cb3c05b186e895579 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 14:24:29 +0200 Subject: [PATCH 1/8] Bug in equivalente_test when using big numbers for lower bounds Fixes #982 --- R/equivalence_test.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 1f5c9cab0..3e23b6470 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -562,13 +562,13 @@ equivalence_test.ggeffects <- function(x, # 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))) { + if (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(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))) { + } else if (all(ci_narrow < max(range_rope))) { # check if CI are entirely inside ROPE. If CI crosses ROPE, reject H0, else accept decision <- "Accepted" } else { From 09affc78fd98046148410ae7a268d70aa0b35e74 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 14:28:07 +0200 Subject: [PATCH 2/8] add test --- tests/testthat/test-equivalence_test.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index cd9ab72bb..1dc4635e7 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -7,3 +7,15 @@ 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)) +}) From 49e3a942a938a46623bf193dc56eb4269bf9f6a1 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 17:59:10 +0200 Subject: [PATCH 3/8] tests --- DESCRIPTION | 2 +- R/equivalence_test.R | 39 ++++++++++++-------------- man/equivalence_test.lm.Rd | 21 ++++++++------ tests/testthat/test-equivalence_test.R | 21 ++++++++++++++ 4 files changed, 53 insertions(+), 30 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8f4e7ce16..bfc44da84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -211,7 +211,7 @@ VignetteBuilder: knitr Encoding: UTF-8 Language: en-US -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/testthat/parallel: true diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 3e23b6470..efa6c56e1 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 (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(range_rope))) { - decision <- "Accepted" - } else { - decision <- "Rejected" - } - # non-significant results - } else if (all(ci_narrow < max(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 <- "Accepted" } } @@ -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" 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/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index 1dc4635e7..004069945 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -18,4 +18,25 @@ test_that("equivalence_test, unequal rope-range", { 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") + ) }) From 68ea747794ddf333110ed7d8482151bba5d12f9b Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:00:22 +0200 Subject: [PATCH 4/8] fix --- R/equivalence_test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/equivalence_test.R b/R/equivalence_test.R index efa6c56e1..e94cd8f2c 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -569,7 +569,7 @@ equivalence_test.ggeffects <- function(x, # non-significant results - undecided decision <- "Undecided" } else { - decision <- "Accepted" + decision <- "Rejected" } } From 6446cabeca47d00ba9af549d74112f3359e1be11 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:04:32 +0200 Subject: [PATCH 5/8] tests --- DESCRIPTION | 1 + .../equivalence_test/equivalence-test-1.svg | 70 ++++++++++++++ .../equivalence_test/equivalence-test-2.svg | 73 +++++++++++++++ .../equivalence_test/equivalence-test-3.svg | 93 +++++++++++++++++++ .../equivalence_test/equivalence-test-4.svg | 93 +++++++++++++++++++ .../equivalence_test/equivalence-test-5.svg | 93 +++++++++++++++++++ tests/testthat/test-equivalence_test.R | 39 ++++++++ 7 files changed, 462 insertions(+) create mode 100644 tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg create mode 100644 tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg create mode 100644 tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg create mode 100644 tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg create mode 100644 tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg diff --git a/DESCRIPTION b/DESCRIPTION index bfc44da84..62a46abf4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -204,6 +204,7 @@ Suggests: tinytable (>= 0.1.0), TMB, truncreg, + vdiffr, VGAM, withr, WRS2 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 004069945..e297cfba0 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -40,3 +40,42 @@ test_that("equivalence_test, unequal rope-range", { c("Rejected", "Accepted", "Undecided", "Rejected", "Rejected", "Undecided") ) }) + +test_that("equivalence_test, unequal rope-range, plots", { + 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) + ) +}) From eeaaae6a023dc4987ec47ffce7e0d792c77d624c Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:05:17 +0200 Subject: [PATCH 6/8] skip_on_cran --- tests/testthat/test-equivalence_test.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index e297cfba0..135eb7058 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -42,6 +42,7 @@ test_that("equivalence_test, unequal rope-range", { }) 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) From 4f4ebcfe3b1e341630067486b795138f76ea4306 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:06:29 +0200 Subject: [PATCH 7/8] news, vers --- DESCRIPTION | 2 +- NEWS.md | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 14849c5de..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", 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`). From 53dc3c10fab22067807b994b2f8f7b39ebfc12e0 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 20 Jul 2024 18:21:33 +0200 Subject: [PATCH 8/8] lintr --- R/equivalence_test.R | 14 ++++++-------- tests/testthat/test-equivalence_test.R | 4 ++-- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/R/equivalence_test.R b/R/equivalence_test.R index e94cd8f2c..3be162035 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -738,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/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index 135eb7058..6c43953db 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -10,7 +10,7 @@ test_that("equivalence_test", { test_that("equivalence_test, unequal rope-range", { data(iris) - m <- lm(Sepal.Length ~ Species, 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)) @@ -45,7 +45,7 @@ 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) + m <- lm(Sepal.Length ~ Species, data = iris) rez <- equivalence_test(m, range = c(-Inf, 0.1)) vdiffr::expect_doppelganger( "Equivalence-Test 1",