From 21fc13cfbc54343c0b4e445e50eaa0d013f970b3 Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" <35330040+mattansb@users.noreply.github.com> Date: Sun, 8 Dec 2024 09:49:19 +0200 Subject: [PATCH] add p0 to OR conversion * Update convert_between_d_to_r.R * support interperting marix/array * add tests * remove chen2010 rule * fix tests * syler * lintr * fix example * lintr [skip] --- NEWS.md | 5 + R/convert_between_d_to_r.R | 4 +- R/interpret.R | 11 +- R/interpret_bf.R | 10 +- R/interpret_direction.R | 8 +- R/interpret_oddsratio.R | 40 ++---- R/interpret_rope.R | 5 +- R/rank_ANOVA.R | 7 +- man/interpret.Rd | 4 +- man/interpret_direction.Rd | 1 + man/interpret_oddsratio.Rd | 20 ++- man/interpret_rope.Rd | 7 +- tests/testthat/test-convert_between.R | 28 +++- tests/testthat/test-interpret.R | 191 +++++++++++++++----------- 14 files changed, 200 insertions(+), 141 deletions(-) diff --git a/NEWS.md b/NEWS.md index dab53560b..553b7f7c8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,11 @@ ## New features - `oddsratio_to_d()` and related functions gain a `p0` argument for exact conversion between odds ratios and Cohen's _d_ (thanks @KohlRaphael for the suggestion). +- `interpret*()` now accept (and return) matrices and arrays. + +## Breaking Changes + +- `interpret_oddsratio()` drops the default `"chen2010"` as it was used incorrectly (thanks to @KohlRaphael). # effectsize 0.8.9 diff --git a/R/convert_between_d_to_r.R b/R/convert_between_d_to_r.R index b854e3bc2..0921e34ff 100644 --- a/R/convert_between_d_to_r.R +++ b/R/convert_between_d_to_r.R @@ -72,7 +72,7 @@ r_to_d <- function(r, n1, n2, ...) { #' @rdname d_to_r #' @export oddsratio_to_d <- function(OR, p0, log = FALSE, ...) { - if (missing(p0)) { + if (missing(p0) || !is.numeric(p0)) { # Use approximation if (log) { log_OR <- OR @@ -90,7 +90,7 @@ oddsratio_to_d <- function(OR, p0, log = FALSE, ...) { odds1 <- OR * probs_to_odds(p0) p1 <- odds_to_probs(odds1) - qnorm(p1) - qnorm(p0) + stats::qnorm(p1) - stats::qnorm(p0) } #' @rdname d_to_r diff --git a/R/interpret.R b/R/interpret.R index ca659ba73..668780175 100644 --- a/R/interpret.R +++ b/R/interpret.R @@ -43,6 +43,10 @@ rules <- function(values, labels = NULL, name = NULL, right = TRUE) { insight::format_error("Too many labels for the number of reference values!") } + if (!is.numeric(values)) { + insight::format_error("Reference values must be numeric.") + } + if (length(values) == length(labels) - 1) { if (is.unsorted(values)) { insight::format_error("Reference values must be sorted.") @@ -129,8 +133,8 @@ is.rules <- function(x) inherits(x, "rules") #' interpret(eta2, rules = "field2013") #' #' X <- chisq.test(mtcars$am, mtcars$cyl == 8) -#' interpret(oddsratio(X), rules = "chen2010") -#' interpret(cramers_v(X), "lovakov2021") +#' interpret(oddsratio(X), rules = "cohen1988") +#' interpret(cramers_v(X), rules = "lovakov2021") #' @export interpret <- function(x, ...) { UseMethod("interpret") @@ -159,6 +163,9 @@ interpret.numeric <- function(x, rules, name = attr(rules, "rule_name"), if (length(x_tran) > 1) { out <- vapply(x_tran, .interpret, rules = rules, FUN.VALUE = character(1L)) + if (is.matrix(x_tran) || is.array(x_tran)) { + out <- structure(out, dim = dim(x_tran), dimnames = dimnames(x_tran)) + } } else { out <- .interpret(x_tran, rules = rules) } diff --git a/R/interpret_bf.R b/R/interpret_bf.R index f420dd513..78c580a01 100644 --- a/R/interpret_bf.R +++ b/R/interpret_bf.R @@ -69,19 +69,19 @@ interpret_bf <- function(bf, ) ) - interpretation <- interpret(bf, rules, transform = function(.x) exp(abs(.x))) + interpretation <- interpret(bf, rules, transform = function(.x) exp(ifelse(.x < 0, -.x, .x))) interpretation[bf == 0] <- "no" # interpret direction - dir <- interpret(bf, rules(0, c("against", "in favour of"))) - dir[bf == 0] <- "against or in favour of" + direction <- interpret(bf, rules(0, c("against", "in favour of"))) + direction[bf == 0] <- "against or in favour of" # Format text if (include_value) { bf_fmt <- insight::format_bf(exp(bf), protect_ratio = protect_ratio, exact = exact) - interpretation[] <- sprintf("%s evidence (%s) %s", interpretation, bf_fmt, dir) + interpretation[] <- sprintf("%s evidence (%s) %s", interpretation, bf_fmt, direction) } else { - interpretation[] <- paste0(interpretation, " evidence ", dir) + interpretation[] <- paste0(interpretation, " evidence ", direction) } interpretation[is.na(bf)] <- "" diff --git a/R/interpret_direction.R b/R/interpret_direction.R index a1baf7bd7..4b0fc4269 100644 --- a/R/interpret_direction.R +++ b/R/interpret_direction.R @@ -6,9 +6,15 @@ #' @examples #' interpret_direction(.02) #' interpret_direction(c(.5, -.02)) +#' interpret_direction(0) #' #' @keywords interpreters #' @export interpret_direction <- function(x) { - interpret(x, rules(0, c("negative", "positive"), name = "math", right = FALSE)) + interpret(x, rules(0, c("negative", "positive"), name = "math", right = FALSE), + transform = function(.x) { + s <- sign(.x) + replace(s, s == 0, NA_real_) + } + ) } diff --git a/R/interpret_oddsratio.R b/R/interpret_oddsratio.R index 0d4851c4d..8c65906e6 100644 --- a/R/interpret_oddsratio.R +++ b/R/interpret_oddsratio.R @@ -1,26 +1,23 @@ #' Interpret Odds Ratio #' #' @param OR Value or vector of (log) odds ratio values. -#' @param rules Can be "`chen2010"` (default), `"cohen1988"` (through -#' transformation to standardized difference, see [oddsratio_to_d()]) or custom set -#' of [rules()]. +#' @param rules If `"cohen1988"` (default), `OR` is transformed to a +#' standardized difference (via [oddsratio_to_d()]) and interpreted according +#' to Cohen's rules (see [interpret_cohens_d()]; see Chen et al., 2010). If a +#' custom set of [rules()] is used, OR is interpreted as is. #' @param log Are the provided values log odds ratio. #' @inheritParams interpret +#' @inheritParams oddsratio_to_d #' #' @section Rules: #' #' Rules apply to OR as ratios, so OR of 10 is as extreme as a OR of 0.1 (1/10). #' -#' - Chen et al. (2010) (`"chen2010"`; default) -#' - **OR < 1.68** - Very small -#' - **1.68 <= OR < 3.47** - Small -#' - **3.47 <= OR < 6.71** - Medium -#' - **OR >= 6.71 ** - Large #' - Cohen (1988) (`"cohen1988"`, based on the [oddsratio_to_d()] conversion, see [interpret_cohens_d()]) #' - **OR < 1.44** - Very small #' - **1.44 <= OR < 2.48** - Small #' - **2.48 <= OR < 4.27** - Medium -#' - **OR >= 4.27 ** - Large +#' - **OR >= 4.27** - Large #' #' @examples #' interpret_oddsratio(1) @@ -40,28 +37,15 @@ #' #' @keywords interpreters #' @export -interpret_oddsratio <- function(OR, rules = "chen2010", log = FALSE, ...) { - if (log) { - f_transform <- function(.x) exp(abs(.x)) - } else { - f_transform <- function(.x) exp(abs(log(.x))) - } - - +interpret_oddsratio <- function(OR, rules = "cohen1988", p0 = NULL, log = FALSE, ...) { if (is.character(rules) && rules == "cohen1988") { - d <- oddsratio_to_d(OR, log = log) + d <- oddsratio_to_d(OR, p0, log = log) return(interpret_cohens_d(d, rules = rules)) } - rules <- .match.rules( - rules, - list( - chen2010 = rules(c(1.68, 3.47, 6.71), c("very small", "small", "medium", "large"), - name = "chen2010", right = FALSE - ), - cohen1988 = NA # for correct error msg - ) - ) + if (log) { + OR <- exp(OR) + } - interpret(OR, rules, transform = f_transform) + interpret(OR, rules, transform = function(.x) ifelse(.x < 1, 1 / .x, .x)) } diff --git a/R/interpret_rope.R b/R/interpret_rope.R index e2bde54df..21860dd8c 100644 --- a/R/interpret_rope.R +++ b/R/interpret_rope.R @@ -3,7 +3,8 @@ #' Interpretation of #' #' @param rope Value or vector of percentages in ROPE. -#' @param ci The Credible Interval (CI) probability, corresponding to the proportion of HDI, that was used. Can be `1` in the case of "full ROPE". +#' @param ci The Credible Interval (CI) probability, corresponding to the +#' proportion of HDI, that was used. Can be `1` in the case of "full ROPE". #' @param rules A character string (see details) or a custom set of [rules()]. #' #' @section Rules: @@ -29,7 +30,7 @@ #' #' @keywords interpreters #' @export -interpret_rope <- function(rope, ci = 0.9, rules = "default") { +interpret_rope <- function(rope, rules = "default", ci = 0.9) { if (ci < 1) { e <- .Machine$double.eps diff --git a/R/rank_ANOVA.R b/R/rank_ANOVA.R index 6a58a6a6d..f4ee4abb7 100644 --- a/R/rank_ANOVA.R +++ b/R/rank_ANOVA.R @@ -280,9 +280,12 @@ kendalls_w <- function(x, groups, blocks, data = NULL, boot_fun <- function(.data, .i) { split(.data$x, .data$groups) <- - lapply(split(.data$x, .data$groups), + lapply( + split(.data$x, .data$groups), function(v) { - if (length(v) < 2L) return(v) + if (length(v) < 2L) { + return(v) + } sample(v, size = length(v), replace = TRUE) } ) diff --git a/man/interpret.Rd b/man/interpret.Rd index c831620e9..3361202a0 100644 --- a/man/interpret.Rd +++ b/man/interpret.Rd @@ -63,8 +63,8 @@ eta2 <- eta_squared(m) interpret(eta2, rules = "field2013") X <- chisq.test(mtcars$am, mtcars$cyl == 8) -interpret(oddsratio(X), rules = "chen2010") -interpret(cramers_v(X), "lovakov2021") +interpret(oddsratio(X), rules = "cohen1988") +interpret(cramers_v(X), rules = "lovakov2021") } \seealso{ \code{\link[=rules]{rules()}} diff --git a/man/interpret_direction.Rd b/man/interpret_direction.Rd index 07a486fcf..addbfe15e 100644 --- a/man/interpret_direction.Rd +++ b/man/interpret_direction.Rd @@ -15,6 +15,7 @@ Interpret Direction \examples{ interpret_direction(.02) interpret_direction(c(.5, -.02)) +interpret_direction(0) } \keyword{interpreters} diff --git a/man/interpret_oddsratio.Rd b/man/interpret_oddsratio.Rd index 39da032e0..b69842fdc 100644 --- a/man/interpret_oddsratio.Rd +++ b/man/interpret_oddsratio.Rd @@ -4,14 +4,17 @@ \alias{interpret_oddsratio} \title{Interpret Odds Ratio} \usage{ -interpret_oddsratio(OR, rules = "chen2010", log = FALSE, ...) +interpret_oddsratio(OR, rules = "cohen1988", p0 = NULL, log = FALSE, ...) } \arguments{ \item{OR}{Value or vector of (log) odds ratio values.} -\item{rules}{Can be "\verb{chen2010"} (default), \code{"cohen1988"} (through -transformation to standardized difference, see \code{\link[=oddsratio_to_d]{oddsratio_to_d()}}) or custom set -of \code{\link[=rules]{rules()}}.} +\item{rules}{If \code{"cohen1988"} (default), \code{OR} is transformed to a +standardized difference (via \code{\link[=oddsratio_to_d]{oddsratio_to_d()}}) and interpreted according +to Cohen's rules (see \code{\link[=interpret_cohens_d]{interpret_cohens_d()}}; see Chen et al., 2010). If a +custom set of \code{\link[=rules]{rules()}} is used, OR is interpreted as is.} + +\item{p0}{Baseline risk. If not specified, the \emph{d} to \emph{OR} conversion uses am approximation (see details).} \item{log}{Are the provided values log odds ratio.} @@ -25,19 +28,12 @@ Interpret Odds Ratio Rules apply to OR as ratios, so OR of 10 is as extreme as a OR of 0.1 (1/10). \itemize{ -\item Chen et al. (2010) (\code{"chen2010"}; default) -\itemize{ -\item \strong{OR < 1.68} - Very small -\item \strong{1.68 <= OR < 3.47} - Small -\item \strong{3.47 <= OR < 6.71} - Medium -\item **OR >= 6.71 ** - Large -} \item Cohen (1988) (\code{"cohen1988"}, based on the \code{\link[=oddsratio_to_d]{oddsratio_to_d()}} conversion, see \code{\link[=interpret_cohens_d]{interpret_cohens_d()}}) \itemize{ \item \strong{OR < 1.44} - Very small \item \strong{1.44 <= OR < 2.48} - Small \item \strong{2.48 <= OR < 4.27} - Medium -\item **OR >= 4.27 ** - Large +\item \strong{OR >= 4.27} - Large } } } diff --git a/man/interpret_rope.Rd b/man/interpret_rope.Rd index 4bf678ccc..41eabf1aa 100644 --- a/man/interpret_rope.Rd +++ b/man/interpret_rope.Rd @@ -4,14 +4,15 @@ \alias{interpret_rope} \title{Interpret Bayesian Posterior Percentage in ROPE.} \usage{ -interpret_rope(rope, ci = 0.9, rules = "default") +interpret_rope(rope, rules = "default", ci = 0.9) } \arguments{ \item{rope}{Value or vector of percentages in ROPE.} -\item{ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, that was used. Can be \code{1} in the case of "full ROPE".} - \item{rules}{A character string (see details) or a custom set of \code{\link[=rules]{rules()}}.} + +\item{ci}{The Credible Interval (CI) probability, corresponding to the +proportion of HDI, that was used. Can be \code{1} in the case of "full ROPE".} } \description{ Interpretation of diff --git a/tests/testthat/test-convert_between.R b/tests/testthat/test-convert_between.R index 18cce8c1f..fdd2392b8 100644 --- a/tests/testthat/test-convert_between.R +++ b/tests/testthat/test-convert_between.R @@ -13,11 +13,35 @@ test_that("exact OR to d", { expect_equal(cor(oddsratio_to_d(OR), d), 1, tolerance = 0.0001) expect_equal(oddsratio_to_d(1), 0, tolerance = 0.0001) - expect_equal(oddsratio_to_d(OR, p0), d) + expect_equal(oddsratio_to_d(OR, p0), d, tolerance = 0.0001) expect_equal(cor(oddsratio_to_r(OR), d_to_r(d)), 1, tolerance = 0.0002) expect_equal(oddsratio_to_r(1), 0, tolerance = 0.0001) - expect_equal(oddsratio_to_r(OR, p0), d_to_r(d)) + expect_equal(oddsratio_to_r(OR, p0), d_to_r(d), tolerance = 0.0001) + + + # From Chen et al 2010 + chen_tab_1 <- as.matrix( + read.table( + text = "p0 OR_1 OR_2 OR_3 + 0.0100 1.6814 3.4739 6.7128 + 0.0200 1.6146 3.1332 5.7486 + 0.0300 1.5733 2.9535 5.2592 + 0.0400 1.5455 2.8306 4.9471 + 0.0500 1.5228 2.7416 4.7233 + 0.0600 1.5060 2.6741 4.5536 + 0.0700 1.4926 2.6177 4.4191 + 0.0800 1.4811 2.5707 4.3097 + 0.0900 1.4709 2.5309 4.2167 + 0.1000 1.4615 2.4972 4.1387", + header = TRUE + ) + ) + + for (i in seq_len(nrow(chen_tab_1))) { + d_recovered <- oddsratio_to_d(chen_tab_1[i, 2:4], p0 = chen_tab_1[i, 1]) + expect_equal(d_recovered, c(0.2, 0.5, 0.8), tolerance = 0.01, ignore_attr = TRUE) + } }) diff --git a/tests/testthat/test-interpret.R b/tests/testthat/test-interpret.R index 31433fc99..2eff82a83 100644 --- a/tests/testthat/test-interpret.R +++ b/tests/testthat/test-interpret.R @@ -1,16 +1,19 @@ # interpret generic ---- test_that("interpret generic", { rules_grid <- rules(c(0.01, 0.05), c("very significant", "significant", "not significant")) - expect_equal(interpret(0.001, rules_grid)[1], "very significant") - expect_equal(interpret(0.021, rules_grid)[1], "significant") - expect_equal(interpret(0.08, rules_grid)[1], "not significant") - expect_equal( + expect_identical(interpret(0.001, rules_grid)[1], "very significant") + expect_identical(interpret(0.021, rules_grid)[1], "significant") + expect_identical(interpret(0.08, rules_grid)[1], "not significant") + expect_identical( interpret(c(0.01, 0.005, 0.08), rules_grid)[1:3], c("very significant", "very significant", "not significant") ) - expect_error(rules(c(0.5), c("A", "B", "C")), "Too many") + expect_error(rules(0.5, c("A", "B", "C")), "Too many") expect_error(rules(c(0.5, 0.2, 0.7), c("A", "B", "C", "D")), "sorted") + expect_error(rules(1), NA) + expect_error(rules("a"), "must be numeric") + r1 <- rules(c(0, 1), labels = c("some", "few", "many")) r2 <- rules(c(0, 1), labels = c("some", "few", "many"), right = FALSE) @@ -19,95 +22,123 @@ test_that("interpret generic", { expect_equal(interpret(c(0, 1), r2)[], c("few", "many"), ignore_attr = TRUE) }) + +test_that("interpret matrix / array", { + # Matrix + r <- cor(mtcars[, 8:11]) + out <- interpret_r(r) + + expect_identical(dim(out), dim(r)) + expect_identical(dimnames(out), dimnames(r)) + + out2 <- interpret_r(as.vector(r)) + expect_equal(out2, as.vector(out), ignore_attr = TRUE) + + # Array + set.seed(111) + p <- array(runif(3 * 2 * 4, max = 0.1), dim = c(3, 2, 4)) + out <- interpret_p(p, rules = "rss") + + expect_identical(dim(out), dim(p)) + + out2 <- interpret_p(as.vector(p), rules = "rss") + expect_equal(out2, as.vector(out), ignore_attr = TRUE) +}) + # interpret types ---- test_that("interpret_r", { - expect_equal(interpret_r(0.21)[1], "medium") - expect_equal(interpret_r(0.21, "cohen1988")[1], "small") - expect_equal(interpret_r(0.21, "lovakov2021")[1], "small") - expect_equal(interpret_r(0.7, "evans1996")[1], "strong") - expect_equal(interpret_r(c(0.5, -0.08), "cohen1988")[1:2], c("large", "very small")) - expect_equal(interpret_r(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_r(0.21)[1], "medium") + expect_identical(interpret_r(0.21, "cohen1988")[1], "small") + expect_identical(interpret_r(0.21, "lovakov2021")[1], "small") + expect_identical(interpret_r(0.7, "evans1996")[1], "strong") + expect_identical(interpret_r(c(0.5, -0.08), "cohen1988")[1:2], c("large", "very small")) + expect_identical(interpret_r(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_r(0.6, "DUPA"), "must be") }) test_that("interpret_p", { - expect_equal(interpret_p(0.021)[1], "significant") - expect_equal(interpret_p(0.08)[1], "not significant") - expect_equal(interpret_p(c(0.01, 0.08))[1:2], c("significant", "not significant")) - expect_equal(interpret_p(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_p(0.021)[1], "significant") + expect_identical(interpret_p(0.08)[1], "not significant") + expect_identical(interpret_p(c(0.01, 0.08))[1:2], c("significant", "not significant")) + expect_identical(interpret_p(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_p(0.6, "DUPA"), "must be") }) test_that("interpret_direction", { - expect_equal(interpret_direction(c(0.01, -0.08))[1:2], c("positive", "negative")) + expect_identical(interpret_direction(c(0.01, -0.08))[1:2], c("positive", "negative")) }) test_that("interpret_cohens_d", { - expect_equal(interpret_cohens_d(0.021)[1], "very small") - expect_equal(interpret_cohens_d(1.3, "sawilowsky2009")[1], "very large") - expect_equal(interpret_cohens_d(c(0.45, 0.85), "cohen1988")[1:2], c("small", "large")) - expect_equal(interpret_cohens_d(c(0.45, 0.85), "lovakov2021")[1:2], c("medium", "large")) - expect_equal(interpret_cohens_d(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_cohens_d(0.021)[1], "very small") + expect_identical(interpret_cohens_d(1.3, "sawilowsky2009")[1], "very large") + expect_identical(interpret_cohens_d(c(0.45, 0.85), "cohen1988")[1:2], c("small", "large")) + expect_identical(interpret_cohens_d(c(0.45, 0.85), "lovakov2021")[1:2], c("medium", "large")) + expect_identical(interpret_cohens_d(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_cohens_d(0.6, "DUPA"), "must be") }) test_that("interpret_cohens_g", { - expect_equal(interpret_cohens_g(0.021)[1], "very small") - expect_equal(interpret_cohens_g(c(0.10, 0.35), "cohen1988")[1:2], c("small", "large")) - expect_equal(interpret_cohens_g(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_cohens_g(0.021)[1], "very small") + expect_identical(interpret_cohens_g(c(0.10, 0.35), "cohen1988")[1:2], c("small", "large")) + expect_identical(interpret_cohens_g(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_cohens_g(0.6, "DUPA"), "must be") }) test_that("interpret_rope", { - expect_equal(interpret_rope(0, ci = 0.9)[1], "significant") - expect_equal(interpret_rope(c(0.50, 1), ci = 0.9)[1:2], c("undecided", "negligible")) - expect_equal(interpret_rope(c(0.98, 0.991), ci = 1)[1:2], c("probably negligible", "negligible")) - expect_equal(interpret_rope(0.6, , rules(c(0.5), c("A", "B")))[1], "B") - expect_error(interpret_rope(0.6, , "DUPA"), "must be") + expect_identical(interpret_rope(0, ci = 0.9)[1], "significant") + expect_identical(interpret_rope(c(0.50, 1), ci = 0.9)[1:2], c("undecided", "negligible")) + expect_identical(interpret_rope(c(0.98, 0.991), ci = 1)[1:2], c("probably negligible", "negligible")) + expect_identical(interpret_rope(0.6, rules(0.5, c("A", "B")))[1], "B") + expect_error(interpret_rope(0.6, "DUPA"), "must be") }) test_that("interpret_oddsratio", { - expect_equal(interpret_oddsratio(2)[1], "small") - expect_equal(interpret_oddsratio(c(1, 3))[1:2], c("very small", "small")) - expect_equal(interpret_oddsratio(c(1, 3), "cohen1988")[1:2], c("very small", "medium")) - expect_equal(interpret_oddsratio(0.6, rules(c(0.5), c("A", "B")))[1], "B") - expect_error(interpret_oddsratio(0.6, "DUPA"), "must be") + # Chen 2010, table 1 row 6 + OR <- c(1.4, 2.5, 4.4, 7.5) + p0 <- 0.06 + expect_equal(interpret_oddsratio(OR, p0 = p0), c("very small", "small", "medium", "large"), ignore_attr = TRUE) + expect_equal(interpret_oddsratio(OR), c("very small", "medium", "large", "large"), ignore_attr = TRUE) + + expect_equal(interpret_oddsratio( + c(0.1, 0.5, 2, 10), + rules(3, c("A", "B")) + ), c("B", "A", "A", "B"), ignore_attr = TRUE) }) test_that("interpret_r2", { - expect_equal(interpret_r2(0.4)[1], "substantial") - expect_equal(interpret_r2(c(0, 0.4), "falk1992")[1:2], c("negligible", "adequate")) - expect_equal(interpret_r2(c(0.1, 0.4), "chin1998")[1:2], c("very weak", "moderate")) - expect_equal(interpret_r2(c(0.1, 0.4), "hair2011")[1:2], c("very weak", "weak")) - expect_equal(interpret_r2(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_r2(0.4)[1], "substantial") + expect_identical(interpret_r2(c(0, 0.4), "falk1992")[1:2], c("negligible", "adequate")) + expect_identical(interpret_r2(c(0.1, 0.4), "chin1998")[1:2], c("very weak", "moderate")) + expect_identical(interpret_r2(c(0.1, 0.4), "hair2011")[1:2], c("very weak", "weak")) + expect_identical(interpret_r2(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_r2(0.6, "DUPA"), "must be") }) test_that("interpret_bf", { expect_error(interpret_bf(-2), "Negative") - expect_equal(interpret_bf(1)[1], "no evidence against or in favour of") - expect_equal( + expect_identical(interpret_bf(1)[1], "no evidence against or in favour of") + expect_identical( interpret_bf(c(0.8, 3.5), "jeffreys1961")[1:2], c("anecdotal evidence against", "moderate evidence in favour of") ) - expect_equal( + expect_identical( interpret_bf(c(0.8, 3.5), "raftery1995")[1:2], c("weak evidence against", "positive evidence in favour of") ) - expect_equal(interpret_bf(2, rules(c(0.5), c("A", "B")))[1], "B evidence in favour of") + expect_identical(interpret_bf(2, rules(0.5, c("A", "B")))[1], "B evidence in favour of") expect_error(interpret_bf(2, "DUPA"), "must be") skip_on_cran() # just in case there are changes in insight bf <- c(10^seq(-4, 4), NA) - expect_equal(interpret_bf(bf, include_value = TRUE, protect_ratio = TRUE, exact = TRUE), + expect_identical(interpret_bf(bf, include_value = TRUE, protect_ratio = TRUE, exact = TRUE), c( "extreme evidence (BF = 1/1.00e+04) against", "extreme evidence (BF = 1/1000.00) against", "very strong evidence (BF = 1/100.00) against", "moderate evidence (BF = 1/10.00) against", @@ -122,61 +153,61 @@ test_that("interpret_bf", { test_that("interpret_omega_squared", { - expect_equal(interpret_omega_squared(0.1)[1], "medium") - expect_equal(interpret_omega_squared(c(0.1, 0.25))[1:2], c("medium", "large")) - expect_equal(interpret_omega_squared(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_omega_squared(0.1)[1], "medium") + expect_identical(interpret_omega_squared(c(0.1, 0.25))[1:2], c("medium", "large")) + expect_identical(interpret_omega_squared(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_omega_squared(0.6, "DUPA"), "must be") # these should be same - expect_equal(interpret_eta_squared(0.1)[1], interpret_omega_squared(0.1)[1]) - expect_equal( + expect_identical(interpret_eta_squared(0.1)[1], interpret_omega_squared(0.1)[1]) + expect_identical( interpret_eta_squared(c(0.1, 0.25))[1:2], interpret_omega_squared(c(0.1, 0.25))[1:2] ) }) test_that("interpret_kendalls_w", { - expect_equal(interpret_kendalls_w(0.1)[1], "slight agreement") - expect_equal( + expect_identical(interpret_kendalls_w(0.1)[1], "slight agreement") + expect_identical( interpret_kendalls_w(c(0.1, 0.25))[1:2], c("slight agreement", "fair agreement") ) - expect_equal(interpret_kendalls_w(0.9)[1], "almost perfect agreement") - expect_equal(interpret_kendalls_w(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_kendalls_w(0.9)[1], "almost perfect agreement") + expect_identical(interpret_kendalls_w(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_kendalls_w(0.6, "DUPA"), "must be") }) test_that("interpret_rhat", { - expect_equal(interpret_rhat(1)[1], "converged") - expect_equal(interpret_rhat(c(1, 1.02))[1:2], c("converged", "failed")) - expect_equal(interpret_rhat(c(1, 1.02), "gelman1992")[1:2], c("converged", "converged")) - expect_equal(interpret_rhat(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_rhat(1)[1], "converged") + expect_identical(interpret_rhat(c(1, 1.02))[1:2], c("converged", "failed")) + expect_identical(interpret_rhat(c(1, 1.02), "gelman1992")[1:2], c("converged", "converged")) + expect_identical(interpret_rhat(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_rhat(0.6, "DUPA"), "must be") }) test_that("interpret_ess", { - expect_equal(interpret_ess(1000)[1], "sufficient") - expect_equal(interpret_ess(c(1000, 800))[1:2], c("sufficient", "insufficient")) - expect_equal(interpret_ess(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_ess(1000)[1], "sufficient") + expect_identical(interpret_ess(c(1000, 800))[1:2], c("sufficient", "insufficient")) + expect_identical(interpret_ess(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_ess(0.6, "DUPA"), "must be") }) test_that("interpret_fit", { - expect_equal(interpret_gfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_agfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_nfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_nnfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_cfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_rfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_ifi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_pnfi(c(.5, .99)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_rmsea(c(.1, .05)), c("poor", "satisfactory"), ignore_attr = TRUE) - expect_equal(interpret_srmr(c(.1, .05)), c("poor", "satisfactory"), ignore_attr = TRUE) - - cr <- rules(c(0.5), c("A", "B")) + expect_equal(interpret_gfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_agfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_nfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_nnfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_cfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_rfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_ifi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_pnfi(c(0.5, 0.99)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_rmsea(c(0.1, 0.05)), c("poor", "satisfactory"), ignore_attr = TRUE) + expect_equal(interpret_srmr(c(0.1, 0.05)), c("poor", "satisfactory"), ignore_attr = TRUE) + + cr <- rules(0.5, c("A", "B")) expect_equal(interpret_gfi(0.6, cr), "B", ignore_attr = TRUE) expect_equal(interpret_agfi(0.6, cr), "B", ignore_attr = TRUE) expect_equal(interpret_nfi(0.6, cr), "B", ignore_attr = TRUE) @@ -208,29 +239,29 @@ test_that("interpret_fit", { dem60 ~ ind60 " model <- lavaan::sem(structure, data = lavaan::PoliticalDemocracy) int <- interpret(model) - expect_equal(int$Name, c("GFI", "AGFI", "NFI", "NNFI", "CFI", "RMSEA", "SRMR", "RFI", "PNFI", "IFI")) + expect_identical(int$Name, c("GFI", "AGFI", "NFI", "NNFI", "CFI", "RMSEA", "SRMR", "RFI", "PNFI", "IFI")) expect_equal(int$Value, c(0.9666, 0.9124, 0.9749, 1.0001, 1, 0, 0.0273, 0.9529, 0.5199, 1.0001), tolerance = 0.001) int2 <- interpret(performance::model_performance(model)) - expect_equal(int, int2) + expect_identical(int, int2) }) test_that("interpret_icc", { expect_equal(interpret_icc(c(0.45, 0.55, 0.8, 0.95)), c("poor", "moderate", "good", "excellent"), ignore_attr = TRUE) - expect_equal(interpret_icc(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_icc(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_icc(0.6, "DUPA"), "must be") }) test_that("interpret_vif", { expect_equal(interpret_vif(c(1, 5.5, 10)), c("low", "moderate", "high"), ignore_attr = TRUE) - expect_equal(interpret_icc(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_icc(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_icc(0.6, "DUPA"), "must be") }) test_that("interpret_pd", { expect_equal(interpret_pd(c(0.9, 0.99)), c("not significant", "significant"), ignore_attr = TRUE) expect_equal(interpret_pd(c(0.9, 0.99), "makowski2019"), c("uncertain", "likely existing"), ignore_attr = TRUE) - expect_equal(interpret_pd(0.6, rules(c(0.5), c("A", "B")))[1], "B") + expect_identical(interpret_pd(0.6, rules(0.5, c("A", "B")))[1], "B") expect_error(interpret_pd(0.6, "DUPA"), "must be") }) @@ -258,7 +289,7 @@ test_that("interpret effectsize_table", { d1_ <- interpret(d1, rules = "cohen1988") d2_ <- interpret(d2, rules = "cohen1988") - expect_equal(d1_$Interpretation, d2_$Interpretation) - expect_equal(d1_[[1]], d1[[1]]) - expect_equal(d2_[[1]], d2[[1]]) + expect_identical(d1_$Interpretation, d2_$Interpretation) + expect_identical(d1_[[1]], d1[[1]]) + expect_identical(d2_[[1]], d2[[1]]) })