fix #650

R/interpret.R

@@ -91,6 +91,8 @@ is.rules <- function(x) inherits(x, "rules")
 #'   frame of class `effectsize_table`.
 #' @param rules Set of [rules()]. When `x` is a data frame, can be a name of an
 #'   established set of rules.
+#' @param transform a function (or name of a function) to apply to `x` before
+#'   interpreting. See examples.
 #' @param ... Currently not used.
 #' @inheritParams rules
 #'
@@ -133,21 +135,26 @@ interpret <- function(x, ...) {
 
 #' @rdname interpret
 #' @export
-interpret.numeric <- function(x, rules, name = attr(rules, "rule_name"), ...) {
+interpret.numeric <- function(x, rules, name = attr(rules, "rule_name"),
+                              transform = NULL, ...) {
+  if (is.null(transform)) transform <- identity
+  transform <- match.fun(transform)
+  x_tran <- transform(x)
+
   if (!inherits(rules, "rules")) {
     rules <- rules(rules)
   }
 
   if (is.null(name)) name <- "Custom rules"
   attr(rules, "rule_name") <- name
 
-  if (length(x) > 1) {
-    out <- vapply(x, .interpret, rules = rules, FUN.VALUE = character(1L))
+  if (length(x_tran) > 1) {
+    out <- vapply(x_tran, .interpret, rules = rules, FUN.VALUE = character(1L))
   } else {
-    out <- .interpret(x, rules = rules)
+    out <- .interpret(x_tran, rules = rules)
   }
 
-  names(out) <- names(x)
+  names(out) <- names(x_tran)
 
   class(out) <- c("effectsize_interpret", class(out))
   attr(out, "rules") <- rules
@@ -156,11 +163,14 @@ interpret.numeric <- function(x, rules, name = attr(rules, "rule_name"), ...) {
 
 #' @rdname interpret
 #' @export
-interpret.effectsize_table <- function(x, rules, ...) {
+interpret.effectsize_table <- function(x, rules, transform = NULL, ...) {
   if (missing(rules)) insight::format_error("You {.b must} specify the rules of interpretation!")
 
+  if (is.null(transform)) transform <- identity
+  transform <- match.fun(transform)
+
   es_name <- colnames(x)[is_effectsize_name(colnames(x))]
-  value <- x[[es_name]]
+  value <- transform(x[[es_name]])
 
   x$Interpretation <- switch(es_name,
     ## std diff

R/interpret_bf.R

@@ -30,7 +30,7 @@
 #'
 #' @examples
 #' interpret_bf(1)
-#' interpret_bf(c(5, 2))
+#' interpret_bf(c(5, 2, 0.01))
 #'
 #' @references
 #' - Jeffreys, H. (1961), Theory of Probability, 3rd ed., Oxford University
@@ -50,54 +50,42 @@ interpret_bf <- function(bf,
                          include_value = FALSE,
                          protect_ratio = TRUE,
                          exact = TRUE) {
-  if (log) bf <- exp(bf)
-
-  if (any(bf < 0, na.rm = TRUE)) {
-    insight::format_warning("Negative BFs detected. These are not possible, and are {.i ignored}.")
-    bf[bf < 0] <- NA
+  if (!log && any(bf < 0, na.rm = TRUE)) {
+    insight::format_error("Negative BFs detected. These are not possible, and are {.i ignored}.")
   }
 
-  orig_bf <- bf
-
-  dir <- rep("against or in favour of", length.out = length(bf))
-  dir <- replace(dir, is.na(bf), NA_character_)
-  dir <- replace(dir, bf < 1, "against")
-  dir <- replace(dir, bf > 1, "in favour of")
-  bf <- exp(abs(log(bf)))
+  if (!log) bf <- log(bf)
 
+  # interpret strength
   rules <- .match.rules(
     rules,
     list(
       jeffreys1961 = rules(c(3, 10, 30, 100), c("anecdotal", "moderate", "strong", "very strong", "extreme"),
-        name = "jeffreys1961"
+                           name = "jeffreys1961"
       ),
       raftery1995 = rules(c(3, 20, 150), c("weak", "positive", "strong", "very strong"),
-        name = "raftery1995"
+                          name = "raftery1995"
       )
     )
   )
 
-  interpretation <- interpret(bf, rules)
+  interpretation <- interpret(bf, rules, transform = function(.x) exp(abs(.x)))
+  interpretation[bf == 0] <- "no"
 
-  # Format text
-  interpretation[] <- paste0(interpretation, " evidence")
-  interpretation[orig_bf == 1] <- "no evidence"
+  # interpret direction
+  dir <- interpret(bf, rules(0, c("against", "in favour of")))
+  dir[bf == 0] <- "against or in favour of"
 
-  # Add value if asked for
+  # Format text
   if (include_value) {
-    interpretation[] <-
-      paste0(
-        interpretation,
-        " (",
-        insight::format_bf(orig_bf, protect_ratio = protect_ratio, exact = exact),
-        ")"
-      )
+    bf_fmt <- insight::format_bf(exp(bf), protect_ratio = protect_ratio, exact = exact)
+    interpretation[] <- sprintf("%s evidence (%s) %s", interpretation, bf_fmt, dir)
+  } else {
+    interpretation[] <- paste0(interpretation, " evidence ", dir)
   }
 
-  # Add direction
-  interpretation[] <- paste(interpretation[], dir)
-
-  interpretation[is.na(orig_bf)] <- ""
+  interpretation[is.na(bf)] <- ""
+  interpretation[] <- trimws(interpretation, "right")
 
   interpretation
 }

R/interpret_cohens_d.R

@@ -81,7 +81,7 @@ interpret_cohens_d <- function(d, rules = "cohen1988", ...) {
     )
   )
 
-  interpret(abs(d), rules)
+  interpret(d, rules, transform = abs)
 }
 
 #' @rdname interpret_cohens_d

R/interpret_cohens_g.R

@@ -42,5 +42,5 @@ interpret_cohens_g <- function(g, rules = "cohen1988", ...) {
     )
   )
 
-  interpret(abs(g), rules)
+  interpret(g, rules, transform = abs)
 }

R/interpret_ess_rhat.R

@@ -49,7 +49,7 @@ interpret_ess <- function(ess, rules = "burkner2017") {
     )
   )
 
-  interpret(abs(ess), rules)
+  interpret(ess, rules)
 }
 
 
@@ -65,5 +65,5 @@ interpret_rhat <- function(rhat, rules = "vehtari2019") {
     )
   )
 
-  interpret(abs(rhat), rules)
+  interpret(rhat, rules)
 }

R/interpret_oddsratio.R

@@ -42,15 +42,15 @@
 #' @export
 interpret_oddsratio <- function(OR, rules = "chen2010", log = FALSE, ...) {
   if (log) {
-    OR <- exp(abs(OR))
+    f_transform <- function(.x) exp(abs(.x))
   } else {
-    OR <- exp(abs(log(OR)))
+    f_transform <- function(.x) exp(abs(log(.x)))
   }
 
 
   if (is.character(rules) && rules == "cohen1988") {
-    d <- oddsratio_to_d(OR, log = FALSE)
-    return(interpret_cohens_d(abs(d), rules = rules))
+    d <- oddsratio_to_d(OR, log = log)
+    return(interpret_cohens_d(d, rules = rules))
   }
 
   rules <- .match.rules(
@@ -63,5 +63,5 @@ interpret_oddsratio <- function(OR, rules = "chen2010", log = FALSE, ...) {
     )
   )
 
-  interpret(OR, rules)
+  interpret(OR, rules, transform = f_transform)
 }

R/interpret_r.R

@@ -106,7 +106,7 @@ interpret_r <- function(r, rules = "funder2019", ...) {
     )
   )
 
-  interpret(abs(r), rules)
+  interpret(r, rules, transform = abs)
 }
 
 #' @export

tests/testthat/test-interpret.R

@@ -92,7 +92,7 @@ test_that("interpret_r2", {
 
 
 test_that("interpret_bf", {
-  expect_warning(interpret_bf(-2), "Negative")
+  expect_error(interpret_bf(-2), "Negative")
   expect_equal(interpret_bf(1)[1], "no evidence against or in favour of")
   expect_equal(
     interpret_bf(c(0.8, 3.5), "jeffreys1961")[1:2],
@@ -252,4 +252,13 @@ test_that("interpret effectsize_table", {
   expect_output(print(V_), "Interpretation rule: funder2019")
 
   expect_error(interpret(d), "must specify")
+
+  d1 <- cohens_d(mtcars$wt, mu = 4)
+  d2 <- cohens_d(-mtcars$wt, mu = -4)
+  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]])
 })