Adding ard_car_anova() (#67)

**What changes are proposed in this pull request?**
* Added `ard_car_anova()` for tabulating results from `car::Anova()`.
(#3)

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


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

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.
- [ ] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`
- [ ] Request a reviewer

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

- [ ] 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()`

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).
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

---------

Signed-off-by: Daniel Sjoberg <[email protected]>

DESCRIPTION

@@ -24,6 +24,7 @@ Imports:
 Suggests:
     broom (>= 1.0.5),
     broom.helpers (>= 1.13.0),
+    car (>= 3.0-11),
     effectsize (>= 0.6.0),
     parameters (>= 0.20.2),
     smd (>= 0.6.6),

NAMESPACE

@@ -4,6 +4,7 @@ S3method(ard_regression,default)
 export("%>%")
 export(all_of)
 export(any_of)
+export(ard_car_anova)
 export(ard_chisqtest)
 export(ard_cohens_d)
 export(ard_fishertest)

R/ard_car_anova.R

@@ -0,0 +1,69 @@
+#' ARD ANOVA from car Package
+#'
+#' Function takes a regression model object and calculated ANOVA using [`car::Anova()`].
+#'
+#' @param x regression model object
+#' @param ... arguments passed to `car::Anova(...)`
+#'
+#' @return data frame
+#' @export
+#'
+#' @examplesIf cards::is_pkg_installed("car", reference_pkg = "cardx")
+#' lm(AGE ~ ARM, data = cards::ADSL) |>
+#'   ard_car_anova()
+#'
+#' glm(vs ~ factor(cyl) + factor(am), data = mtcars, family = binomial) |>
+#'   ard_car_anova(test.statistic = "Wald")
+ard_car_anova <- function(x, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx")
+
+  # check inputs ---------------------------------------------------------------
+  check_not_missing(x)
+
+  # run car::Anova() -----------------------------------------------------------
+  car_anova <- cards::eval_capture_conditions(car::Anova(x, ...))
+
+  if (!is.null(car_anova[["error"]])) {
+    cli::cli_abort(c(
+      "There was an error running {.fun car::Anova}. See error message below.",
+      x = car_anova[["error"]]
+    ))
+  }
+
+  car_anova[["result"]] |>
+    broom.helpers::tidy_parameters(conf.int = FALSE) |> # using broom.helpers, because it handle non-syntactic names for us
+    dplyr::filter(!(dplyr::row_number() == dplyr::n() & .data$term %in% "Residuals")) |> # removing Residual rows
+    dplyr::rename(variable = "term") |>
+    tidyr::pivot_longer(
+      cols = -"variable",
+      names_to = "stat_name",
+      values_to = "stat"
+    ) |>
+    dplyr::mutate(
+      stat = as.list(.data$stat),
+      stat_label =
+        dplyr::case_when(
+          .data$stat_name %in% "statistic" ~ "Statistic",
+          .data$stat_name %in% "df" ~ "Degrees of Freedom",
+          .data$stat_name %in% "p.value" ~ "p-value",
+          TRUE ~ .data$stat_name
+        ),
+      fmt_fn =
+        map(
+          .data$stat,
+          function(.x) {
+            # styler: off
+            if (is.integer(.x)) return(0L)
+            if (is.numeric(.x)) return(1L)
+            # styler: on
+            NULL
+          }
+        ),
+      context = "car_anova",
+      warning = car_anova["warning"],
+      error = car_anova["error"]
+    ) |>
+    cards::tidy_ard_column_order() %>%
+    {structure(., class = c("card", class(.)))} # styler: off
+}

R/ard_regression.R

@@ -29,7 +29,7 @@ ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_
   cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx")
 
   # check inputs ---------------------------------------------------------------
-  check_not_missing(x, "model")
+  check_not_missing(x)
 
   # summarize model ------------------------------------------------------------
   broom.helpers::tidy_plus_plus(

_pkgdown.yml

@@ -24,6 +24,7 @@ reference:
   - title: "ARD Creation"
   - subtitle: "Inference"
   - contents:
+      - ard_car_anova
       - ard_chisqtest
       - ard_fishertest
       - ard_kruskaltest

tests/testthat/_snaps/ard_car_anova.md

@@ -0,0 +1,17 @@
+# ard_car_anova() works
+
+    Code
+      glm_ard_car_anova
+    Message
+      {cards} data frame: 6 x 8
+    Output
+           variable   context stat_name stat_label  stat fmt_fn
+      1 factor(cyl) car_anova statistic  Statistic     0      1
+      2 factor(cyl) car_anova        df  Degrees …     2      1
+      3 factor(cyl) car_anova   p.value    p-value     1      1
+      4  factor(am) car_anova statistic  Statistic     0      1
+      5  factor(am) car_anova        df  Degrees …     1      1
+      6  factor(am) car_anova   p.value    p-value 0.998      1
+    Message
+      i 2 more variables: warning, error
+

tests/testthat/test-ard_car_anova.R

@@ -0,0 +1,18 @@
+test_that("ard_car_anova() works", {
+  # works for a generic case
+  expect_error(
+    glm_ard_car_anova <-
+      suppressWarnings(glm(vs ~ factor(cyl) + factor(am), data = mtcars, family = binomial)) |>
+      ard_car_anova(test.statistic = "Wald"),
+    NA
+  )
+  expect_equal(nrow(glm_ard_car_anova), 6L)
+  expect_snapshot(glm_ard_car_anova)
+})
+
+test_that("ard_car_anova() messaging", {
+  expect_snapshot(
+    error = TRUE,
+    ard_car_anova(mtcars)
+  )
+})