diff --git a/DESCRIPTION b/DESCRIPTION index 03da8ef69..28b992f95 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/data_tabulate.R b/R/data_tabulate.R index 7245e7df1..4f4e5e41d 100644 --- a/R/data_tabulate.R +++ b/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) diff --git a/R/data_xtabulate.R b/R/data_xtabulate.R index cf1a56cc1..93fc4d1d7 100644 --- a/R/data_xtabulate.R +++ b/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 @@ print_html.datawizard_crosstab <- function(x, big_mark = NULL, ...) { 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", diff --git a/man/data_tabulate.Rd b/man/data_tabulate.Rd index 93112add9..7540ccb9b 100644 --- a/man/data_tabulate.Rd +++ b/man/data_tabulate.Rd @@ -20,6 +20,7 @@ data_tabulate(x, ...) name = NULL, verbose = TRUE, metrics = c("N", "raw", "valid", "cumulative"), + chisq = FALSE, ... ) @@ -36,6 +37,7 @@ data_tabulate(x, ...) proportions = NULL, collapse = FALSE, verbose = TRUE, + chisq = FALSE, ... ) @@ -81,6 +83,9 @@ any combination of \code{N} (frequencies including \code{NA}), \code{"raw"} (per including \code{NA} values), \code{"valid"} (percentage excluding \code{NA} values) and \code{"cumulative"} (percentage excluding \code{NA} values).} +\item{chisq}{include chi square for two dimensional tables. This is always +calculated with the \code{chisq.test()} \code{simulate.p.value = TRUE}.} + \item{select}{Variables that will be included when performing the required tasks. Can be either \itemize{ diff --git a/tests/testthat/_snaps/data_tabulate.md b/tests/testthat/_snaps/data_tabulate.md index 153420ab5..1f223fb2d 100644 --- a/tests/testthat/_snaps/data_tabulate.md +++ b/tests/testthat/_snaps/data_tabulate.md @@ -270,6 +270,31 @@ 5 | 2002107 | 20.02 | 20.02 | 100.00 | 0 | 0.00 | | +# data_tabulate default by with chisq + + Code + data_tabulate(x = efc$e16sex, by = efc$c172code, chisq = TRUE) + Output + Pearson's Chi-squared test with simulated p-value + (based on 2000 replicates) + X-squared = 3.88, df = NA, p = 0.163 + + efc$e16sex | low level of education | intermediate level of education + -----------+------------------------+-------------------------------- + 1 | 5 | 32 + 2 | 3 | 34 + | 0 | 0 + -----------+------------------------+-------------------------------- + Total | 8 | 66 + + efc$e16sex | high level of education | | Total + -----------+-------------------------+------+------ + 1 | 4 | 5 | 46 + 2 | 12 | 5 | 54 + | 0 | 0 | 0 + -----------+-------------------------+------+------ + Total | 16 | 10 | 100 + # data_tabulate print multiple, collapse Code @@ -861,6 +886,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 diff --git a/tests/testthat/test-data_tabulate.R b/tests/testthat/test-data_tabulate.R index c8b55e756..422678736 100644 --- a/tests/testthat/test-data_tabulate.R +++ b/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,6 +346,7 @@ test_that("data_tabulate data.frame by", { total_n = 100L, varname = "c172code", by = "e16sex", + chi_square = chi_square, grouped_df = FALSE ) ) @@ -342,6 +354,18 @@ test_that("data_tabulate data.frame by", { 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) @@ -439,6 +496,15 @@ test_that("data_tabulate big numbers", { expect_snapshot(print(data_tabulate(x), big_mark = "")) }) +test_that("data_tabulate default by with chisq", { + data(efc, package = "datawizard") + set.seed(123) + expect_snapshot(data_tabulate( + x = efc$e16sex, + by = efc$c172code, + chisq = TRUE + )) +}) test_that("data_tabulate print multiple, collapse", { data(efc, package = "datawizard") @@ -957,14 +1023,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 +1053,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 +1160,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 +1172,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 +1188,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", "", "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 +1201,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", "", "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")) })