From c849ad4743e87f363fcb46dceb16af99d887c632 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Wed, 6 Mar 2024 12:10:29 -0800 Subject: [PATCH] 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 #'_ closes #3 -------------------------------------------------------------------------------- Pre-review Checklist (if item does not apply, mark is as complete) - [ ] **All** GitHub Action workflows pass with a :white_check_mark: - [ ] 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 :white_check_mark: - [ ] Approve Pull Request - [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Signed-off-by: Daniel Sjoberg --- DESCRIPTION | 1 + NAMESPACE | 1 + R/ard_car_anova.R | 69 ++++++++++++++++++++++++++ R/ard_regression.R | 2 +- _pkgdown.yml | 1 + man/ard_car_anova.Rd | 28 +++++++++++ tests/testthat/_snaps/ard_car_anova.md | 17 +++++++ tests/testthat/test-ard_car_anova.R | 18 +++++++ 8 files changed, 136 insertions(+), 1 deletion(-) create mode 100644 R/ard_car_anova.R create mode 100644 man/ard_car_anova.Rd create mode 100644 tests/testthat/_snaps/ard_car_anova.md create mode 100644 tests/testthat/test-ard_car_anova.R diff --git a/DESCRIPTION b/DESCRIPTION index 2d3fad5f5..38378d68c 100644 --- a/DESCRIPTION +++ b/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), diff --git a/NAMESPACE b/NAMESPACE index e3605f2f4..e10c34862 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ard_car_anova.R b/R/ard_car_anova.R new file mode 100644 index 000000000..8312976ac --- /dev/null +++ b/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 +} diff --git a/R/ard_regression.R b/R/ard_regression.R index ed68b8d79..974787778 100644 --- a/R/ard_regression.R +++ b/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( diff --git a/_pkgdown.yml b/_pkgdown.yml index 0a05a446e..e3142ccc3 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -24,6 +24,7 @@ reference: - title: "ARD Creation" - subtitle: "Inference" - contents: + - ard_car_anova - ard_chisqtest - ard_fishertest - ard_kruskaltest diff --git a/man/ard_car_anova.Rd b/man/ard_car_anova.Rd new file mode 100644 index 000000000..db38def63 --- /dev/null +++ b/man/ard_car_anova.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_car_anova.R +\name{ard_car_anova} +\alias{ard_car_anova} +\title{ARD ANOVA from car Package} +\usage{ +ard_car_anova(x, ...) +} +\arguments{ +\item{x}{regression model object} + +\item{...}{arguments passed to \code{car::Anova(...)}} +} +\value{ +data frame +} +\description{ +Function takes a regression model object and calculated ANOVA using \code{\link[car:Anova]{car::Anova()}}. +} +\examples{ +\dontshow{if (cards::is_pkg_installed("car", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +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") +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/_snaps/ard_car_anova.md b/tests/testthat/_snaps/ard_car_anova.md new file mode 100644 index 000000000..c3400445c --- /dev/null +++ b/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 + diff --git a/tests/testthat/test-ard_car_anova.R b/tests/testthat/test-ard_car_anova.R new file mode 100644 index 000000000..931af0436 --- /dev/null +++ b/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) + ) +})