adding ard_svyttest()

.Rbuildignore

@@ -15,6 +15,7 @@ LICENSE
 ^\.git$
 ^\.github$
 ^\.gitlab-ci\.yml$
+^codecov\.yml$
 
 # lintr
 ^\.lintr$

NAMESPACE

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

R/ard_svyttest.R

@@ -0,0 +1,87 @@
+#' ARD Survey t-test
+#'
+#' @description
+#' Analysis results data for survey t-test using [`survey::svyttest()`].
+#'
+#' @param data (`survey.design`)\cr
+#'   a survey design object often created with [`survey::svydesign()`]
+#' @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 run for each variable.
+#' @param conf.level (`double`)\cr
+#'   confidence level of the returned confidence interval. Must be between `c(0, 1)`.
+#'   Default is `0.95`
+#' @param ... arguments passed to [`survey::svyttest()`]
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examplesIf cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")
+#' data(api, package = "survey")
+#' dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2)
+#'
+#' ard_svyttest(dclus2, variables = enroll, by = comp.imp, conf.level = 0.9)
+ard_svyttest <- function(data, by, variables, conf.level = 0.95, ...) {
+  # 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_range(conf.level, range = c(0, 1))
+  check_class(data, cls = "survey.design")
+  cards::process_selectors(data[["variables"]], by = {{ by }}, variables = {{ variables }})
+  check_scalar(by)
+
+  # build ARD ------------------------------------------------------------------
+  lapply(
+    variables,
+    function(variable) {
+      .format_svyttest_results(
+        by = by,
+        variable = variable,
+        lst_tidy =
+          cards::eval_capture_conditions(
+            survey::svyttest(stats::reformulate(by, response = variable), design = data, ...) %>%
+              # a slightly enhanced tidier that allows us to specify the conf.level
+              {
+                dplyr::bind_cols(
+                  broom::tidy(.) |> dplyr::select(-c("conf.low", "conf.high")),
+                  dplyr::tibble(!!!stats::confint(., level = conf.level) |> set_names(c("conf.low", "conf.high"))) |>
+                    dplyr::mutate(conf.level = conf.level)
+                )
+              }
+          ),
+        ...
+      )
+    }
+  ) |>
+    dplyr::bind_rows()
+}
+
+.format_svyttest_results <- function(by, variable, lst_tidy, ...) {
+  # build ARD ------------------------------------------------------------------
+  ret <-
+    cards::tidy_as_ard(
+      lst_tidy = lst_tidy,
+      tidy_result_names = c(
+        "estimate", "statistic",
+        "p.value", "parameter",
+        "conf.low", "conf.high",
+        "conf.level", "method", "alternative"
+      ),
+      passed_args = dots_list(...),
+      lst_ard_columns = list(group1 = by, variable = variable, context = "svyttest")
+    )
+
+  # add the stat label ---------------------------------------------------------
+  ret |>
+    dplyr::left_join(
+      .df_ttest_stat_labels(),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::tidy_ard_column_order()
+}

_pkgdown.yml

@@ -32,6 +32,7 @@ reference:
       - ard_mcnemartest
       - ard_proptest
       - ard_svychisq
+      - ard_svyttest
       - ard_ttest
       - ard_wilcoxtest
 

codecov.yml

@@ -0,0 +1 @@
+comment: false

tests/testthat/test-ard_svyttest.R

@@ -0,0 +1,75 @@
+skip_if_not(cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx"))
+
+test_that("ard_svyttest() works", {
+  data(api, package = "survey")
+  dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2)
+
+  expect_error(
+    ard_svyttest <-
+      ard_svyttest(
+        dclus2,
+        variable = enroll,
+        by = comp.imp,
+        conf.level = 0.9
+      ),
+    NA
+  )
+
+  expect_equal(
+    cards::get_ard_statistics(
+      ard_svyttest,
+      stat_name %in% c("estimate", "p.value")
+    ),
+    survey::svyttest(enroll ~ comp.imp, dclus2)[c("estimate", "p.value")],
+    ignore_attr = TRUE
+  )
+
+  expect_equal(
+    cards::get_ard_statistics(
+      ard_svyttest,
+      stat_name %in% c("conf.low", "conf.high")
+    ),
+    survey::svyttest(enroll ~ comp.imp, dclus2) |>
+      confint(level = 0.9) |>
+      as.list(),
+    ignore_attr = TRUE
+  )
+
+  # check that is works with multiple variables
+  expect_equal(
+    dplyr::bind_rows(
+      ard_svyttest,
+      ard_svyttest(
+        dclus2,
+        variable = mobility,
+        by = comp.imp,
+        conf.level = 0.9
+      )
+    ),
+    ard_svyttest(
+      dclus2,
+      variable = c(enroll, mobility),
+      by = comp.imp,
+      conf.level = 0.9
+    )
+  )
+})
+
+test_that("ard_svyttest() messaging", {
+  data(api, package = "survey")
+  dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2)
+
+  expect_error(
+    ard_svyttest <-
+      ard_svyttest(
+        dclus2,
+        variable = enroll,
+        by = stype
+      ),
+    NA
+  )
+  expect_equal(
+    ard_svyttest$error |> unique() |> unlist(),
+    "group must be binary"
+  )
+})