Add Kruskal-Wallis method (#397)

* add kruskal method

* fix tests errors, add tests/testthat/helper-state.R

* style and skip helper-state.R for this PR

* comment helper-state.R

* trigger tests again

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: report
 Type: Package
 Title: Automated Reporting of Results and Statistical Models
-Version: 0.5.7.12
+Version: 0.5.7.13
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",
@@ -127,6 +127,7 @@ Collate:
     'report_htest_cor.R'
     'report_htest_fisher.R'
     'report_htest_friedman.R'
+    'report_htest_kruskal.R'
     'report_htest_ttest.R'
     'report_htest_wilcox.R'
     'report_info.R'

NEWS.md

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

R/report.htest.R

@@ -58,6 +58,13 @@ report_effectsize.htest <- function(x, ...) {
 
     if (grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
       out <- .report_effectsize_friedman(x, table, dot_args)
+    } else if (!is.null(x$statistic) && grepl(
+      "Kruskal", attributes(x$statistic)$names,
+      fixed = TRUE
+    )) {
+      # For Kruskal-Wallis test ---------------
+
+      out <- .report_effectsize_kruskal(x, table, dot_args)
     } else {
       # For wilcox test ---------------
 
@@ -254,14 +261,20 @@ report_parameters.htest <- function(x, table = NULL, ...) {
   # Correlations
   if (model_info$is_correlation) {
     out <- .report_parameters_correlation(table, stats, ...)
-
     # t-tests
   } else if (model_info$is_ttest) {
     out <- .report_parameters_ttest(table, stats, effsize, ...)
     # Friedman
-  } else if (model_info$is_ranktest &&
-    grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
+  } else if (
+    model_info$is_ranktest &&
+      grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
     out <- .report_parameters_friedman(table, stats, effsize, ...)
+  } else if (!is.null(x$statistic) && grepl(
+    "Kruskal", attributes(x$statistic)$names,
+    fixed = TRUE
+  )) {
+    # Kruskal
+    out <- .report_parameters_kruskal(table, stats, effsize, ...)
     # chi2
   } else if (model_info$is_chi2test) {
     if (chi2_type(x) == "fisher") {

R/report_htest_kruskal.R

@@ -0,0 +1,89 @@
+# report_table -----------------
+
+.report_table_kruskal <- function(table_full, effsize) {
+  table_full <- cbind(table_full, attributes(effsize)$table)
+  list(table = NULL, table_full = table_full)
+}
+
+
+# report_effectsize ---------------------
+
+.report_effectsize_kruskal <- 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)
+
+  # same as Pearson's r
+  args <- c(list(table$rank_epsilon_squared), dot_args)
+  interpretation <- do.call(effectsize::interpret_epsilon_squared, args)
+  rules <- .text_effectsize(attr(attr(interpretation, "rules"), "rule_name"))
+
+  main <- paste0("Epsilon squared (rank) = ", insight::format_value(table$rank_epsilon_squared))
+  statistics <- paste0(
+    main,
+    ", ",
+    insight::format_ci(table$CI_low, table$CI_high, ci)
+  )
+
+  table <- table[names(table)[-2]]
+
+  list(
+    table = table, statistics = statistics, interpretation = interpretation,
+    rules = rules, ci = ci, main = main
+  )
+}
+
+
+# report_model ----------------------------
+
+.report_model_kruskal <- function(x, table) {
+  # two-sample
+  if ("Parameter1" %in% names(table)) {
+    vars_full <- paste0(table$Parameter1[[1]], ", and ", table$Parameter2[[1]])
+
+    text <- paste0(
+      trimws(x$method),
+      " testing the difference in ranks between ",
+      vars_full
+    )
+  } else {
+    # one-sample
+    vars_full <- paste0(table$Parameter[[1]])
+
+    text <- paste0(
+      trimws(x$method),
+      " testing the difference in rank for ",
+      vars_full,
+      " and true location of 0"
+    )
+  }
+
+  text
+}
+
+.report_parameters_kruskal <- function(table, stats, effsize, ...) {
+  text_full <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and ",
+    attributes(effsize)$interpretation,
+    " (",
+    paste0("Kruskal-Wallis ", stats),
+    ")"
+  )
+
+  text_short <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and ",
+    attributes(effsize)$interpretation,
+    " (",
+    paste0("Kruskal-Wallis ", summary(stats)),
+    ")"
+  )
+
+  list(text_short = text_short, text_full = text_full)
+}

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

@@ -0,0 +1,12 @@
+# report.htest-kruskal report
+
+    Code
+      report(x, verbose = FALSE)
+    Output
+      Effect sizes were labelled following Field's (2013) recommendations.
+      
+      The Kruskal-Wallis rank sum test testing the difference in ranks between
+      airquality$Ozone and as.factor(airquality$Month) suggests that the effect is
+      statistically significant, and large (Kruskal-Wallis chi2 = 29.27, p < .001;
+      Epsilon squared (rank) = 0.25, 95% CI [0.15, 1.00])
+

tests/testthat/helper-state.R

@@ -0,0 +1,14 @@
+# testthat::set_state_inspector(function() {
+#   list(
+#     attached = search(),
+#     connections = nrow(showConnections()),
+#     cwd = getwd(),
+#     envvars = Sys.getenv(),
+#     libpaths = .libPaths(),
+#     locale = Sys.getlocale(),
+#     options = .Options,
+#     packages = .packages(all.available = TRUE),
+#     NULL
+#   )
+# })
+##

tests/testthat/test-report.htest-kruskal.R

@@ -0,0 +1,9 @@
+test_that("report.htest-kruskal report", {
+  x <- kruskal.test(airquality$Ozone ~ as.factor(airquality$Month))
+
+  set.seed(100)
+  expect_snapshot(
+    variant = "windows",
+    report(x, verbose = FALSE)
+  )
+})