adding long mcnemar (#129)

**What changes are proposed in this pull request?**
* Style this entry in a way that can be copied directly into `NEWS.md`.
(#<issue number>, @<username>)

Provide more detail here as needed.

**Reference GitHub issue associated with pull request.** _e.g., 'closes
#<issue number>'_



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

Pre-review Checklist (if item does not apply, mark is as complete)
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] 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.
- [ ] If a new `ard_*()` function was added, it passes the ARD
structural checks from `cards::check_ard_structure()`.
- [ ] If a new `ard_*()` function was added, `set_cli_abort_call()` has
been set.
- [ ] If a new `ard_*()` function was added and it depends on another
package (such as, `broom`), `is_pkg_installed("broom", reference_pkg =
"cardx")` has been set in the function call and the following added to
the roxygen comments: `@examplesIf
do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom"",
reference_pkg = "cardx"))`
- [ ] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`

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

- [ ] If a bug was fixed, a unit test was added.
- [ ] Code coverage is suitable for any new functions/features:
`devtools::test_coverage()`

When the branch is ready to be merged:
- [ ] Update `NEWS.md` with the changes from this pull request under the
heading "`# cardx (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).
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

NAMESPACE

@@ -25,6 +25,7 @@ export(ard_stats_chisq_test)
 export(ard_stats_fisher_test)
 export(ard_stats_kruskal_test)
 export(ard_stats_mcnemar_test)
+export(ard_stats_mcnemar_test_long)
 export(ard_stats_mood_test)
 export(ard_stats_oneway_test)
 export(ard_stats_paired_t_test)

NEWS.md

@@ -21,6 +21,7 @@ ard_moodtest()          -> ard_stats_mood_test()
 * Added the following functions for calculating Analysis Results Data (ARD).
   - `ard_stats_aov()` for calculating ANOVA results using `stats::aov()`. (#3)
   - `ard_stats_anova()` for calculating ANOVA results using `stats::anova()`. (#12) 
+  - `ard_stats_mcnemar_test_long()` for McNemar's test from long data using `stats::mcnemar.test()`. 
   - `ard_aod_wald_test()` for calculating Wald Tests for regression models using `aod::wald.test()`. (#84)
   - `ard_car_anova()` for calculating ANOVA results using `car::Anova()`. (#3)
   - `ard_stats_oneway_test()` for calculating ANOVA results using `stats::oneway.test()`. (#3)

R/ard_stats_mcnemar_test.R

@@ -2,6 +2,9 @@
 #'
 #' @description
 #' Analysis results data for McNemar's statistical test.
+#' We have two functions depending on the structure of the data.
+#' - `ard_stats_mcnemar_test()` is the structure expected by [`stats::mcnemar.test()`]
+#' - `ard_stats_mcnemar_test_long()` is one row per ID per group
 #'
 #' @param data (`data.frame`)\cr
 #'   a data frame. See below for details.
@@ -11,9 +14,11 @@
 #'   column names to be compared. Independent tests will
 #'   be computed for each variable.
 #' @param ... arguments passed to `stats::mcnemar.test(...)`
+#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column name of the subject or participant ID
 #'
 #' @return ARD data frame
-#' @export
+#' @name ard_stats_mcnemar_test
 #'
 #' @details
 #' For the `ard_stats_mcnemar_test()` function, the data is expected to be one row per subject.
@@ -23,6 +28,21 @@
 #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))
 #' cards::ADSL |>
 #'   ard_stats_mcnemar_test(by = "SEX", variables = "EFFFL")
+#'
+#' set.seed(1234)
+#' cards::ADSL[c("USUBJID", "TRT01P")] |>
+#'   dplyr::mutate(TYPE = "PLANNED") |>
+#'   dplyr::rename(TRT01 = TRT01P) %>%
+#'   dplyr::bind_rows(dplyr::mutate(., TYPE = "ACTUAL", TRT01 = sample(TRT01))) |>
+#'   ard_stats_mcnemar_test_long(
+#'     by = TYPE,
+#'     variable = TRT01,
+#'     id = USUBJID
+#'   )
+NULL
+
+#' @rdname ard_stats_mcnemar_test
+#' @export
 ard_stats_mcnemar_test <- function(data, by, variables, ...) {
   set_cli_abort_call()
 
@@ -61,6 +81,51 @@ ard_stats_mcnemar_test <- function(data, by, variables, ...) {
     dplyr::bind_rows()
 }
 
+#' @rdname ard_stats_mcnemar_test
+#' @export
+ard_stats_mcnemar_test_long <- function(data, by, variables, id, ...) {
+  set_cli_abort_call()
+
+  # check installed packages ---------------------------------------------------
+  check_pkg_installed("broom", reference_pkg = "cardx")
+
+  # check/process inputs -------------------------------------------------------
+  check_not_missing(data)
+  check_not_missing(variables)
+  check_not_missing(by)
+  check_not_missing(id)
+  check_data_frame(data)
+  data <- dplyr::ungroup(data)
+  cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}, id = {{ id }})
+  check_scalar(by)
+  check_scalar(id)
+
+  # if no variables selected, return empty tibble ------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble())
+  }
+  # build ARD ------------------------------------------------------------------
+  lapply(
+    variables,
+    function(variable) {
+      .format_mcnemartest_results(
+        by = by,
+        variable = variable,
+        lst_tidy =
+          cards::eval_capture_conditions({
+            # adding this reshape inside the eval, so if there is an error it's captured in the ARD object
+            data_wide <- .paired_data_pivot_wider(data, by = by, variable = variable, id = id)
+            # performing McNemars test
+            stats::mcnemar.test(x = data_wide[["by1"]], y = data_wide[["by2"]], ...) |>
+              broom::tidy()
+          }),
+        ...
+      )
+    }
+  ) |>
+    dplyr::bind_rows()
+}
+
 #' Convert McNemar's test to ARD
 #'
 #' @inheritParams cards::tidy_as_ard

tests/testthat/test-ard_stats_mcnemar_test.R

@@ -1,4 +1,4 @@
-skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx"))
+skip_if_not(is_pkg_installed(c("broom", "withr"), reference_pkg = "cardx"))
 
 test_that("ard_stats_mcnemar_test() works", {
   expect_error(
@@ -50,4 +50,21 @@ test_that("ard_stats_mcnemar_test() works", {
     cards::ADSL |>
       ard_stats_mcnemar_test(by = SEX, variables = c(EFFFL, COMP16FL))
   )
+
+  # testing long format version
+  withr::local_seed(1234)
+  expect_error(
+    ard_stats_mcnemar_test_long <-
+      cards::ADSL[c("USUBJID", "TRT01P")] |>
+      dplyr::mutate(TYPE = "PLANNED") |>
+      dplyr::rename(TRT01 = TRT01P) %>%
+      dplyr::bind_rows(dplyr::mutate(., TYPE = "ACTUAL", TRT01 = sample(TRT01))) |>
+      ard_stats_mcnemar_test_long(
+        by = TYPE,
+        variable = TRT01,
+        id = USUBJID
+      ),
+    NA
+  )
+  expect_null(ard_stats_mcnemar_test_long$error |> unique() |> unlist())
 })