diff --git a/NEWS.md b/NEWS.md index f98458f3f..c3232190d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,8 +8,8 @@ * Added support for `{marginaleffects}` -* The ROPE or threshold ranges in `rope()`, `describe_posterior()` and - `p_significance()` can now be specified as a list. This allows for different +* The ROPE or threshold ranges in `rope()`, `describe_posterior()`, `p_significance()` + and `equivalence_test()` can now be specified as a list. This allows for different ranges for different parameters. * Results from objects generated by `{emmeans}` (`emmGrid`/`emm_list`) now diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 05aa2c62d..589b8d7fc 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -165,13 +165,40 @@ equivalence_test.data.frame <- function(x, range = "default", ci = 0.95, rvar_co return(.append_datagrid(out, x)) } - l <- insight::compact_list(lapply( - x, - equivalence_test, - range = range, - ci = ci, - verbose = verbose - )) + # multiple ranges for the parameters - iterate over parameters and range + if (is.list(range)) { + if (length(range) != ncol(x)) { + insight::format_error("Length of `range` (i.e. number of ROPE limits) should match the number of parameters.") + } + # check if list of values contains only valid values + checks <- vapply(range, function(r) { + !all(r == "default") || !all(is.numeric(r)) || length(r) != 2 + }, logical(1)) + if (!all(checks)) { + insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).") + } + l <- insight::compact_list(mapply( + function(p, r) { + equivalence_test( + p, + range = r, + ci = ci, + verbose = verbose + ) + }, + x, + range, + SIMPLIFY = FALSE + )) + } else { + l <- insight::compact_list(lapply( + x, + equivalence_test, + range = range, + ci = ci, + verbose = verbose + )) + } dat <- do.call(rbind, l) out <- data.frame( @@ -259,50 +286,7 @@ equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verb verbose = verbose ) - if (is.list(range)) { - if (length(range) != ncol(params)) { - insight::format_error("Length of `range` (i.e. number of ROPE limits) should match the number of parameters.") - } - # check if list of values contains only valid values - checks <- vapply(range, function(r) { - !all(r == "default") || !all(is.numeric(r)) || length(r) != 2 - }, logical(1)) - if (!all(checks)) { - insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).") - } - l <- mapply( - function(p, r) { - equivalence_test( - p, - range = r, - ci = ci, - verbose = verbose - ) - }, - params, - range, - SIMPLIFY = FALSE - ) - } else { - l <- sapply( - params, - equivalence_test, - range = range, - ci = ci, - verbose = verbose, - simplify = FALSE - ) - } - - dat <- do.call(rbind, l) - out <- data.frame( - Parameter = rep(names(l), each = nrow(dat) / length(l)), - dat, - stringsAsFactors = FALSE - ) - - class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out))) - out + equivalence_test(params, range = range, ci = ci, verbose = verbose) } diff --git a/man/equivalence_test.Rd b/man/equivalence_test.Rd index ea0b3a182..81f5d42fd 100644 --- a/man/equivalence_test.Rd +++ b/man/equivalence_test.Rd @@ -165,7 +165,7 @@ print(test, digits = 4) model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) equivalence_test(model) # multiple ROPE ranges - asymmetric, symmetric, default -equivalence_test(model, range = list(c(-10, 5), c(-0.2, 0.2), "default")) +equivalence_test(model, range = list(c(10, 40), c(-5, -4), "default")) # plot result test <- equivalence_test(model) diff --git a/tests/testthat/_snaps/equivalence_test.md b/tests/testthat/_snaps/equivalence_test.md index 8e54d8ac0..cf351f609 100644 --- a/tests/testthat/_snaps/equivalence_test.md +++ b/tests/testthat/_snaps/equivalence_test.md @@ -1,4 +1,4 @@ -# equivalence test +# equivalence test, rstanarm Code print(out) @@ -34,3 +34,39 @@ +# equivalence test, df + + Code + print(out) + Output + # Test for Practical Equivalence + + ROPE: [-0.10 0.10] + + Parameter | H0 | inside ROPE | 95% HDI + ----------------------------------------------------- + (Intercept) | Rejected | 0.00 % | [-2.68, -0.50] + size | Accepted | 100.00 % | [-0.04, 0.07] + period2 | Rejected | 0.00 % | [-1.61, -0.36] + period3 | Rejected | 0.00 % | [-1.77, -0.40] + period4 | Rejected | 0.00 % | [-2.52, -0.76] + + + +--- + + Code + print(out) + Output + # Test for Practical Equivalence + + Parameter | H0 | inside ROPE | 95% HDI | ROPE + ---------------------------------------------------------------------- + (Intercept) | Undecided | 15.82 % | [-2.68, -0.50] | [-1.00, 1.00] + size | Accepted | 100.00 % | [-0.04, 0.07] | [-0.10, 0.10] + period2 | Rejected | 0.00 % | [-1.61, -0.36] | [0.00, 2.00] + period3 | Accepted | 100.00 % | [-1.77, -0.40] | [-2.00, 0.00] + period4 | Rejected | 0.00 % | [-2.52, -0.76] | [-0.10, 0.10] + + + diff --git a/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index 632e58807..e7ce74cac 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -1,4 +1,6 @@ -test_that("equivalence test", { +skip_on_cran() + +test_that("equivalence test, rstanarm", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") m <- insight::download_model("stanreg_merMod_5") @@ -30,3 +32,38 @@ test_that("equivalence test", { regex = "should be 'default'" ) }) + + +test_that("equivalence test, df", { + skip_if_offline() + skip_if_not_or_load_if_installed("rstanarm") + m <- insight::download_model("stanreg_merMod_5") + params <- as.data.frame(m)[1:5] + + out <- equivalence_test(params, verbose = FALSE) + expect_snapshot(print(out)) + + out <- equivalence_test( + params, + range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "default"), + verbose = FALSE + ) + expect_snapshot(print(out)) + + expect_error( + equivalence_test( + params, + range = list(c(-1, 1), "default", c(0, 2), c(-2, 0)), + verbose = FALSE + ), + regex = "Length of" + ) + expect_error( + equivalence_test( + params, + range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "a"), + verbose = FALSE + ), + regex = "should be 'default'" + ) +})