init #464

R/interpret_bf.R

@@ -13,20 +13,11 @@
 #'
 #' Rules apply to BF as ratios, so BF of 10 is as extreme as a BF of 0.1 (1/10).
 #'
-#' - Jeffreys (1961) (`"jeffreys1961"`; default)
-#'   - **BF = 1** - No evidence
-#'   - **1 < BF <= 3** - Anecdotal
-#'   - **3 < BF <= 10** - Moderate
-#'   - **10 < BF <= 30** - Strong
-#'   - **30 < BF <= 100** - Very strong
-#'   - **BF > 100** - Extreme.
-#' - Raftery (1995) (`"raftery1995"`)
-#'   - **BF = 1** - No evidence
-#'   - **1 < BF <= 3** - Weak
-#'   - **3 < BF <= 20** - Positive
-#'   - **20 < BF <= 150** - Strong
-#'   - **BF > 150** - Very strong
+#' ```{r, echo = FALSE, results = "asis"}
+#' insight::print_md(.i_bf_jeffreys1961, "BF", "Jeffreys(1961) (`{.rn}`; default):\n- **BF = 1** - No evidence")
 #'
+#' insight::print_md(.i_bf_raftery1995, "BF", "Raftery (1995) (`{.rn}`):\n- **BF = 1** - No evidence")
+#' ```
 #'
 #' @examples
 #' interpret_bf(1)
@@ -68,12 +59,8 @@ interpret_bf <- function(bf,
   rules <- .match.rules(
     rules,
     list(
-      jeffreys1961 = rules(c(3, 10, 30, 100), c("anecdotal", "moderate", "strong", "very strong", "extreme"),
-        name = "jeffreys1961"
-      ),
-      raftery1995 = rules(c(3, 20, 150), c("weak", "positive", "strong", "very strong"),
-        name = "raftery1995"
-      )
+      jeffreys1961 = .i_bf_jeffreys1961,
+      raftery1995 = .i_bf_raftery1995
     )
   )
 
@@ -101,3 +88,16 @@ interpret_bf <- function(bf,
 
   interpretation
 }
+
+
+# rules -------------------------------------------------------------------
+
+#' @keywords internal
+.i_bf_jeffreys1961 <- rules(c(3, 10, 30, 100),
+                            c("anecdotal", "moderate", "strong", "very strong", "extreme"),
+                            name = "jeffreys1961")
+
+#' @keywords internal
+.i_bf_raftery1995 <- rules(c(3, 20, 150),
+                           c("weak", "positive", "strong", "very strong"),
+                           name = "raftery1995")

R/interpret_cohens_d.R

@@ -14,29 +14,16 @@
 #' Rules apply to equally to positive and negative *d* (i.e., they are given as
 #' absolute values).
 #'
-#' - Cohen (1988) (`"cohen1988"`; default)
-#'   - **d < 0.2** - Very small
-#'   - **0.2 <= d < 0.5** - Small
-#'   - **0.5 <= d < 0.8** - Medium
-#'   - **d >= 0.8** - Large
-#' - Sawilowsky (2009) (`"sawilowsky2009"`)
-#'   - **d < 0.1** - Tiny
-#'   - **0.1 <= d < 0.2** - Very small
-#'   - **0.2 <= d < 0.5** - Small
-#'   - **0.5 <= d < 0.8** - Medium
-#'   - **0.8 <= d < 1.2** - Large
-#'   - **1.2 <= d < 2** - Very large
-#'   - **d >= 2** - Huge
-#' - Lovakov & Agadullina (2021) (`"lovakov2021"`)
-#'   - **d < 0.15** - Very small
-#'   - **0.15 <= d < 0.36** - Small
-#'   - **0.36 <= d < 0.65** - Medium
-#'   - **d >= 0.65** - Large
-#' - Gignac & Szodorai (2016) (`"gignac2016"`, based on the [d_to_r()] conversion, see [interpret_r()])
-#'   - **d < 0.2** - Very small
-#'   - **0.2 <= d < 0.41** - Small
-#'   - **0.41 <= d < 0.63** - Moderate
-#'   - **d >= 0.63** - Large
+#' ```{r, echo = FALSE, results = "asis"}
+#' insight::print_md(.i_d_cohen1988, "d", "Cohen (1988) (`{.rn}`; default):")
+#'
+#' insight::print_md(.i_d_sawilowsky2009, "d", "Sawilowsky (2009) (`{.rn}`):")
+#'
+#' insight::print_md(.i_d_lovakov2021, "d", "Lovakov & Agadullina (2021) (`{.rn}`):")
+#'
+#' tit <- "Gignac & Szodorai (2016) (`{.rn}`, based on the [d_to_r()] conversion, see [interpret_r()]):"
+#' insight::print_md(i_d_gignac2016, "d", tit)
+#' ```
 #'
 #' @examples
 #' interpret_cohens_d(.02)
@@ -59,25 +46,13 @@
 #' @keywords interpreters
 #' @export
 interpret_cohens_d <- function(d, rules = "cohen1988", ...) {
-  if (is.character(rules) && rules == "gignac2016") {
-    return(interpret_r(d_to_r(d), rules))
-  }
-
   rules <- .match.rules(
     rules,
     list(
-      cohen1988 = rules(c(0.2, 0.5, 0.8), c("very small", "small", "medium", "large"),
-        name = "cohen1988", right = FALSE
-      ),
-      sawilowsky2009 = rules(c(0.1, 0.2, 0.5, 0.8, 1.2, 2),
-        c("tiny", "very small", "small", "medium", "large", "very large", "huge"),
-        name = "sawilowsky2009", right = FALSE
-      ),
-      lovakov2021 = rules(c(0.15, 0.36, 0.65),
-        c("very small", "small", "medium", "large"),
-        name = "lovakov2021", right = FALSE
-      ),
-      gignac2016 = NA # added for the correct error msg
+      cohen1988 = .i_d_cohen1988,
+      sawilowsky2009 =.i_d_sawilowsky2009,
+      lovakov2021 = .i_d_lovakov2021,
+      gignac2016 = i_d_gignac2016
     )
   )
 
@@ -95,3 +70,25 @@ interpret_hedges_g <- function(g, rules = "cohen1988") {
 interpret_glass_delta <- function(delta, rules = "cohen1988") {
   interpret_cohens_d(delta, rules)
 }
+
+
+# rules -------------------------------------------------------------------
+
+#' @keywords internal
+.i_d_cohen1988 <- rules(c(0.2, 0.5, 0.8), c("very small", "small", "medium", "large"),
+                        name = "cohen1988", right = FALSE)
+
+#' @keywords internal
+.i_d_sawilowsky2009 <- rules(c(0.1, 0.2, 0.5, 0.8, 1.2, 2),
+                             c("tiny", "very small", "small", "medium", "large", "very large", "huge"),
+                             name = "sawilowsky2009", right = FALSE)
+
+#' @keywords internal
+.i_d_lovakov2021 <- rules(c(0.15, 0.36, 0.65),
+                          c("very small", "small", "medium", "large"),
+                          name = "lovakov2021", right = FALSE)
+
+#' @keywords internal
+i_d_gignac2016 <- rules(r_to_d(c(0.1, 0.2, 0.3)),
+                        c("very small", "small", "moderate", "large"),
+                        name = "gignac2016", right = FALSE)

R/print.rules.R

@@ -12,14 +12,51 @@ print.rules <- function(x, digits = "signif2", ...) {
 
 
 #' @export
-print_md.rules <- function(x, digits = "signif2", ...) {
-  x_fmt <- format(x, digits = digits, output = "markdown", ...)
+print_md.rules <- function(x, value = "x", title = "`{.rn}`:", ...) {
 
-  if (length(x$values) == length(x$labels)) {
-    insight::export_table(x_fmt, align = "rl", format = "markdown", ...)
+  rule_name <- attr(x, "rule_name")
+  title <- gsub("\\{\\.rn\\}", rule_name, title)
+
+  values <- insight::format_value(x$values, digits = "signif2", protect_integers = TRUE)
+  labels <- insight::format_capitalize(x$labels)
+
+  if (length(labels) > length(values)) {
+    right <- attr(x, "right")
+
+    k <- length(labels)
+
+    if (right) {
+      l <- "<"
+      r <- "<="
+    } else {
+      l <- "<="
+      r <- "<"
+    }
+
+    first <- sprintf("\n- **%s %s %s** - %s", value, r, values[1], labels[1])
+    last <- sprintf("\n- **%s %s %s** - %s", values[k-1], l, value, labels[k])
+
+    nth <- ""
+    if (k > 2L) {
+      nth <- sprintf("\n- **%s %s %s %s %s** - %s",
+                     values[1:(k-2)], l, value, r, values[2:(k-1)],
+                     labels[2:(k-1)])
+      nth <- paste0(nth, collapse = "")
+    }
+
+    fmt_rules <- paste0(c(first, nth, last), collapse = "")
   } else {
-    insight::export_table(x_fmt, align = "rcl", format = "markdown", ...)
+    fmt_rules <- sprintf("\n- **%s =~ %s** - %s",
+                         value, values, labels)
+    fmt_rules <- paste0(fmt_rules, collapse = "")
   }
+
+  cat("\n")
+  cat(title)
+  cat(fmt_rules)
+  cat("\n")
+
+  invisible(x)
 }
 
 
@@ -101,4 +138,4 @@ print.effectsize_interpret <- function(x, ...) {
   insight::print_color(paste0("(Rules: ", name, ")\n"), .pcl["interpret"])
 
   invisible(orig_x)
-}
+}