Add method for Fischer's exact test

DESCRIPTION

@@ -56,7 +56,7 @@ Depends:
     R (>= 3.6)
 Imports:
     bayestestR (>= 0.13.0),
-    effectsize (>= 0.8.5),
+    effectsize (>= 0.8.6.1),
     insight (>= 0.19.3.2),
     parameters (>= 0.20.2),
     performance (>= 0.10.2),
@@ -125,6 +125,7 @@ Collate:
     'report_effectsize.R'
     'report_htest_chi2.R'
     'report_htest_cor.R'
+    'report_htest_fisher.R'
     'report_htest_friedman.R'
     'report_htest_ttest.R'
     'report_htest_wilcox.R'

NEWS.md

@@ -6,7 +6,7 @@ Major Changes
 
 Minor changes 
 
-* `report` now supports variables of class `htest` for the Friedman test.
+* `report` now supports variables of class `htest` for the Chi2, Friedman test, and Fisher's exact test.
 
 * `report` now supports variables of class `Date`, treating them like factors.
 

R/report.htest.R

@@ -74,7 +74,11 @@ report_effectsize.htest <- function(x, ...) {
   ## For Chi2 ---------------
 
   if (model_info$is_chi2test) {
-    out <- .report_effectsize_chi2(x, table, dot_args)
+    if (chi2_type(x) == "fisher") {
+      out <- .report_effectsize_fisher(x, table, dot_args)
+    } else {
+      out <- .report_effectsize_chi2(x, table, dot_args)
+    }
   }
 
   # TODO: Chi-squared test -------------
@@ -161,7 +165,10 @@ report_statistics.htest <- function(x, table = NULL, ...) {
   text <- NULL
 
   # Estimate
-  candidates <- c("rho", "r", "tau", "Difference", "r_rank_biserial", "Chi2")
+  candidates <- c(
+    "rho", "r", "tau", "Difference", "r_rank_biserial",
+    "Chi2", "Odds Ratio"
+  )
   estimate <- candidates[candidates %in% names(table)][1]
   if (!is.null(estimate) && !is.na(estimate)) {
     text <- paste0(tolower(estimate), " = ", insight::format_value(table[[estimate]]))
@@ -257,7 +264,11 @@ report_parameters.htest <- function(x, table = NULL, ...) {
     out <- .report_parameters_friedman(table, stats, effsize, ...)
     # chi2
   } else if (model_info$is_chi2test) {
-    out <- .report_parameters_chi2(table, stats, effsize, ...)
+    if (chi2_type(x) == "fisher") {
+      out <- .report_parameters_fisher(table, stats, effsize, ...)
+    } else {
+      out <- .report_parameters_chi2(table, stats, effsize, ...)
+    }
   } else {
     # TODO: default, same as t-test?
     out <- .report_parameters_htest_default(table, stats, effsize, ...)
@@ -312,7 +323,11 @@ report_model.htest <- function(x, table = NULL, ...) {
   }
 
   if (model_info$is_chi2test) {
-    text <- .report_model_chi2(x, table)
+    if (chi2_type(x) == "fisher") {
+      text <- .report_model_fisher(x, table)
+    } else {
+      text <- .report_model_chi2(x, table)
+    }
   }
 
   as.report_model(text, summary = text)

R/report_htest_fisher.R

@@ -0,0 +1,111 @@
+# report_table -----------------
+
+.report_table_fisher <- function(table_full, effsize) {
+  table_full <- cbind(table_full, attributes(effsize)$table)
+  list(table = NULL, table_full = table_full)
+}
+
+
+# report_effectsize ---------------------
+
+.report_effectsize_fisher <- function(x, table, dot_args, rules = "funder2019") {
+  args <- c(list(x), dot_args)
+  table <- do.call(effectsize::effectsize, args)
+  ci <- attributes(table)$ci
+  estimate <- names(table)[1]
+  rules <- ifelse(is.null(dot_args$rules), rules, dot_args$rules)
+
+  args <- list(table, rules = rules, dot_args)
+  interpretation <- do.call(effectsize::interpret, args)$Interpretation
+  rules <- .text_effectsize(attr(attr(interpretation, "rules"), "rule_name"))
+
+  if (estimate == "Cramers_v_adjusted") {
+    main <- paste0("Adjusted Cramer's v = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Tschuprows_t") {
+    main <- paste0("Tschuprow's t = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Tschuprows_t_adjusted") {
+    main <- paste0("Adjusted Tschuprow's t = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Pearsons_c") {
+    main <- paste0("Pearson's c = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "phi_adjusted") {
+    main <- paste0("Adjusted Phi = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Cohens_h") {
+    main <- paste0("Cohen's h = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Odds_ratio") {
+    main <- paste0("Odds ratio = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "Ris_kratio") {
+    main <- paste0("Risk ratio = ", insight::format_value(table[[estimate]]))
+  } else if (estimate == "cohens_h") {
+    main <- paste0("Cohen's w = ", insight::format_value(table[[estimate]]))
+  } else {
+    main <- paste0(estimate, " = ", insight::format_value(table[[estimate]]))
+  }
+
+  statistics <- paste0(
+    main,
+    ", ",
+    insight::format_ci(table$CI_low, table$CI_high, ci)
+  )
+
+  table <- datawizard::data_rename(
+    as.data.frame(table),
+    c("CI_low", "CI_high"),
+    paste0(estimate, c("_CI_low", "_CI_high"))
+  )
+
+  table <- table[c(estimate, paste0(estimate, c("_CI_low", "_CI_high")))]
+
+  list(
+    table = table, statistics = statistics, interpretation = interpretation,
+    rules = rules, ci = ci, main = main
+  )
+}
+
+# report_model ----------------------------
+
+.report_model_fisher <- function(x, table) {
+  vars_full <- paste0(names(attributes(x$observed)$dimnames), collapse = " and ")
+
+  text <- paste0(
+    trimws(x$method),
+    " testing the association between the variables of the ",
+    x$data.name, " dataset "
+  )
+
+  text
+}
+
+chi2_type <- function(x) {
+  if (grepl("probabilities", x$method, fixed = TRUE)) {
+    out <- "probabilities"
+  } else if (grepl("Pearson", x$method, fixed = TRUE)) {
+    out <- "pearson"
+  } else if (grepl("Fisher", x$method, fixed = TRUE)) {
+    out <- "fisher"
+  }
+  out
+}
+
+.report_parameters_fisher <- function(table, stats, effsize, ...) {
+  text_full <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and ",
+    attributes(effsize)$interpretation,
+    " (",
+    stats,
+    ")"
+  )
+
+  text_short <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and ",
+    attributes(effsize)$interpretation,
+    " (",
+    summary(stats),
+    ")"
+  )
+
+  list(text_short = text_short, text_full = text_full)
+}

tests/testthat/_snaps/windows/report.htest-chi2.md

@@ -1,138 +1,3 @@
-# report.htest-chi2 report_effectsize
-
-    Code
-      report_effectsize(x)
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, rules = "funder2019")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, rules = "gignac2016")
-    Output
-      Effect sizes were labelled following Gignac's (2016) recommendations. 
-
-      small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, rules = "cohen1988")
-    Output
-      Effect sizes were labelled following Cohen's (1988) recommendations. 
-
-      small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, rules = "evans1996")
-    Output
-      Effect sizes were labelled following Evans's (1996) recommendations. 
-
-      very weak (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, rules = "lovakov2021")
-    Output
-      Effect sizes were labelled following Lovakov's (2021) recommendations. 
-
-      very small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "cramers_v")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      small (Adjusted Cramer's v = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "pearsons_c")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      small (Pearson's c = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "tschuprows_t", adjust = FALSE)
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      very small (Tschuprow's t = 0.09, 95% CI [0.06, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "tschuprows_t")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      very small (Adjusted Tschuprow's t = 0.08, 95% CI [0.06, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "cohens_w")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      small (Cohens_w = 0.10, 95% CI [0.07, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "phi")
-    Output
-      Effect sizes were labelled following Funder's (2019) recommendations. 
-
-      large (Adjusted Phi = 0.36, 95% CI [0.25, 1.00])
-
----
-
-    Code
-      report_effectsize(x, type = "cohens_h", rules = "sawilowsky2009")
-    Output
-      Effect sizes were labelled following Savilowsky's (2009) recommendations. 
-
-      medium (Cohen's h = 0.74, 95% CI [0.50, 0.99])
-
----
-
-    Code
-      report_effectsize(x, type = "oddsratio", rules = "chen2010")
-    Output
-      Effect sizes were labelled following Chen's (2010) recommendations. 
-
-      medium (Odds ratio = 4.73, 95% CI [2.74, 8.17])
-
----
-
-    Code
-      report_effectsize(x, type = "riskratio")
-    Output
-
-
-       (Risk_ratio = 2.54, 95% CI [1.80, 3.60])
-
 # report.htest-chi2 report
 
     Code
@@ -318,10 +183,10 @@
     Code
       report(x)
     Output
-
+      Effect sizes were labelled following Funder's (2019) recommendations.
 
       The Chi-squared test for given probabilities / goodness of fit of
       table(mtcars$cyl) to a distribution of [4: n=3.2, 6: n=9.6, 8: n=19.2] suggests
-      that the effect is statistically significant, and (chi2 = 21.12, p < .001; Fei
-      = 0.27, 95% CI [0.17, 1.00])
+      that the effect is statistically significant, and medium (chi2 = 21.12, p <
+      .001; Fei = 0.27, 95% CI [0.17, 1.00])
 

tests/testthat/_snaps/windows/report.htest-fisher.md

@@ -0,0 +1,12 @@
+# report.htest-fisher report
+
+    Code
+      report(x)
+    Output
+      Effect sizes were labelled following Funder's (2019) recommendations.
+
+      The Fisher's Exact Test for Count Data testing the association between the
+      variables of the TeaTasting dataset suggests that the effect is statistically
+      not significant, and large (odds ratio = 6.41, 95% CI [0.31, Inf], p = 0.243;
+      Adjusted Cramer's v = 0.35, 95% CI [0.00, 1.00])
+