add ard_svychisq() function

DESCRIPTION

@@ -29,6 +29,7 @@ Suggests:
     parameters (>= 0.20.2),
     smd (>= 0.6.6),
     spelling,
+    survey (>= 4.1),
     testthat (>= 3.2.0),
     withr
 Remotes: 

NAMESPACE

@@ -21,6 +21,7 @@ export(ard_proptest)
 export(ard_regression)
 export(ard_regression_basic)
 export(ard_smd)
+export(ard_svychisq)
 export(ard_ttest)
 export(ard_vif)
 export(ard_wilcoxtest)

R/ard_svychisq.R

@@ -0,0 +1,72 @@
+#' ARD Survey Chi-Square Test
+#'
+#' @description
+#' Analysis results data for survey Chi-Square test using [`survey::svychisq()`].
+#' Only two-way comparisons are supported.
+#'
+#' @param data (`survey.design`)\cr
+#'   a survey design object often created with the {survey} package
+#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to compare by.
+#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column names to be compared. Independent tests will be computed for
+#'   each variable.
+#' @param statistic (`character`)\cr
+#'   statistic used to estimate Chisq p-value.
+#'   Default is the Rao-Scott second-order correction ("F"). See [`survey::svychisq`]
+#'   for available statistics options.
+#' @param ... arguments passed to [`survey::svychisq()`].
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examplesIf cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")
+#' data(api, package = "survey")
+#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
+#'
+#' ard_svychisq(dclus1, variables = sch.wide, by = comp.imp, statistic = "F")
+ard_svychisq <- function(data, by, variables, statistic = "F", ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variables)
+  check_not_missing(by)
+  check_class(data, cls = "survey.design")
+  cards::process_selectors(data[["variables"]], by = {{ by }}, variables = {{ variables }})
+  check_scalar(by)
+
+  # if no variables selected, return empty tibble ------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble())
+  }
+  # build ARD ------------------------------------------------------------------
+  lapply(
+    variables,
+    function(variable) {
+      cards::tidy_as_ard(
+        lst_tidy =
+          cards::eval_capture_conditions(
+            survey::svychisq(stats::reformulate(termlabels = paste(variable, by, sep = "+"), response = NULL), design = data, statistic = statistic, ...) |>
+              broom::tidy()
+          ),
+        tidy_result_names = c("statistic", "p.value", "ndf", "ddf", "method"),
+        passed_args = dots_list(...),
+        lst_ard_columns = list(group1 = by, variable = variable, context = "svychisq")
+      ) |>
+        dplyr::mutate(
+          .after = "stat_name",
+          stat_label =
+            dplyr::case_when(
+              .data$stat_name %in% "statistic" ~ "Statistic",
+              .data$stat_name %in% "p.value" ~ "p-value",
+              .data$stat_name %in% "ndf" ~ "Nominator Degrees of Freedom",
+              .data$stat_name %in% "ddf" ~ "Denominator Degrees of Freedom"
+              TRUE ~ .data$stat_name,
+            )
+        )
+    }
+  ) |>
+    dplyr::bind_rows()
+}

R/ard_wilcoxtest.R

@@ -30,15 +30,15 @@
 #' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx")
 #' cards::ADSL |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
-#'   ard_wilcoxtest(by = "ARM", variable = "AGE")
+#'   ard_wilcoxtest(by = "ARM", variables = "AGE")
 #'
 #' # constructing a paired data set,
 #' # where patients receive both treatments
 #' cards::ADSL[c("ARM", "AGE")] |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
 #'   dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |>
 #'   dplyr::arrange(USUBJID, ARM) |>
-#'   ard_paired_wilcoxtest(by = ARM, variable = AGE, id = USUBJID)
+#'   ard_paired_wilcoxtest(by = ARM, variables = AGE, id = USUBJID)
 NULL
 
 #' @rdname ard_wilcoxtest
@@ -141,7 +141,7 @@ ard_paired_wilcoxtest <- function(data, by, variables, id, ...) {
 #' # Pre-processing ADSL to have grouping factor (ARM here) with 2 levels
 #' ADSL <- cards::ADSL |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
-#'   ard_wilcoxtest(by = "ARM", variable = "AGE")
+#'   ard_wilcoxtest(by = "ARM", variables = "AGE")
 #'
 #' cardx:::.format_wilcoxtest_results(
 #'   by = "ARM",
@@ -167,7 +167,7 @@ ard_paired_wilcoxtest <- function(data, by, variables, id, ...) {
       ),
       formals = formals(asNamespace("stats")[["wilcox.test.default"]]),
       passed_args = c(list(paired = paired), dots_list(...)),
-      lst_ard_columns = list(group1 = by, variable = variable, context = "ttest")
+      lst_ard_columns = list(group1 = by, variable = variable, context = "wilcoxtest")
     )
 
   # add the stat label ---------------------------------------------------------

_pkgdown.yml

@@ -31,6 +31,7 @@ reference:
       - ard_moodtest
       - ard_mcnemartest
       - ard_proptest
+      - ard_svychisq
       - ard_ttest
       - ard_wilcoxtest
 

inst/WORDLIST

@@ -8,11 +8,13 @@ Jeffreys
 Lifecycle
 McNemar's
 Newcombe
+Rao
 Su
 VIF
 XG
 Xin
 agresti
+chisq
 clopper
 coull
 funder

tests/testthat/_snaps/ard_svychisq.md

@@ -0,0 +1,15 @@
+# ard_svychisq() works
+
+    Code
+      as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select(ard_svychisq(
+        dclus2, variables = c(sch.wide, stype), by = comp.imp, statistic = "adjWald"),
+      c(1:3, 5:6)), variable), n = 3))
+    Output
+          group1 variable  context                     stat_label     stat
+      1 comp.imp sch.wide svychisq   Nominator Degrees of Freedom        1
+      2 comp.imp sch.wide svychisq Denominator Degrees of Freedom       39
+      3 comp.imp sch.wide svychisq                      Statistic  11.4203
+      4 comp.imp    stype svychisq   Nominator Degrees of Freedom        2
+      5 comp.imp    stype svychisq Denominator Degrees of Freedom       38
+      6 comp.imp    stype svychisq                      Statistic 4.480236
+

tests/testthat/test-ard_svychisq.R

@@ -0,0 +1,51 @@
+skip_if_not(cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx"))
+
+test_that("ard_svychisq() works", {
+  data(api, package = "survey")
+  dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2)
+
+  expect_error(
+    ard_svychisq <-
+      ard_svychisq(
+        dclus2,
+        variables = sch.wide,
+        by = comp.imp,
+        statistic = "F"
+      ),
+    NA
+  )
+
+  expect_equal(
+    cards::get_ard_statistics(
+      ard_svychisq,
+      stat_name %in% c("statistic", "p.value")
+    ),
+    survey::svychisq(~ sch.wide + comp.imp, dclus2)[c("statistic", "p.value")],
+    ignore_attr = TRUE
+  )
+
+  # test that the function works with multiple variables
+  expect_snapshot(
+    ard_svychisq(
+      dclus2,
+      variables = c(sch.wide, stype),
+      by = comp.imp,
+      statistic = "adjWald"
+    ) |>
+      dplyr::select(c(1:3, 5:6)) |>
+      dplyr::group_by(variable) |>
+      dplyr::slice_head(n = 3) |>
+      as.data.frame()
+  )
+
+
+  expect_equal(
+    dplyr::bind_rows(
+      ard_svychisq,
+      dclus2 |>
+        ard_svychisq(by = comp.imp, variables = stype)
+    ),
+    dclus2 |>
+      ard_svychisq(by = comp.imp, variables = c(sch.wide, stype))
+  )
+})