Add support for friedman test

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: report
 Title: Automated Reporting of Results and Statistical Models
-Version: 0.5.7.10
+Version: 0.5.7.11
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",
@@ -125,6 +125,7 @@ Collate:
     'report_effectsize.R'
     'report_htest_chi2.R'
     'report_htest_cor.R'
+    'report_htest_friedman.R'
     'report_htest_ttest.R'
     'report_htest_wilcox.R'
     'report_info.R'

NEWS.md

@@ -2,6 +2,8 @@
 
 Minor changes 
 
+* `report` now supports variables of class `htest` for the Friedman test.
+
 * `report` now supports variables of class `Date`, treating them like factors.
 
 * `report` now supports objects of class `estimate_contrasts`, from easystats'

R/report.htest.R

@@ -53,10 +53,16 @@ report_effectsize.htest <- function(x, ...) {
     out <- .report_effectsize_ttest(x, table, dot_args)
   }
 
-  # For wilcox test ---------------
-
   if (model_info$is_ranktest && !model_info$is_correlation) {
-    out <- .report_effectsize_wilcox(x, table, dot_args)
+    # For friedman test ---------------
+
+    if (grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
+      out <- .report_effectsize_friedman(x, table, dot_args)
+    } else {
+      # For wilcox test ---------------
+
+      out <- .report_effectsize_wilcox(x, table, dot_args)
+    }
   }
 
   # For correlations ---------------
@@ -120,11 +126,13 @@ report_table.htest <- function(x, ...) {
     out <- .report_table_ttest(table_full, effsize)
   } else if (model_info$is_ranktest && !model_info$is_correlation) {
     # wilcox test
+    # but same function for Friedman
     out <- .report_table_wilcox(table_full, effsize)
   } else if (model_info$is_chi2test) {
     # chi2 test
     out <- .report_table_chi2(table_full, effsize)
   } else if (model_info$is_correlation) {
+    # correlation test
     out <- .report_table_correlation(table_full)
   } else {
     out <- list(table_full = table_full, table = NULL)
@@ -152,7 +160,7 @@ report_statistics.htest <- function(x, table = NULL, ...) {
   text <- NULL
 
   # Estimate
-  candidates <- c("rho", "r", "tau", "Difference", "r_rank_biserial")
+  candidates <- c("rho", "r", "tau", "Difference", "r_rank_biserial", "Chi2")
   estimate <- candidates[candidates %in% names(table)][1]
   if (!is.null(estimate) && !is.na(estimate)) {
     text <- paste0(tolower(estimate), " = ", insight::format_value(table[[estimate]]))
@@ -186,15 +194,14 @@ report_statistics.htest <- function(x, table = NULL, ...) {
     text <- paste0(text, ", z = ", insight::format_value(table$z))
   } else if ("W" %in% names(table)) {
     text <- paste0("W = ", insight::format_value(table$W))
-  } else if ("Chi2" %in% names(table)) {
-    text <- paste0(text, ", Chi2 = ", insight::format_value(table$Chi2))
   }
 
   # p-value
   text <- paste0(text, ", ", insight::format_p(table$p, stars = FALSE, digits = "apa"))
 
   # Effect size
-  if (model_info$is_ttest || (model_info$is_ranktest && !model_info$is_correlation)) {
+  if (model_info$is_ttest || (model_info$is_ranktest && !model_info$is_correlation) ||
+    model_info$is_chi2test) {
     text_full <- paste0(text, "; ", attributes(effsize)$statistics)
     text <- paste0(text, ", ", attributes(effsize)$main)
   } else {
@@ -243,6 +250,9 @@ report_parameters.htest <- function(x, table = NULL, ...) {
     # t-tests
   } else if (model_info$is_ttest) {
     out <- .report_parameters_ttest(table, stats, effsize, ...)
+  } else if (model_info$is_ranktest &&
+    grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
+    out <- .report_parameters_friedman(table, stats, effsize, ...)
 
     # TODO: default, same as t-test?
   } else {
@@ -286,7 +296,19 @@ report_model.htest <- function(x, table = NULL, ...) {
   }
 
   if (model_info$is_ranktest && !model_info$is_correlation) {
-    text <- .report_model_wilcox(x, table)
+    # For friedman test ---------------
+
+    if (grepl("Friedman", attributes(x$statistic)$names, fixed = TRUE)) {
+      text <- .report_model_friedman(x, table)
+    } else {
+      # For wilcox test ---------------
+
+      text <- .report_model_wilcox(x, table)
+    }
+  }
+
+  if (model_info$is_chi2test) {
+    text <- .report_model_chi2(x, table)
   }
 
   as.report_model(text, summary = text)

R/report_effectsize.R

@@ -91,24 +91,25 @@ print.report_effectsize <- function(x, ...) {
 #' @keywords internal
 .text_effectsize <- function(interpretation) {
   # Effect size
-  if (!is.null(interpretation)) {
+  if (is.null(interpretation)) {
+    text <- ""
+  } else {
     if (is.character(interpretation)) {
       effsize_name <- switch(interpretation,
-        "cohen1988" = "Cohen's (1988)",
-        "sawilowsky2009" = "Savilowsky's (2009)",
-        "gignac2016" = "Gignac's (2016)",
-        "funder2019" = "Funder's (2019)",
-        "lovakov2021" = "Lovakov's (2021)",
-        "evans1996" = "Evans's (1996)",
-        "chen2010" = "Chen's (2010)",
-        "field2013" = "Field's (2013)"
+        cohen1988 = "Cohen's (1988)",
+        sawilowsky2009 = "Savilowsky's (2009)",
+        gignac2016 = "Gignac's (2016)",
+        funder2019 = "Funder's (2019)",
+        lovakov2021 = "Lovakov's (2021)",
+        evans1996 = "Evans's (1996)",
+        chen2010 = "Chen's (2010)",
+        field2013 = "Field's (2013)",
+        landis1977 = "Landis' (1977)"
       )
       text <- paste0("Effect sizes were labelled following ", effsize_name, " recommendations.")
     } else {
       text <- paste0("Effect sizes were labelled following a custom set of rules.")
     }
-  } else {
-    text <- ""
   }
   text
 }

R/report_htest_chi2.R

@@ -27,23 +27,23 @@
     ), call. = FALSE)
   }
 
-  if (estimate %in% "Cramers_v_adjusted") {
+  if (estimate == "Cramers_v_adjusted") {
     main <- paste0("Adjusted Cramer's v = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Tschuprows_t") {
+  } else if (estimate == "Tschuprows_t") {
     main <- paste0("Tschuprow's t = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Tschuprows_t_adjusted") {
+  } else if (estimate == "Tschuprows_t_adjusted") {
     main <- paste0("Adjusted Tschuprow's t = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Pearsons_c") {
+  } else if (estimate == "Pearsons_c") {
     main <- paste0("Pearson's c = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "phi_adjusted") {
+  } else if (estimate == "phi_adjusted") {
     main <- paste0("Adjusted Phi = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Cohens_h") {
+  } else if (estimate == "Cohens_h") {
     main <- paste0("Cohen's h = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Odds_ratio") {
+  } else if (estimate == "Odds_ratio") {
     main <- paste0("Odds ratio = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "Ris_kratio") {
+  } else if (estimate == "Ris_kratio") {
     main <- paste0("Risk ratio = ", insight::format_value(table[[estimate]]))
-  } else if (estimate %in% "cohens_h") {
+  } else if (estimate == "cohens_h") {
     main <- paste0("Cohen's w = ", insight::format_value(table[[estimate]]))
   } else {
     main <- paste0(estimate, " = ", insight::format_value(table[[estimate]]))
@@ -68,3 +68,17 @@
     rules = rules, ci = ci, main = main
   )
 }
+
+# report_model ----------------------------
+
+.report_model_chi2 <- function(x, table) {
+  vars_full <- paste0(names(attributes(x$observed)$dimnames), collapse = " and ")
+
+  text <- paste0(
+    trimws(x$method),
+    " testing the association between ",
+    vars_full
+  )
+
+  text
+}

R/report_htest_friedman.R

@@ -0,0 +1,87 @@
+# report_table -----------------
+
+.report_table_friedman <- function(table_full, effsize) {
+  table_full <- cbind(table_full, attributes(effsize)$table)
+  list(table = NULL, table_full = table_full)
+}
+
+
+# report_effectsize ---------------------
+
+.report_effectsize_friedman <- function(x, table, dot_args) {
+  args <- c(list(x, effectsize_type = "kendalls_w"), dot_args)
+  table <- do.call(parameters::parameters, args)
+  ci <- attributes(table)$ci
+  estimate <- "kendalls_w"
+
+  # same as Pearson's r
+  args <- c(list(table$Kendalls_W), dot_args)
+  interpretation <- do.call(effectsize::interpret_kendalls_w, args)
+  rules <- .text_effectsize(attr(attr(interpretation, "rules"), "rule_name"))
+
+  main <- paste0("Kendall's W = ", insight::format_value(table$Kendalls_W))
+  statistics <- paste0(
+    main,
+    ", ",
+    insight::format_ci(table$W_CI_low, table$W_CI_high, ci)
+  )
+
+  table <- table[c("Kendalls_W", "W_CI_low", "W_CI_high")]
+
+  list(
+    table = table, statistics = statistics, interpretation = interpretation,
+    rules = rules, ci = ci, main = main
+  )
+}
+
+
+# report_model ----------------------------
+
+.report_model_friedman <- 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_friedman <- function(table, stats, effsize, ...) {
+  text_full <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and in ",
+    attributes(effsize)$interpretation,
+    " (",
+    stats,
+    ")"
+  )
+
+  text_short <- paste0(
+    "statistically ",
+    effectsize::interpret_p(table$p, rules = "default"),
+    ", and in ",
+    attributes(effsize)$interpretation,
+    " (",
+    summary(stats),
+    ")"
+  )
+
+  list(text_short = text_short, text_full = text_full)
+}

R/report_participants.R

@@ -165,7 +165,22 @@ report_participants <- function(data,
     race <- .find_race_in_data(data)
   }
 
-  if (!is.null(group)) {
+  if (is.null(group)) {
+    text <- .report_participants(
+      data,
+      age = age,
+      sex = sex,
+      gender = gender,
+      education = education,
+      country = country,
+      race = race,
+      participants = participants,
+      spell_n = spell_n,
+      digits = digits,
+      threshold = threshold,
+      ...
+    )
+  } else {
     text <- NULL
     data[[group]] <- as.character(data[[group]])
     for (i in split(data, data[group])) {
@@ -192,21 +207,6 @@ report_participants <- function(data,
       text <- c(text, paste0(pre_text, current_text))
     }
     text <- paste("For", datawizard::text_concatenate(text, sep = ", for ", last = " and for "))
-  } else {
-    text <- .report_participants(
-      data,
-      age = age,
-      sex = sex,
-      gender = gender,
-      education = education,
-      country = country,
-      race = race,
-      participants = participants,
-      spell_n = spell_n,
-      digits = digits,
-      threshold = threshold,
-      ...
-    )
   }
   text
 }
@@ -420,15 +420,18 @@ report_participants <- function(data,
     data[[country]] <- as.character(data[[country]])
     data[which(data[[country]] %in% c(NA, "NA")), country] <- "missing"
     frequency_table <- as.data.frame(datawizard::data_tabulate(data[[country]]),
-                                     stringsAsFactors = FALSE)[c(2, 4)]
+      stringsAsFactors = FALSE
+    )[c(2, 4)]
     names(frequency_table)[2] <- "Percent"
     frequency_table <- frequency_table[-which(is.na(frequency_table$Value)), ]
     frequency_table <- frequency_table[order(-frequency_table$Percent), ]
     upper <- frequency_table[which(frequency_table$Percent >= threshold), ]
     lower <- frequency_table[which(frequency_table$Percent < threshold), ]
     if (nrow(lower) > 0) {
-      lower_sum <- data.frame(Value = "other", Percent = sum(lower$Percent),
-                              stringsAsFactors = FALSE)
+      lower_sum <- data.frame(
+        Value = "other", Percent = sum(lower$Percent),
+        stringsAsFactors = FALSE
+      )
       combined <- rbind(upper, lower_sum)
     } else {
       combined <- upper
@@ -444,15 +447,18 @@ report_participants <- function(data,
     data[[race]] <- as.character(data[[race]])
     data[which(data[[race]] %in% c(NA, "NA")), race] <- "missing"
     frequency_table <- as.data.frame(datawizard::data_tabulate(data[[race]]),
-                                     stringsAsFactors = FALSE)[c(2, 4)]
+      stringsAsFactors = FALSE
+    )[c(2, 4)]
     names(frequency_table)[2] <- "Percent"
     frequency_table <- frequency_table[-which(is.na(frequency_table$Value)), ]
     frequency_table <- frequency_table[order(-frequency_table$Percent), ]
     upper <- frequency_table[which(frequency_table$Percent >= threshold), ]
     lower <- frequency_table[which(frequency_table$Percent < threshold), ]
     if (nrow(lower) > 0) {
-      lower_sum <- data.frame(Value = "other", Percent = sum(lower$Percent),
-                              stringsAsFactors = FALSE)
+      lower_sum <- data.frame(
+        Value = "other", Percent = sum(lower$Percent),
+        stringsAsFactors = FALSE
+      )
       combined <- rbind(upper, lower_sum)
     } else {
       combined <- upper