McNemar's statistical test addition: ard_mcnemartest

NAMESPACE

@@ -6,6 +6,7 @@ export(all_of)
 export(any_of)
 export(ard_chisqtest)
 export(ard_fishertest)
+export(ard_mcnemartest)
 export(ard_paired_ttest)
 export(ard_paired_wilcoxtest)
 export(ard_proportion_ci)

R/ard_mcnemartest.R

@@ -0,0 +1,110 @@
+#' ARD McNemar's Test
+#'
+#' @description
+#' Analysis results data for McNemar's statistical test.
+#'
+#' @param data (`data.frame`)\cr
+#'   a data frame. See below for details.
+#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to compare by.
+#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name to be compared.
+#' @param ... arguments passed to `stats::mcnemar.test(...)`
+#'
+#' @return ARD data frame
+#' @name ard_mcnemartest
+#'
+#' @details
+#' For the `ard_mcnemartest()` function, the data is expected to be one row per subject.
+#' The data is passed as `stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...)`.
+#' `variable` and `by` are expected to be dichotomous variables. Please
+#' use `table(x = data[[variable]], y = data[[by]])` to check the contingency table.
+#'
+#' @examples
+#' cards::ADSL |>
+#'   ard_mcnemartest(by = "SEX", variable = "EFFFL")
+#'
+NULL
+
+#' @rdname ard_mcnemartest
+#' @export
+ard_mcnemartest <- function(data, by, variable, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variable)
+  check_not_missing(by)
+  check_class_data_frame(x = data)
+  data <- dplyr::ungroup(data)
+  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  check_scalar(by)
+  check_scalar(variable)
+
+  # build ARD ------------------------------------------------------------------
+  .format_mcnemartest_results(
+    by = by,
+    variable = variable,
+    lst_tidy =
+      cards::eval_capture_conditions(
+        stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...) |>
+          broom::tidy()
+      ),
+    ...
+  )
+}
+
+#' Convert McNemar's test to ARD
+#'
+#' @inheritParams cards::tidy_as_ard
+#' @inheritParams stats::mcnemar.test
+#' @param by (`string`)\cr by column name
+#' @param variable (`string`)\cr variable column name
+#' @param ... passed to `stats::mcnemar.test(...)`
+#'
+#' @return ARD data frame
+#'
+#' @examples
+#' cardx:::.format_mcnemartest_results(
+#'   by = "ARM",
+#'   variable = "AGE",
+#'   paired = FALSE,
+#'   lst_tidy =
+#'     cards::eval_capture_conditions(
+#'       stats::mcnemar.test(cards::ADSL[["SEX"]], cards::ADSL[["EFFFL"]]) |>
+#'         broom::tidy()
+#'     )
+#' )
+#'
+#' @keywords internal
+.format_mcnemartest_results <- function(by, variable, lst_tidy, paired, ...) {
+  # build ARD ------------------------------------------------------------------
+  ret <-
+    cards::tidy_as_ard(
+      lst_tidy = lst_tidy,
+      tidy_result_names = c("statistic", "p.value", "method"),
+      fun_args_to_record = c("correct"),
+      formals = formals(asNamespace("stats")[["mcnemar.test"]]),
+      passed_args = dots_list(...),
+      lst_ard_columns = list(group1 = by, variable = variable, context = "mcnemartest")
+    )
+
+  # add the stat label ---------------------------------------------------------
+  ret |>
+    dplyr::left_join(
+      .df_mcnemar_stat_labels(),
+      by = "stat_name"
+    ) |>
+    dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::tidy_ard_column_order()
+}
+
+.df_mcnemar_stat_labels <- function() {
+  dplyr::tribble(
+    ~stat_name, ~stat_label,
+    "statistic", "X-squared Statistic",
+    "parameter", "Degrees of Freedom",
+    "p.value", "p-value",
+  )
+}

R/ard_wilcoxtest.R

@@ -105,17 +105,23 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) {
   )
 }
 
+
 #' Convert Wilcoxon test to ARD
 #'
 #' @inheritParams cards::tidy_as_ard
 #' @inheritParams stats::wilcox.test
 #' @param by (`string`)\cr by column name
 #' @param variable (`string`)\cr variable column name
-#' @param ... passed to `wilcox.test(...)`
+#' @param ... passed to `stats::wilcox.test(...)`
 #'
 #' @return ARD data frame
-#' @keywords internal
+#'
 #' @examples
+#' # 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")
+#'
 #' cardx:::.format_wilcoxtest_results(
 #'   by = "ARM",
 #'   variable = "AGE",
@@ -126,6 +132,8 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) {
 #'         broom::tidy()
 #'     )
 #' )
+#'
+#' @keywords internal
 .format_wilcoxtest_results <- function(by, variable, lst_tidy, paired, ...) {
   # build ARD ------------------------------------------------------------------
   ret <-

_pkgdown.yml

@@ -26,6 +26,7 @@ reference:
   - contents:
       - ard_chisqtest
       - ard_fishertest
+      - ard_mcnemartest
       - ard_ttest
       - ard_wilcoxtest
 

inst/WORDLIST

@@ -3,6 +3,7 @@ Biopharmaceutical
 Clopper
 Hoffmann
 Jeffreys
+McNemar's
 Newcombe
 Su
 XG

tests/testthat/test-ard_mcnemartest.R

@@ -0,0 +1,37 @@
+test_that("ard_mcnemartest() works", {
+  expect_error(
+    ard_mcnemartest <-
+      cards::ADSL |>
+      ard_mcnemartest(by = SEX, variable = EFFFL),
+    NA
+  )
+
+  expect_equal(
+    ard_mcnemartest |>
+      cards::get_ard_statistics(stat_name %in% c("statistic", "p.value", "parameter", "method")),
+    stats::mcnemar.test(cards::ADSL[["SEX"]], cards::ADSL[["EFFFL"]], correct = TRUE) |>
+      broom::tidy() |>
+      unclass(),
+    ignore_attr = TRUE
+  )
+
+  # errors are properly handled
+  expect_equal(
+    cards::ADSL |>
+      ard_mcnemartest(by = ARM, variable = AGE, correct = FALSE) |>
+      dplyr::pull(error) |>
+      getElement(1L),
+    "'x' and 'y' must have the same number of levels (minimum 2)"
+  )
+
+  # non-syntactic column names work too
+  ADSL_tmp <- cards::ADSL |>
+    dplyr::rename("if" = AGE, "_c d" = EFFFL)
+
+  expect_error(
+    ard_mcnemartest <-
+      ADSL_tmp |>
+      ard_mcnemartest(by = `if`, variable = `_c d`),
+    NA
+  )
+})