Add chi square attribute to the datawizard_crosstab objects.

DESCRIPTION

@@ -85,4 +85,4 @@ Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
-Config/roxygen2/version: 8.1.0
+Config/roxygen2/version: 8.1.1

R/data_tabulate.R

@@ -44,6 +44,8 @@
 #' any combination of `N` (frequencies including `NA`), `"raw"` (percentage
 #' including `NA` values), `"valid"` (percentage excluding `NA` values) and
 #' `"cumulative"` (percentage excluding `NA` values).
+#' @param chisq include chi square for two dimensional tables. This is always
+#' calculated with the `chisq.test()` `simulate.p.value = TRUE`.
 #' @param ... not used.
 #' @inheritParams extract_column_names
 #'
@@ -163,6 +165,7 @@ data_tabulate.default <- function(
   name = NULL,
   verbose = TRUE,
   metrics = c("N", "raw", "valid", "cumulative"),
+  chisq = FALSE,
   ...
 ) {
   # save label attribute, before it gets lost...
@@ -211,7 +214,8 @@ data_tabulate.default <- function(
       remove_na = remove_na,
       proportions = proportions,
       obj_name = obj_name,
-      group_variable = group_variable
+      group_variable = group_variable,
+      chisq = chisq
     ))
   }
   # frequency table
@@ -334,6 +338,7 @@ data_tabulate.default <- function(
     attr(out, "by") <- NULL
   } else {
     attr(out, "by") <- by_name
+    attr(out, "chi_square") <- chisq
   }
 
   class(out) <- c("datawizard_table", "data.frame")
@@ -357,6 +362,7 @@ data_tabulate.data.frame <- function(
   proportions = NULL,
   collapse = FALSE,
   verbose = TRUE,
+  chisq = FALSE,
   ...
 ) {
   if (!is.null(by)) {
@@ -391,6 +397,7 @@ data_tabulate.data.frame <- function(
       remove_na = remove_na,
       name = i,
       verbose = verbose,
+      chisq = chisq,
       ...
     )
   })
@@ -422,6 +429,7 @@ data_tabulate.grouped_df <- function(
   remove_na = FALSE,
   collapse = FALSE,
   verbose = TRUE,
+  chisq = FALSE,
   ...
 ) {
   grps <- attr(x, "groups", exact = TRUE)

R/data_xtabulate.R

@@ -7,8 +7,19 @@
   remove_na = FALSE,
   proportions = NULL,
   obj_name = NULL,
-  group_variable = NULL
+  group_variable = NULL,
+  chisq = FALSE
 ) {
+  if (is.null(group_variable) && is.null(attr(x, "groups"))) {
+    chi_square <- chisq.test(x, by, simulate.p.value = TRUE)
+  } else if (nlevels(x) > 1 && nlevels(x) > 1) {
+    chi_square <- chisq.test(x, by, simulate.p.value = TRUE)
+  } else {
+    chi_square <-
+      "Both 'by' and 'x' must have at least 2 unique levels\n
+    in order to calculate chi square."
+  }
+
   if (!is.null(proportions)) {
     proportions <- match.arg(proportions, c("row", "column", "full"))
   }
@@ -97,7 +108,26 @@
   if (!is.null(by_name)) {
     attr(out, "by") <- by_name
   }
-
+  attr(out, "chi_square") <- chi_square
+  if (chisq) {
+    if (is.list(chi_square)) {
+      attr(out, "chisq_caption") <- paste0(
+        chi_square$method,
+        "\n ",
+        "X-squared = ",
+        round(chi_square[["statistic"]], 3),
+        ", ",
+        "df = ",
+        chi_square[["parameter"]][["df"]],
+        ", p = ",
+        round(chi_square$p.value, 3)
+      )
+    } else {
+      if (is.character(chi_square)) {
+        attr(out, "chisq_caption") <- chi_square
+      }
+    }
+  }
   attr(out, "grouped_df") <- !is.null(group_variable)
   attr(out, "prop_table") <- .prop_table(out)
 
@@ -312,6 +342,16 @@
     caption <- paste0("Grouped by ", x[["Group"]][1])
     x$Group <- NULL
   }
+  if (!is.null(attr(x, "chisq_caption"))) {
+    caption <- paste0(caption, attr(x, "chisq_caption"))
+  }
+  if (!is.null(attr(x, "chi_square_warning"))) {
+    paste0(
+      caption,
+      "\n",
+      insight::format_warning(attr(x, "chi_square_warning"))
+    )
+  }
 
   # this function is used by all four supported format, markdown, text, html
   # and tt (tinytable). For tt, we sometimes have format "html" and backend = "tt",

tests/testthat/_snaps/data_tabulate.md

@@ -861,6 +861,26 @@
       |e42dep   |     4| 32  (50.8%)| 28 (44.4%)| 3 (4.8%) |    63|
       |e42dep   |  (NA)|  1  (33.3%)|  2 (66.7%)| 0 (0.0%) |     3|
 
+---
+
+    Code
+      display(data_tabulate(efc, "c172code", by = "e16sex", proportions = "column",
+        remove_na = TRUE, weights = "weights", chisq = TRUE))
+    Output
+
+
+      Table: Pearson's Chi-squared test with simulated p-value
+      	 (based on 2000 replicates)
+       X-squared = 4.217, df = NA, p = 0.117
+
+      |c172code |       male|     female| Total|
+      |:--------|----------:|----------:|-----:|
+      |1        |  5 (12.5%)|  3  (6.5%)|     8|
+      |2        | 32 (80.0%)| 32 (69.6%)|    64|
+      |3        |  3  (7.5%)| 11 (23.9%)|    14|
+      |         |           |           |      |
+      |Total    |         40|         46|    86|
+
 # data_tabulate, correct 0% for proportions
 
     Code

tests/testthat/test-data_tabulate.R

@@ -318,7 +318,18 @@ test_that("data_tabulate data.frame with wrong value for 'metrics'", {
 
 test_that("data_tabulate data.frame by", {
   data(efc, package = "datawizard")
-  x <- data_tabulate(efc, "c172code", by = "e16sex")
+  by <- factor(efc$e16sex, labels = attr(efc$e16sex, "labels") |> names())
+  x <- factor(efc$c172code)
+  set.seed(456)
+  if (nlevels(x) > 1 && nlevels(x) > 1) {
+    chi_square <- chisq.test(x, by, simulate.p.value = TRUE)
+  } else {
+    chi_square <-
+      "Both 'by' and 'x' must have at least 2 unique values
+      in order to calculate chi square."
+  }
+  set.seed(456)
+  x <- data_tabulate(efc, "c172code", by = "e16sex", chisq = FALSE)
   expect_s3_class(x, c("datawizard_crosstab", "list"))
   expect_length(x, 1L)
   expect_identical(
@@ -335,13 +346,26 @@ test_that("data_tabulate data.frame by", {
       total_n = 100L,
       varname = "c172code",
       by = "e16sex",
+      chi_square = chi_square,
       grouped_df = FALSE
     )
   )
 })
 
 test_that("data_tabulate default by", {
   data(efc, package = "datawizard")
+  by <- factor(efc$e16sex, labels = attr(efc$e16sex, "labels") |> names())
+  x <- factor(efc$c172code)
+  set.seed(456)
+  if (length(unique(x)) > 1 & length(unique(by)) > 1) {
+    chi_square <- chisq.test(x, by, simulate.p.value = TRUE)
+  } else {
+    chi_square <- list(
+      "Both 'by' and 'x' must have at least 2 unique values\n
+    in order to calculate chi square."
+    )
+  }
+  set.seed(456)
   x <- data_tabulate(efc$c172code, by = efc$e16sex)
   expect_s3_class(x, c("datawizard_crosstab", "data.frame"))
   expect_length(x, 4L)
@@ -359,14 +383,34 @@ test_that("data_tabulate default by", {
       total_n = 100L,
       varname = "efc$c172code",
       by = "efc$e16sex",
+      chi_square = chi_square,
       grouped_df = FALSE
     )
   )
 })
 
+test_that("data_tabulate default by with chisq", {
+  expect_no_error(data_tabulate(
+    x = efc$e16sex,
+    by = efc$c172code,
+    chisq = TRUE
+  ))
+})
+
 test_that("data_tabulate grouped data.frame by", {
   skip_if_not_installed("poorman")
   data(efc, package = "datawizard")
+  efc_group1 <- subset(efc, efc$e16sex == 1)
+  x <- factor(
+    efc_group1$c172code
+  )
+  by <- factor(efc_group1$e42dep)
+  Group <- factor(efc_group1$e16sex)
+  set.seed(456)
+  chi_square <-
+    "Both 'by' and 'x' must have at least 2 unique levels\n
+    in order to calculate chi square."
+  set.seed(456)
   x <- data_tabulate(poorman::group_by(efc, e16sex), "c172code", by = "e42dep")
   expect_identical(
     attributes(x[[1]]),
@@ -385,10 +429,24 @@ test_that("data_tabulate grouped data.frame by", {
       total_n = 46L,
       varname = "c172code",
       by = "e42dep",
+      chi_square = chi_square,
       grouped_df = TRUE
     )
   )
 })
+
+
+test_that("data_tabulate grouped data.frame by with chi square", {
+  skip_if_not_installed("poorman")
+  data(efc, package = "datawizard")
+  expect_no_warning(data_tabulate(
+    poorman::group_by(efc, e16sex),
+    "c172code",
+    by = "e42dep",
+    chisq = TRUE
+  ))
+})
+
 test_that("data_tabulate unsupported class", {
   data(mtcars)
   expect_warning(
@@ -397,7 +455,6 @@ test_that("data_tabulate unsupported class", {
   )
 })
 
-
 test_that("data_tabulate print", {
   set.seed(123)
   x <- sample.int(3, 1e6, TRUE)
@@ -957,14 +1014,16 @@ test_that("data_tabulate, cross tables, markdown", {
     remove_na = TRUE,
     weights = efc$weights
   ))) # nolint
-  expect_snapshot(print_md(data_tabulate(
-    efc,
-    "c172code",
-    by = "e16sex",
-    proportions = "column",
-    remove_na = TRUE,
-    weights = "weights"
-  ))) # nolint
+  expect_snapshot(
+    print_md(data_tabulate(
+      efc,
+      "c172code",
+      by = "e16sex",
+      proportions = "column",
+      remove_na = TRUE,
+      weights = "weights"
+    ))
+  ) # nolint
   expect_snapshot(print_md(data_tabulate(
     efc,
     c("c172code", "e42dep"),
@@ -985,9 +1044,18 @@ test_that("data_tabulate, cross tables, markdown", {
     by = "e16sex",
     proportions = "row"
   ))) # nolint
+  set.seed(123)
+  expect_snapshot(display(data_tabulate(
+    efc,
+    "c172code",
+    by = "e16sex",
+    proportions = "column",
+    remove_na = TRUE,
+    weights = "weights",
+    chisq = TRUE
+  ))) # nolint
 })
 
-
 # validate against table -------------------------
 
 test_that("data_tabulate, validate against table", {
@@ -1083,7 +1151,7 @@ test_that("data_tabulate, as.data.frame, cross tables", {
   )
   expect_length(out$table, 1L)
   expect_named(out$table[[1]], c("cyl", "0", "1", "NA"))
-  expect_identical(nrow(out$table[[1]]), 4L)
+  expect_shape(out$table[[1]], nrow = 4L)
   # cross tables
   x <- data_tabulate(mtcars, c("cyl", "vs"), by = "am")
   out <- as.data.frame(x)
@@ -1095,7 +1163,7 @@ test_that("data_tabulate, as.data.frame, cross tables", {
   )
   expect_length(out$table, 2L)
   expect_named(out$table[[1]], c("cyl", "0", "1", "NA"))
-  expect_identical(nrow(out$table[[1]]), 4L)
+  expect_shape(out$table[[1]], nrow = 4L)
 })
 
 
@@ -1111,7 +1179,7 @@ test_that("data_tabulate, as.data.frame, cross tables with total N", {
   )
   expect_length(out$table, 1L)
   expect_named(out$table[[1]], c("cyl", "0", "1", "<NA>", "Total"))
-  expect_identical(nrow(out$table[[1]]), 5L)
+  expect_shape(out$table[[1]], nrow = 5L)
   expect_identical(out$table[[1]]$cyl, c("4", "6", "8", NA, "Total"))
   # cross tables, with total
   x <- data_tabulate(mtcars, c("cyl", "vs"), by = "am")
@@ -1124,7 +1192,7 @@ test_that("data_tabulate, as.data.frame, cross tables with total N", {
   )
   expect_length(out$table, 2L)
   expect_named(out$table[[1]], c("cyl", "0", "1", "<NA>", "Total"))
-  expect_identical(nrow(out$table[[1]]), 5L)
+  expect_shape(out$table[[1]], nrow = 5L)
   expect_identical(out$table[[1]]$cyl, c("4", "6", "8", NA, "Total"))
 })