add check_ard_structure() unit tests (#197)

closes #151 -------------------------------------------------------------------------------- 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". --------- Signed-off-by: Abinaya Yogasekaram <[email protected]> Co-authored-by: Daniel Sjoberg <[email protected]>
insightsengineering · Aug 23, 2024 · ea13383 · ea13383
1 parent 9b08b6f
commit ea13383
Show file tree

Hide file tree

Showing 42 changed files with 420 additions and 20 deletions.
diff --git a/R/ard_car_vif.R b/R/ard_car_vif.R
@@ -74,6 +74,7 @@ ard_car_vif <- function(x, ...) {
     ) |>
     dplyr::mutate(
       context = "car_vif",
+      stat = as.list(.data$stat),
       stat_label = ifelse(
         .data$stat_name == "aGVIF",
         "Adjusted GVIF",

diff --git a/R/ard_regression.R b/R/ard_regression.R
@@ -52,7 +52,7 @@ ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_
     if (!is.null(lst_results[["result"]])) {
       lst_results[["result"]] |>
         dplyr::mutate(
-          variable_level = dplyr::if_else(.data$var_type %in% "continuous", NA_character_, .data$label),
+          variable_level = as.list(dplyr::if_else(.data$var_type %in% "continuous", NA_character_, .data$label)),
           dplyr::across(-c("variable", "variable_level"), .fns = as.list)
         ) |>
         tidyr::pivot_longer(

diff --git a/R/ard_stats_aov.R b/R/ard_stats_aov.R
@@ -50,6 +50,16 @@ ard_stats_aov <- function(formula, data, ...) {
           TRUE ~ .data$stat_name
         ),
       context = "stats_aov",
+      fmt_fn = lapply(
+        .data$stat,
+        function(x) {
+          switch(is.integer(x),
+            0L
+          ) %||% switch(is.numeric(x),
+            1L
+          )
+        }
+      ),
       warning = aov["warning"],
       error = aov["error"]
     ) |>

diff --git a/tests/testthat/_snaps/ard_car_vif.md b/tests/testthat/_snaps/ard_car_vif.md
@@ -5,10 +5,10 @@
     Output
         variable context stat_name    stat_label     stat fmt_fn warning error
       1      ARM car_vif      GVIF          GVIF 1.015675      1    NULL  NULL
-      2      ARM car_vif        df            df 2.000000      1    NULL  NULL
+      2      ARM car_vif        df            df        2      1    NULL  NULL
       3      ARM car_vif     aGVIF Adjusted GVIF 1.003896      1    NULL  NULL
       4      SEX car_vif      GVIF          GVIF 1.015675      1    NULL  NULL
-      5      SEX car_vif        df            df 1.000000      1    NULL  NULL
+      5      SEX car_vif        df            df        1      1    NULL  NULL
       6      SEX car_vif     aGVIF Adjusted GVIF 1.007807      1    NULL  NULL
 
 ---

diff --git a/tests/testthat/_snaps/ard_regression.md b/tests/testthat/_snaps/ard_regression.md
@@ -59,12 +59,12 @@
       cards::round5(x, 3), x)))
     Output
                         variable           variable_level stat_name   stat warning error
-      1                       hp                     <NA>     n_obs     32    NULL  NULL
-      2                       hp                     <NA>  estimate  -0.03    NULL  NULL
-      3                       hp                     <NA> std.error  0.015    NULL  NULL
-      4                       hp                     <NA> statistic -2.088    NULL  NULL
-      5                       hp                     <NA>  conf.low -0.059    NULL  NULL
-      6                       hp                     <NA> conf.high -0.002    NULL  NULL
+      1                       hp                       NA     n_obs     32    NULL  NULL
+      2                       hp                       NA  estimate  -0.03    NULL  NULL
+      3                       hp                       NA std.error  0.015    NULL  NULL
+      4                       hp                       NA statistic -2.088    NULL  NULL
+      5                       hp                       NA  conf.low -0.059    NULL  NULL
+      6                       hp                       NA conf.high -0.002    NULL  NULL
       7      cyl.sd__(Intercept)      cyl.sd__(Intercept)  estimate  4.023    NULL  NULL
       8 Residual.sd__Observation Residual.sd__Observation  estimate  3.149    NULL  NULL
 

diff --git a/tests/testthat/_snaps/ard_stats_aov.md b/tests/testthat/_snaps/ard_stats_aov.md
@@ -3,15 +3,26 @@
     Code
       as.data.frame(ard_stats_aov(AGE ~ ARM + SEX, data = cards::ADSL))
     Output
-         variable   context stat_name             stat_label      stat warning error
-      1       ARM stats_aov     sumsq         Sum of Squares  71.38574    NULL  NULL
-      2       ARM stats_aov        df     Degrees of Freedom         2    NULL  NULL
-      3       ARM stats_aov    meansq Mean of Sum of Squares  35.69287    NULL  NULL
-      4       ARM stats_aov statistic              Statistic 0.5235002    NULL  NULL
-      5       ARM stats_aov   p.value                p-value 0.5930912    NULL  NULL
-      6       SEX stats_aov     sumsq         Sum of Squares  87.40947    NULL  NULL
-      7       SEX stats_aov        df     Degrees of Freedom         1    NULL  NULL
-      8       SEX stats_aov    meansq Mean of Sum of Squares  87.40947    NULL  NULL
-      9       SEX stats_aov statistic              Statistic  1.282017    NULL  NULL
-      10      SEX stats_aov   p.value                p-value 0.2586091    NULL  NULL
+         variable   context stat_name             stat_label      stat fmt_fn warning
+      1       ARM stats_aov     sumsq         Sum of Squares  71.38574      1    NULL
+      2       ARM stats_aov        df     Degrees of Freedom         2      1    NULL
+      3       ARM stats_aov    meansq Mean of Sum of Squares  35.69287      1    NULL
+      4       ARM stats_aov statistic              Statistic 0.5235002      1    NULL
+      5       ARM stats_aov   p.value                p-value 0.5930912      1    NULL
+      6       SEX stats_aov     sumsq         Sum of Squares  87.40947      1    NULL
+      7       SEX stats_aov        df     Degrees of Freedom         1      1    NULL
+      8       SEX stats_aov    meansq Mean of Sum of Squares  87.40947      1    NULL
+      9       SEX stats_aov statistic              Statistic  1.282017      1    NULL
+      10      SEX stats_aov   p.value                p-value 0.2586091      1    NULL
+         error
+      1   NULL
+      2   NULL
+      3   NULL
+      4   NULL
+      5   NULL
+      6   NULL
+      7   NULL
+      8   NULL
+      9   NULL
+      10  NULL
 
diff --git a/tests/testthat/test-ard_aod_wald_test.R b/tests/testthat/test-ard_aod_wald_test.R
@@ -18,3 +18,11 @@ test_that("ard_aod_wald_test() works", {
       dplyr::select(c(context, error))
   )
 })
+
+test_that("ard_aod_wald_test() follows ard structure", {
+  expect_silent(
+    suppressWarnings(lm(AGE ~ ARM, data = cards::ADSL)) |>
+      ard_aod_wald_test() |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_car_anova.R b/tests/testthat/test-ard_car_anova.R
@@ -20,3 +20,11 @@ test_that("ard_car_anova() messaging", {
     ard_car_anova(mtcars)
   )
 })
+
+test_that("ard_car_anova() follows ard structure", {
+  expect_silent(
+    suppressWarnings(glm(vs ~ factor(cyl) + factor(am), data = mtcars, family = binomial)) |>
+      ard_car_anova(test.statistic = "Wald") |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_car_vif.R b/tests/testthat/test-ard_car_vif.R
@@ -31,3 +31,11 @@ test_that("ard_vif() issues friendly messaging for incorrect object passed in/ca
     cards::ADSL |> ard_car_vif()
   )
 })
+
+test_that("ard_car_vif() follows ard structure", {
+  expect_silent(
+    lm(AGE ~ ARM + SEX, data = cards::ADSL) |>
+      ard_car_vif() |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_categorical.survey.design.R b/tests/testthat/test-ard_categorical.survey.design.R
@@ -1309,3 +1309,18 @@ test_that("ard_categorical.survey.design(statistic) properly excluded unweighted
       dplyr::select(variable, variable_level, stat_name, stat_label, stat)
   )
 })
+
+test_that("ard_categorical follows ard structure", {
+  data(api, package = "survey")
+  svy_titanic <- survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq)
+
+  expect_silent(
+    ard_categorical(
+      svy_titanic,
+      variables = c(Class, Age),
+      by = Survived,
+      denominator = "row"
+    ) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_categorical_ci.survey.design.R b/tests/testthat/test-ard_categorical_ci.survey.design.R
@@ -111,3 +111,10 @@ test_that("ard_categorical_ci(method)", {
       set_names(c("estimate", "conf.low", "conf.high"))
   )
 })
+
+test_that("ard_categorical_ci.survey.design() follows ard structure", {
+  expect_silent(
+    ard_categorical_ci(dclus1, variables = c(both, awards), method = "likelihood") |>
+      cards::check_ard_structure(method = TRUE)
+  )
+})
diff --git a/tests/testthat/test-ard_continuous.survey.design.R b/tests/testthat/test-ard_continuous.survey.design.R
@@ -508,3 +508,13 @@ test_that("ard_continuous.survey.design() works when using generic names ", {
     ard_continuous(dclus2, variables = c(deff, mean.std.error), by = min) |> dplyr::select(stat)
   )
 })
+
+test_that("ard_continuous.survey.design() follows ard structure", {
+  data(api, package = "survey")
+  dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
+
+  expect_silent(
+    ard_continuous(dclus1, variables = c(cds, stype), by = snum) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_continuous_ci.data.frame.R b/tests/testthat/test-ard_continuous_ci.data.frame.R
@@ -33,3 +33,14 @@ test_that("ard_continuous_ci.data.frame(method = 'wilcox.test')", {
       dplyr::select(-context)
   )
 })
+
+test_that("ard_continuous_ci.data.frame() follows ard structure", {
+  expect_silent(
+    ard_continuous_ci(
+      mtcars,
+      variables = mpg,
+      method = "wilcox.test"
+    ) |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_continuous_ci.survey.design.R b/tests/testthat/test-ard_continuous_ci.survey.design.R
@@ -195,3 +195,10 @@ test_that("ard_continuous_ci() errors are captured", {
     ard_continuous_ci(dclus1, variables = sch.wide, method = "svymedian.beta")
   )
 })
+
+test_that("ard_continuous_ci.survey.design() follows ard structure", {
+  expect_silent(
+    ard_continuous_ci(dclus1, variables = c(api00, api99), df = 50) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_dichotomous.survey.design.R b/tests/testthat/test-ard_dichotomous.survey.design.R
@@ -448,3 +448,19 @@ test_that("ard_dichotomous.survey.design() returns an error with erroneous input
     error = TRUE
   )
 })
+
+
+test_that("ard_dichotomous.survey.design() follows ard structure", {
+  svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1)
+  svy_dicho$variables <- svy_dicho$variables |>
+    dplyr::mutate(across(c("cyl", "am", "vs"), as.factor))
+  expect_silent(
+    ard_dichotomous(svy_dicho,
+      by = vs,
+      variables = c(cyl, am),
+      value = list(cyl = 4),
+      denominator = "row"
+    ) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_effectsize_cohens_d.R b/tests/testthat/test-ard_effectsize_cohens_d.R
@@ -95,3 +95,26 @@ test_that("ard_effectsize_paired_cohens_d() works", {
     FALSE
   )
 })
+
+test_that("ard_effectsize_cohens_d() follows ard structure", {
+  expect_silent(
+    cards::ADSL |>
+      dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+      ard_effectsize_cohens_d(by = ARM, variables = AGE, pooled_sd = FALSE) |>
+      cards::check_ard_structure()
+  )
+
+  # paired
+  ADSL_paired <-
+    cards::ADSL[c("ARM", "AGE")] |>
+    dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+    dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |>
+    dplyr::group_by(USUBJID) |>
+    dplyr::filter(dplyr::n() > 1)
+
+  expect_silent(
+    ADSL_paired |>
+      ard_effectsize_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID) |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_effectsize_hedges_g.R b/tests/testthat/test-ard_effectsize_hedges_g.R
@@ -91,3 +91,26 @@ test_that("ard_effectsize_paired_hedges_g() works", {
     FALSE
   )
 })
+
+test_that("ard_effectsize_cohens_d() follows ard structure", {
+  expect_silent(
+    cards::ADSL |>
+      dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+      ard_effectsize_hedges_g(by = ARM, variables = AGE, pooled_sd = FALSE) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+
+  # paired
+  ADSL_paired <-
+    cards::ADSL[c("ARM", "AGE")] |>
+    dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+    dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |>
+    dplyr::group_by(USUBJID) |>
+    dplyr::filter(dplyr::n() > 1)
+
+  expect_silent(
+    ADSL_paired |>
+      ard_effectsize_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_emmeans_mean_difference.R b/tests/testthat/test-ard_emmeans_mean_difference.R
@@ -84,3 +84,16 @@ test_that("ard_emmeans_mean_difference() works", {
       getElement("estimate")
   )
 })
+
+test_that("ard_emmeans_mean_difference() follows ard structure", {
+  expect_silent(
+    ard_emmeans_mean_difference(
+      data = mtcars,
+      formula = vs ~ am + mpg,
+      method = "glm",
+      method.args = list(family = binomial),
+      response_type = "dichotomous"
+    ) |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_missing.survey.design.R b/tests/testthat/test-ard_missing.survey.design.R
@@ -103,3 +103,12 @@ test_that("ard_missing.survey.design() works", {
       cards::get_ard_statistics(stat_name %in% "p_nonmiss") |> unlist() |> unname()
   )
 })
+
+test_that("ard_missing.survey.design() follows ard structure", {
+  data(api, package = "survey")
+  svy_titanic <- survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq)
+  expect_silent(
+    ard_missing(svy_titanic, variables = c(Class, Age), by = NULL) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_proportion_ci.R b/tests/testthat/test-ard_proportion_ci.R
@@ -119,3 +119,14 @@ test_that("ard_categorical_ci() messaging", {
     )
   )
 })
+
+test_that("ard_proportion_ci() follows ard structure", {
+  expect_silent(
+    ard_categorical_ci(
+      data = mtcars,
+      variables = c(am, vs),
+      method = "waldcc"
+    ) |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_regression.R b/tests/testthat/test-ard_regression.R
@@ -53,3 +53,11 @@ test_that("ard_regression() warnings and errors return correctly", {
       as.data.frame()
   )
 })
+
+test_that("ard_regression() follows ard structure", {
+  expect_silent(
+    lm(AGE ~ ARM, data = cards::ADSL) |>
+      ard_regression(add_estimate_to_reference_rows = TRUE) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_regression_basic.R b/tests/testthat/test-ard_regression_basic.R
@@ -15,3 +15,11 @@ test_that("ard_regression_basic() works", {
 test_that("ard_regression_basic() does not produce `variable_level` column where not applicable", {
   expect_true(!"variable_level" %in% names(lm(mpg ~ hp, mtcars) |> ard_regression_basic()))
 })
+
+test_that("ard_regression_basic() follows ard structure", {
+  expect_silent(
+    lm(AGE ~ ARM, data = cards::ADSL) |>
+      ard_regression_basic() |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})
diff --git a/tests/testthat/test-ard_smd_smd.R b/tests/testthat/test-ard_smd_smd.R
@@ -69,3 +69,11 @@ test_that("ard_smd_smd() error messaging", {
     "gref must be an integer within 2"
   )
 })
+
+test_that("ard_smd_smd() follows ard structure", {
+  expect_silent(
+    mtcars |>
+      ard_smd_smd(by = vs, variables = am, std.error = TRUE) |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_stats_anova.R b/tests/testthat/test-ard_stats_anova.R
@@ -143,3 +143,14 @@ test_that("ard_stats_anova.data.frame() error messaging", {
       grepl(pattern = "^Argument `method` cannot be namespaced*", x = _)
   )
 })
+
+test_that("ard_stats_anova() follows ard structure", {
+  expect_silent(
+    anova(
+      lm(mpg ~ am, mtcars),
+      lm(mpg ~ am + hp, mtcars)
+    ) |>
+      ard_stats_anova() |>
+      cards::check_ard_structure()
+  )
+})
diff --git a/tests/testthat/test-ard_stats_aov.R b/tests/testthat/test-ard_stats_aov.R
@@ -27,3 +27,10 @@ test_that("ard_aov() works", {
       as.data.frame()
   )
 })
+
+test_that("ard_stats_aov() follows ard structure", {
+  expect_silent(
+    ard_stats_aov(AGE ~ ARM, data = cards::ADSL) |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})