Closes #10 add ard_vif()

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
 Suggests:
     broom (>= 1.0.5),
     broom.helpers (>= 1.13.0),
+    car (>= 3.0-11),
     spelling,
     testthat (>= 3.2.0),
     withr

NAMESPACE

@@ -14,6 +14,7 @@ export(ard_paired_wilcoxtest)
 export(ard_proportion_ci)
 export(ard_regression)
 export(ard_ttest)
+export(ard_vif)
 export(ard_wilcoxtest)
 export(contains)
 export(ends_with)

R/ard_vif.R

@@ -0,0 +1,79 @@
+#' Regression VIF ARD
+#'
+#' Function takes a regression model object and converts it to a ARD
+#' structure using the `broom.helpers` package.
+#'
+#' @param x regression model object
+#' See car::vif() for details
+#'
+#' Do I need to add "type" or "..." as pass-through?
+#'
+#' @return data frame
+#' @name ard_vif
+#' @rdname ard_vif
+#' @export
+#'
+#' @examples
+#' lm(AGE ~ ARM + SEX, data = cards::ADSL) |>
+#'   ard_vif()
+ard_vif <- function(x) {
+  # check installed packages ---------------------------------------------------
+  cards::check_pkg_installed("broom.helpers", reference_pkg = "cards")
+
+  # check inputs ---------------------------------------------------------------
+  check_not_missing(x, "model")
+
+  temp <- x
+  vif <- car::vif(x) |>
+    cards::eval_capture_conditions()
+
+  # if vif failed, set result as NULL, error will be kept through eval_capture_conditions()
+  if (is.null(vif$result)) {
+    vif$result <- dplyr::tibble(variable = names(temp$coefficients)[-1], VIF = list(NULL))
+  }
+  # if VIF is returned
+  else if (!is.matrix(vif$result)) {
+    vif$result <- dplyr::tibble(variable = names(vif$result), VIF = vif$result)
+  }
+  # if Generalized VIF is returned
+  else if (is.matrix(vif$result)) {
+    vif$result <-
+      vif$result |>
+      as.data.frame() %>%
+      dplyr::mutate(., variable = rownames(.), .before = 1L) |>
+      dplyr::rename(
+        aGVIF = "GVIF^(1/(2*Df))",
+        df = "Df"
+      ) |>
+      dplyr::tibble()
+  }
+
+  # Clean-up the result to fit the ard structure through pivot
+  vif$result <-
+    vif$result |>
+    tidyr::pivot_longer(
+      cols = -c("variable"),
+      names_to = "stat_name",
+      values_to = "stat"
+    ) |>
+    dplyr::mutate(
+      context = "vif",
+      stat_label = ifelse(
+        .data$stat_name == "aGVIF",
+        "Adjusted GVIF",
+        .data$stat_name
+      )
+    )
+
+  # Bind the results and possible warning/errors together
+  vif_return <- dplyr::tibble(
+    vif$result,
+    warning = vif["warning"],
+    error = vif["error"]
+  )
+
+  # Clean up return object
+  vif_return |>
+    cards::tidy_ard_column_order() %>%
+    {structure(., class = c("card", class(.)))}  # styler: off
+}

_pkgdown.yml

@@ -36,6 +36,7 @@ reference:
   - contents:
       - ard_proportion_ci
       - ard_regression
+      - ard_vif
 
   - title: "Helpers"
   - contents:

inst/WORDLIST

@@ -9,6 +9,7 @@ Lifecycle
 McNemar's
 Newcombe
 Su
+VIF
 XG
 Xin
 agresti
@@ -18,6 +19,7 @@ funder
 jeffreys
 pearson
 strat
+vif
 wald
 waldcc
 wilson

tests/testthat/_snaps/ard_vif.md

@@ -0,0 +1,30 @@
+# ard_vif() works
+
+    Code
+      ard_vif(lm(AGE ~ ARM + SEX, data = cards::ADSL))
+    Message
+      {cards} data frame: 6 x 7
+    Output
+        variable context stat_name stat_label  stat
+      1      ARM     vif      GVIF       GVIF 1.016
+      2      ARM     vif        df         df     2
+      3      ARM     vif     aGVIF  Adjusted… 1.004
+      4      SEX     vif      GVIF       GVIF 1.016
+      5      SEX     vif        df         df     1
+      6      SEX     vif     aGVIF  Adjusted… 1.008
+    Message
+      i 2 more variables: warning, error
+
+# ard_vif() appropriate errors are given for model with only 1 term
+
+    Code
+      ard_vif(lm(AGE ~ ARM, data = cards::ADSL))
+    Message
+      {cards} data frame: 2 x 7
+    Output
+                       variable context stat_name stat_label stat     error
+      1 ARMXanomeline High Dose     vif       VIF        VIF      model co…
+      2  ARMXanomeline Low Dose     vif       VIF        VIF      model co…
+    Message
+      i 1 more variable: warning
+

tests/testthat/test-ard_vif.R

@@ -0,0 +1,21 @@
+test_that("ard_vif() works", {
+  expect_snapshot(
+    lm(AGE ~ ARM + SEX, data = cards::ADSL) |>
+      ard_vif()
+  )
+})
+
+test_that("ard_vif() appropriate errors are given for model with only 1 term", {
+  expect_snapshot(
+    lm(AGE ~ ARM, data = cards::ADSL) |>
+      ard_vif()
+  )
+  expect_equal(
+    lm(AGE ~ ARM, data = cards::ADSL) |>
+      ard_vif() |>
+      dplyr::select(error) |>
+      unlist() |>
+      unique(),
+    "model contains fewer than 2 terms"
+  )
+})