Merge branch 'main' into remove_lookups

Author: m7pr

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cardx
 Title: Extra Analysis Results Data Utilities
-Version: 0.2.2.9018
+Version: 0.2.2.9020
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),
@@ -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,4 +1,6 @@
-# cardx 0.2.2.9018
+# cardx 0.2.2.9020
+
+* 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)
 

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) {
@@ -265,9 +271,11 @@ ard_categorical_ci.data.frame <- function(data,
   # if there are no by variables, then all row percents are 100%
   if (is_empty(by)) {
     df_res <-
-      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") %>%
       {
@@ -313,9 +321,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 +369,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")
+  )
+})