adding ard_fishertest() (#21)

**What changes are proposed in this pull request?**
Migrated `ard_fishertest()` from {cards}



--------------------------------------------------------------------------------

Reviewer Checklist (if item does not apply, mark is as complete)

- [ ] Ensure all package dependencies are installed:
`devtools::install_dev_deps()`
- [ ] PR branch has pulled the most recent updates from master branch:
`usethis::pr_merge_main()`
- [ ] If a bug was fixed, a unit test was added.
- [ ] Run `pkgdown::build_site()`. Check the R console for errors, and
review the rendered website.
- [ ] Code coverage is suitable for any new functions/features:
`devtools::test_coverage()`
- [ ] `usethis::use_spell_check()` runs with no spelling errors in
documentation

When the branch is ready to be merged:
- [ ] Update `NEWS.md` with the changes from this pull request under the
heading "`# cards (development version)`". If there is an issue
associated with the pull request, reference it in parentheses at the end
update (see `NEWS.md` for examples).
- [ ] Increment the version number using `usethis::use_version(which =
"dev")`
- [ ] Run `usethis::use_spell_check()` again
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge".

---------

Signed-off-by: Daniel Sjoberg <[email protected]>
Signed-off-by: Zelos Zhu <[email protected]>
Co-authored-by: Zelos Zhu <[email protected]>

NAMESPACE

@@ -4,6 +4,7 @@ export("%>%")
 export(all_of)
 export(any_of)
 export(ard_chisqtest)
+export(ard_fishertest)
 export(ard_paired_ttest)
 export(ard_paired_wilcoxtest)
 export(ard_ttest)

R/ard_fishertest.R

@@ -0,0 +1,59 @@
+#' ARD Fisher's Exact Test
+#'
+#' @description
+#' Analysis results data for Fisher's Exact Test.
+#' Calculated with `fisher.test(x = data[[variable]], y = data[[by]], ...)`
+#'
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame.
+#' @param by,variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column names to compare
+#' @param ... additional arguments passed to `fisher.test(...)`
+#'
+#' @return ARD data frame
+#' @export
+#'
+#' @examples
+#' cards::ADSL[1:30, ] |>
+#'   ard_fishertest(by = "ARM", variable = "AGEGR1")
+ard_fishertest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_class_data_frame(x = data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  cards::tidy_as_ard(
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::fisher.test(x = data[[variable]], y = data[[by]], ...) |>
+          broom::tidy()
+      ),
+    tidy_result_names =
+      c("estimate", "p.value", "conf.low", "conf.high", "method", "alternative"),
+    fun_args_to_record =
+      c(
+        "workspace", "hybrid", "hybridPars", "control", "or",
+        "conf.int", "conf.level", "simulate.p.value", "B"
+      ),
+    formals = formals(stats::fisher.test),
+    passed_args = dots_list(...),
+    lst_ard_columns = list(group1 = by, variable = variable, context = "fishertest")
+  ) |>
+    dplyr::mutate(
+      .after = "stat_name",
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "p.value" ~ "p-value",
+          TRUE ~ .data$stat_name,
+        )
+    )
+}

_pkgdown.yml

@@ -25,5 +25,6 @@ reference:
   - subtitle: "Inference"
   - contents:
       - ard_ttest
+      - ard_fishertest
       - ard_chisqtest
       - ard_wilcoxtest

tests/testthat/test-ard_fishertest.R

@@ -0,0 +1,18 @@
+test_that("ard_fishertest() works", {
+  expect_error(
+    ard_fishertest <-
+      cards::ADSL[1:20, ] |>
+      ard_fishertest(by = ARM, variable = AGEGR1),
+    NA
+  )
+
+  expect_equal(
+    ard_fishertest |>
+      cards::get_ard_statistics(stat_name %in% c("p.value", "method")),
+    with(cards::ADSL[1:20, ], fisher.test(AGEGR1, ARM)) |>
+      broom::tidy() |>
+      dplyr::select(p.value, method) |>
+      unclass(),
+    ignore_attr = TRUE
+  )
+})