add ard_aod_wald_test function (#99)

ayogasekaram · ddsjoberg · web-flow · commit ed6a26ce8516 · 2024-04-14T15:26:33.000-07:00
**What changes are proposed in this pull request?** add `ard_aod_wald_test` function closes #84 -------------------------------------------------------------------------------- Pre-review Checklist (if item does not apply, mark is as complete) - [x] **All** GitHub Action workflows pass with a ✅ - [x] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()` - [x] If a bug was fixed, a unit test was added. - [x] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`. - [x] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` - [x] Request a reviewer Reviewer Checklist (if item does not apply, mark is as complete) - [x] If a bug was fixed, a unit test was added. - [x] Run `pkgdown::build_site()`. Check the R console for errors, and review the rendered website. - [x] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: - [x] 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). - [x] **All** GitHub Action workflows pass with a ✅ - [x] Approve Pull Request - [x] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Signed-off-by: Daniel Sjoberg <danield.sjoberg@gmail.com> Signed-off-by: Abinaya Yogasekaram <73252787+ayogasekaram@users.noreply.github.com> Co-authored-by: Daniel Sjoberg <danield.sjoberg@gmail.com>
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -25,6 +25,7 @@ Imports:
     rlang (>= 1.1.1),
     tidyr (>= 1.3.0)
 Suggests:
+    aod (>= 1.3.3),
     broom (>= 1.0.5),
     broom.helpers (>= 1.13.0),
     car (>= 3.0-11),
diff --git a/NAMESPACE b/NAMESPACE
@@ -4,6 +4,7 @@ S3method(ard_regression,default)
 export("%>%")
 export(all_of)
 export(any_of)
+export(ard_aod_wald_test)
 export(ard_car_anova)
 export(ard_car_vif)
 export(ard_effectsize_cohens_d)
diff --git a/NEWS.md b/NEWS.md
@@ -2,7 +2,7 @@
 
 ### Breaking Changes
 
-* Updated function names have been updated to follow the pattern `ard_<pkgname>_<fnname>()`. Former functions names have _not_ been deprecated. (#106)
+* Updated function names to follow the pattern `ard_<pkgname>_<fnname>()`. Former functions names have _not_ been deprecated. (#106)
 
 ```r
 ard_ttest()             -> ard_stats_t_test()
@@ -19,7 +19,8 @@ ard_moodtest()          -> ard_stats_mood_test()
 ### New Features
 
 * Added the following functions for calculating Analysis Results Data (ARD).
-  - `ard_aov()` for calculating ANOVA results using `stats::aov()`. (#3)
+  - `ard_stats_aov()` for calculating ANOVA results using `stats::aov()`. (#3)
+  - `ard_aod_wald_test()` for calculating Wald Tests for regression models using `aod::wald.test()`. (#3)
   - `ard_car_anova()` for calculating ANOVA results using `car::Anova()`. (#3)
   - `ard_onewaytest()` for calculating ANOVA results using `stats::oneway.test()`. (#3)
   - `ard_cohens_d()`, `ard_paired_cohens_d()`, `ard_hedges_g()`, and `ard_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50)
diff --git a/R/ard_aod_wald_test.R b/R/ard_aod_wald_test.R
@@ -0,0 +1,115 @@
+#' ARD Wald Test
+#'
+#' @description
+#' Function takes a regression model object and calculates Wald
+#' statistical test using [`aod::wald.test()`].
+#'
+#' @param x regression model object
+#' @param ... arguments passed to `aod::wald.test(...)`
+#'
+#' @return data frame
+#' @export
+#'
+#' @examplesIf cards::is_pkg_installed(c("aod"), reference_pkg = "cardx")
+#' lm(AGE ~ ARM, data = cards::ADSL) |>
+#'   ard_aod_wald_test()
+ard_aod_wald_test <- function(x, ...) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("aod", reference_pkg = "cardx")
+
+  # check inputs ---------------------------------------------------------------
+  check_not_missing(x)
+
+  # run regression() -----------------------------------------------------------
+  reg_model <- cards::eval_capture_conditions(
+    ard_regression_basic(x, intercept = TRUE, stats_to_remove = c(
+      "var_type",
+      "var_label",
+      "var_class", "label",
+      "contrasts_type", "contrasts", "var_nlevels", "std.error",
+      "conf.low", "conf.high", "statistic", "p.value", "estimate"
+    ))
+  )
+
+  if (!is.null(reg_model[["error"]])) {
+    cli::cli_abort(c(
+      "Unable to identify underlying variable names in regression model.",
+      i = "Is this model type supported by {.fun broom.helpers::tidy_plus_plus}, which is the function used to identify variable names?"
+    ))
+  }
+  aod <-
+    reg_model[["result"]] %>%
+    dplyr::select(c(
+      variable = "variable",
+      model_terms = "stat"
+    )) %>%
+    dplyr::mutate(term_id = dplyr::row_number()) %>%
+    tidyr::nest(data = -"variable") %>%
+    dplyr::rowwise() %>%
+    dplyr::mutate(
+      model_terms = unlist(.data$data[["model_terms"]]) %>% list(),
+      model_terms_id = rlang::set_names(.data$data[["term_id"]]) %>% list()
+    )
+  # run wald.test() -----------------------------------------------------------
+  wald_test <-
+    cards::eval_capture_conditions(lapply(seq_len(length(aod$model_terms_id)), function(terms_id) {
+      aod::wald.test(
+        Sigma = stats::vcov(x),
+        b = stats::coef(x), Terms = aod$model_terms_id[[terms_id]]
+      )
+    }))
+
+
+  df_list <- do.call(rbind, lapply(wald_test$result, .extract_wald_results))
+
+  cbind(aod$variable, df_list) %>%
+    tidyr::pivot_longer(
+      cols = !"aod$variable",
+      names_to = "stat_name",
+      values_to = "stat"
+    ) %>%
+    dplyr::rename(
+      "variable" = "aod$variable"
+    ) |>
+    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 = "aod_wald_test",
+      warning = wald_test["warning"],
+      error = wald_test["error"]
+    ) |>
+    cards::tidy_ard_column_order() %>%
+      {structure(., class = c("card", class(.)))} # styler: off
+}
+
+#' Extract data from wald.test object
+#'
+#'
+#' @param wald_test (`data.frame`)\cr wald test object object from `aod::wald.test()`
+#'
+#' @return a data frame containing the wald test results.
+#' @keywords internal
+
+.extract_wald_results <- function(wald_test) {
+  df <- wald_test$result$chi2[("df")]
+  statistic <- wald_test$result$chi2[("chi2")]
+  p.value <- wald_test$result$chi2[("P")]
+  data.frame(df, statistic, p.value)
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -24,6 +24,7 @@ reference:
   - title: "ARD Creation"
   - subtitle: "Inference"
   - contents:
+      - ard_aod_wald_test
       - ard_car_anova
       - ard_stats_aov
       - ard_stats_chisq_test
diff --git a/man/ard_aod_wald_test.Rd b/man/ard_aod_wald_test.Rd
diff --git a/man/dot-extract_wald_results.Rd b/man/dot-extract_wald_results.Rd
diff --git a/tests/testthat/_snaps/ard_aod_wald_test.md b/tests/testthat/_snaps/ard_aod_wald_test.md
@@ -0,0 +1,15 @@
+# ard_aod_wald_test() works
+
+    Code
+      glm_ard_aod_waldtest[, 1:6]
+    Message
+      {cards} data frame: 6 x 6
+    Output
+           variable   context stat_name stat_label     stat fmt_fn
+      1 (Intercept) aod_wald…        df  Degrees …        1      1
+      2 (Intercept) aod_wald… statistic  Statistic 7126.713      1
+      3 (Intercept) aod_wald…   p.value    p-value        0      1
+      4         ARM aod_wald…        df  Degrees …        2      1
+      5         ARM aod_wald… statistic  Statistic    1.046      1
+      6         ARM aod_wald…   p.value    p-value    0.593      1
+
diff --git a/tests/testthat/test-ard_aod_wald_test.R b/tests/testthat/test-ard_aod_wald_test.R
@@ -0,0 +1,18 @@
+test_that("ard_aod_wald_test() works", {
+  # works for a generic case
+  expect_error(
+    glm_ard_aod_waldtest <-
+      suppressWarnings(lm(AGE ~ ARM, data = cards::ADSL)) |>
+      ard_aod_wald_test(),
+    NA
+  )
+  expect_equal(nrow(glm_ard_aod_waldtest), 6L)
+  expect_snapshot(glm_ard_aod_waldtest[, 1:6])
+
+  # error returned when a regression model isn't passed
+
+  expect_error(
+    ard_aod_wald_test(cards::ADSL) |>
+      dplyr::select(c(context, error))
+  )
+})
