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]
easystats · Dec 8, 2024 · 21fc13c · 21fc13c
1 parent 5ffe7ba
commit 21fc13c
Show file tree

Hide file tree

Showing 14 changed files with 200 additions and 141 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
diff --git a/man/interpret_direction.Rd b/man/interpret_direction.Rd
diff --git a/man/interpret_oddsratio.Rd b/man/interpret_oddsratio.Rd
diff --git a/man/interpret_rope.Rd b/man/interpret_rope.Rd
diff --git 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)
+  }
 })