Adding as_cards_fun() to ard_categorical_ci() (#263)

**What changes are proposed in this pull request?**
* Added `as_cards_fun()` to `ard_categorical_ci()` so when there is an
error, the user gets an ARD with the expected ARD structure. (#262)

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


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

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] If a new `ard_*()` function was added, `set_cli_abort_call()` has
been set.
- [x] If a new `ard_*()` function was added and it depends on another
package (such as, `broom`), `is_pkg_installed("broom")` 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""))`
- [x] 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".

Author: ddsjoberg

DESCRIPTION

@@ -20,7 +20,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
     R (>= 4.1)
 Imports:
-    cards (>= 0.4.0),
+    cards (>= 0.4.0.9028),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),

NEWS.md

@@ -1,5 +1,7 @@
 # cardx 0.2.2.9018
 
+* Added `as_cards_fun()` to `ard_categorical_ci()` so when there is an error, the user gets an ARD with the expected ARD structure. (#262)
+
 * Little `n` is now returned with the results of the `proportion_ci_*()` functions, which then flows into the results of `ard_proportion_ci()`. (#256)
 
 * Update in `ard_categorical.survey.design()` for factor variables that are all missing. These variables can now be tabulated, where previously this resulted in an error. 

R/ard_categorical.survey.design.R

@@ -517,10 +517,10 @@ case_switch <- function(..., .default = NULL) {
               return(fmt_fn)
             }
             if (stat_name %in% c("p", "p_miss", "p_nonmiss", "p_unweighted")) {
-              return(cards::label_cards(digits = 1, scale = 100))
+              return(cards::label_round(digits = 1, scale = 100))
             }
             if (stat_name %in% c("n", "N", "N_miss", "N_nonmiss", "N_obs", "n_unweighted", "N_unweighted")) {
-              return(cards::label_cards(digits = 0))
+              return(cards::label_round(digits = 0))
             }
             if (is.integer(stat)) {
               return(0L)

R/ard_categorical_ci.R

@@ -82,8 +82,6 @@ ard_categorical_ci.data.frame <- function(data,
     data[variables],
     value = value
   )
-  # drop any missing values in the analysis variables
-  data <- tidyr::drop_na(data, any_of(c(variables, by, strata)))
 
   # if there is no by variable, then treat cell as column because it's the same.
   if (denominator == "cell" && is_empty(by)) {
@@ -199,7 +197,15 @@ ard_categorical_ci.data.frame <- function(data,
         conf.level = conf.level, correct = FALSE
       )
     }
-  )
+  ) |>
+    cards::as_cards_fn(
+      stat_names =
+        case_switch(
+          method %in% c("strat_wilsoncc", "strat_wilsoncc") ~
+            c("N", "n", "estimate", "conf.low", "conf.high", "conf.level", "weights", "method"),
+          .default = c("N", "n", "estimate", "conf.low", "conf.high", "conf.level", "method")
+        )
+    )
 }
 
 .unique_values_sort <- function(data, variable, value = NULL) {
@@ -313,9 +319,11 @@ ard_categorical_ci.data.frame <- function(data,
   df_grouping_cols <- cards::nest_for_ard(data, by = by, include_data = FALSE)
   levels <- .levels_for_row(data = data, by = by)
 
-  cards::nest_for_ard(
-    data = data[c(variable, by, strata)],
-    by = variable
+  suppressMessages(
+    cards::nest_for_ard(
+      data = data[c(variable, by, strata)],
+      by = variable
+    )
   ) |>
     dplyr::rename(variable = "group1", variable_level = "group1_level") %>%
     {
@@ -359,7 +367,9 @@ ard_categorical_ci.data.frame <- function(data,
                                            conf.level, strata, weights, max.iterations) {
   # create the base of what the grouping and variable ARD will look like
   df_groups_variable <-
-    cards::nest_for_ard(data, by = c(by, variable), include_data = FALSE) |>
+    suppressMessages(
+      cards::nest_for_ard(data, by = c(by, variable), include_data = FALSE)
+    ) |>
     dplyr::rename(
       variable = glue::glue("group{length(c(variable, by))}"),
       variable_level = glue::glue("group{length(c(variable, by))}_level")

tests/testthat/test-ard_categorical_ci.data.frame.R

@@ -168,6 +168,7 @@ test_that("ard_continuous_ci.data.frame() follows ard structure", {
   )
 })
 
+
 test_that("ard_continuous_ci.data.frame(denominator='row')", {
   # check the structure of the output
   expect_silent(
@@ -337,3 +338,66 @@ test_that("ard_continuous_ci.data.frame(denominator='cell')", {
     )
   )
 })
+
+test_that("ard_continuous_ci.data.frame(denominator='column') with all NA column", {
+  expect_silent(
+    ard <-
+      mtcars |>
+      dplyr::mutate(vs = ifelse(am == 0, NA, vs)) |>
+      ard_categorical_ci(
+        variables = vs,
+        by = am,
+        denominator = "column",
+        method = "wilson"
+      )
+  )
+
+  expect_equal(
+    ard |>
+      dplyr::filter(group1_level %in% 0) |>
+      dplyr::pull(stat_name),
+    c("N", "n", "estimate", "conf.low", "conf.high", "conf.level", "method")
+  )
+})
+
+test_that("ard_continuous_ci.data.frame(denominator='row') with all NA column", {
+  expect_silent(
+    ard <-
+      mtcars |>
+      dplyr::mutate(vs = ifelse(am == 0, NA, vs)) |>
+      ard_categorical_ci(
+        variables = vs,
+        by = am,
+        denominator = "row",
+        method = "wilson"
+      )
+  )
+
+  expect_equal(
+    ard |>
+      dplyr::filter(group1_level %in% 0) |>
+      dplyr::pull(stat_name),
+    c("N", "n", "conf.level", "estimate", "statistic", "p.value", "parameter", "conf.low", "conf.high", "method", "alternative")
+  )
+})
+
+test_that("ard_continuous_ci.data.frame(denominator='cell') with all NA column", {
+  expect_silent(
+    ard <-
+      mtcars |>
+      dplyr::mutate(vs = ifelse(am == 0, NA, vs)) |>
+      ard_categorical_ci(
+        variables = vs,
+        by = am,
+        denominator = "cell",
+        method = "wilson"
+      )
+  )
+
+  expect_equal(
+    ard |>
+      dplyr::filter(group1_level %in% 0) |>
+      dplyr::pull(stat_name),
+    c("N", "n", "conf.level", "estimate", "statistic", "p.value", "parameter", "conf.low", "conf.high", "method", "alternative")
+  )
+})