Implement cards::as_card() (#201)

**What changes are proposed in this pull request?**
* Implement `cards::as_card()` where needed in the package to convert
data frames to class 'card'.

Closes #200 


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

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", 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"))`
- [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:
- [x] 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).
- [x] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

NEWS.md

@@ -6,6 +6,8 @@
 
 * Added `warning` and `error` columns to `ard_regression()` output. (#148)
 
+* Implemented `cards::as_card()` where needed in the package to convert data frames to class 'card'. (#200)
+
 # cardx 0.2.0
 
 ### Breaking Changes

R/ard_aod_wald_test.R

@@ -101,8 +101,8 @@ ard_aod_wald_test <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_pa
       warning = wald_test["warning"],
       error = wald_test["error"]
     ) |>
-    cards::tidy_ard_column_order() %>%
-      {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }
 
 #' Extract data from wald.test object

R/ard_car_anova.R

@@ -69,6 +69,6 @@ ard_car_anova <- function(x, ...) {
       warning = car_anova["warning"],
       error = car_anova["error"]
     ) |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_car_vif.R

@@ -100,6 +100,6 @@ ard_car_vif <- function(x, ...) {
 
   # Clean up return object
   vif_return |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))}  # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_categorical.survey.design.R

@@ -72,8 +72,10 @@ ard_categorical.survey.design <- function(data,
   variables <- setdiff(variables, by)
   check_scalar(by, allow_empty = TRUE)
 
-  # if no variables selected, return empty data frame
-  if (is_empty(variables)) return(dplyr::tibble()) # styler: off
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
 
   check_na_factor_levels(data$variables, c(by, variables))
 
@@ -97,11 +99,6 @@ ard_categorical.survey.design <- function(data,
   )
   denominator <- arg_match(denominator)
 
-  # return empty tibble if no variables selected -------------------------------
-  if (is_empty(variables)) {
-    return(dplyr::tibble())
-  }
-
   # check the missingness
   walk(
     variables,
@@ -215,8 +212,8 @@ ard_categorical.survey.design <- function(data,
       warning = list(NULL),
       error = list(NULL),
     ) |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} |> # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order() |>
     cards::tidy_ard_row_order()
 }
 

R/ard_categorical_ci.R

@@ -76,6 +76,12 @@ ard_categorical_ci.data.frame <- function(data,
     data[variables],
     value = value
   )
+  check_not_missing(variables)
+
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
 
   # calculate confidence intervals ---------------------------------------------
   map(

R/ard_categorical_ci.survey.design.R

@@ -50,6 +50,11 @@ ard_categorical_ci.survey.design <- function(data,
   check_scalar_range(conf.level, range = c(0, 1))
   method <- arg_match(method)
 
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
+
   # calculate and return ARD of one sample CI ----------------------------------
   .calculate_ard_onesample_survey_ci(
     FUN = .svyciprop_wrapper,
@@ -65,9 +70,6 @@ ard_categorical_ci.survey.design <- function(data,
 }
 
 .calculate_ard_onesample_survey_ci <- function(FUN, data, variables, by, conf.level, value, ...) {
-  # return empty data frame if no variables to process -------------------------
-  if (is_empty(variables)) return(dplyr::tibble()) # styler: off
-
   # calculate results ----------------------------------------------------------
   map(
     variables,
@@ -142,8 +144,8 @@ ard_categorical_ci.survey.design <- function(data,
       stat_label = .data$stat_name,
       fmt_fn = map(.data$stat, ~ case_switch(is.numeric(.x) ~ 2L, .default = as.character))
     ) |>
-    cards::tidy_ard_column_order() %>%
-    structure(., class = c("card", class(.)))
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 
   # if a value was passed for the variable, subset on those results
   if (!is_empty(value)) {

R/ard_continuous.survey.design.R

@@ -81,9 +81,9 @@ ard_continuous.survey.design <- function(data, variables, by = NULL,
     )
   )
 
-  # return empty tibble if no variables selected -------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # compute the weighted statistics --------------------------------------------
@@ -147,8 +147,8 @@ ard_continuous.survey.design <- function(data, variables, by = NULL,
   # add class and return ARD object --------------------------------------------
   df_stats |>
     dplyr::mutate(context = "continuous") |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }
 
 .default_svy_stat_labels <- function(stat_label = NULL) {

R/ard_continuous_ci.R

@@ -30,6 +30,13 @@ ard_continuous_ci.data.frame <- function(data, variables, by = dplyr::group_vars
 
   # check inputs ---------------------------------------------------------------
   method <- arg_match(method)
+  check_not_missing(variables)
+  cards::process_selectors(data, by = {{ by }}, variables = {{ variables }})
+
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
 
   # calculate CIs --------------------------------------------------------------
   switch(method,

R/ard_continuous_ci.survey.design.R

@@ -59,6 +59,11 @@ ard_continuous_ci.survey.design <- function(data,
     }
   )
 
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
+
   # calculate and return ARD of one sample CI ----------------------------------
   .calculate_ard_continuous_survey_ci(
     FUN = ifelse(method == "svymean", .svymean_confint_wrapper, .svyquantile_confint_wrapper),
@@ -73,9 +78,6 @@ ard_continuous_ci.survey.design <- function(data,
 }
 
 .calculate_ard_continuous_survey_ci <- function(FUN, data, variables, by, conf.level, ...) {
-  # return empty data frame if no variables to process -------------------------
-  if (is_empty(variables)) return(dplyr::tibble()) # styler: off
-
   # calculate results ----------------------------------------------------------
   map(
     variables,
@@ -143,8 +145,8 @@ ard_continuous_ci.survey.design <- function(data,
       stat_label = .data$stat_name,
       fmt_fn = map(.data$stat, ~ case_switch(is.numeric(.x) ~ 2L, .default = as.character))
     ) |>
-    cards::tidy_ard_column_order() %>%
-    structure(., class = c("card", class(.)))
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }
 
 .svymean_confint_wrapper <- function(data, variable, conf.level, df, ...) {

R/ard_dichotomous.survey.design.R

@@ -46,9 +46,9 @@ ard_dichotomous.survey.design <- function(data,
   )
   .check_dichotomous_value(data$variables, value)
 
-  # return empty tibble if no variables selected -------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # calculate summary statistics -----------------------------------------------

R/ard_effectsize_cohens_d.R

@@ -63,9 +63,10 @@ ard_effectsize_cohens_d <- function(data, by, variables, conf.level = 0.95, ...)
   cards::process_selectors(data, by = {{ by }}, variables = {{ variables }})
   check_scalar(by)
   check_range(conf.level, range = c(0, 1))
-  # if no variables selected, return empty tibble ------------------------------
+
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # build ARD ------------------------------------------------------------------
@@ -116,9 +117,9 @@ ard_effectsize_paired_cohens_d <- function(data, by, variables, id, conf.level =
   check_scalar(id)
   check_range(conf.level, range = c(0, 1))
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # build ARD ------------------------------------------------------------------
@@ -206,5 +207,6 @@ ard_effectsize_paired_cohens_d <- function(data, by, variables, id, conf.level =
       by = "stat_name"
     ) |>
     dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::as_card() |>
     cards::tidy_ard_column_order()
 }

R/ard_effectsize_hedges_g.R

@@ -63,9 +63,9 @@ ard_effectsize_hedges_g <- function(data, by, variables, conf.level = 0.95, ...)
   check_scalar(by)
   check_range(conf.level, range = c(0, 1))
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # build ARD ------------------------------------------------------------------
@@ -115,12 +115,12 @@ ard_effectsize_paired_hedges_g <- function(data, by, variables, id, conf.level =
   check_scalar(id)
   check_range(conf.level, range = c(0, 1))
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
-  # build ARD ------------------------------------------------------------------
 
+  # build ARD ------------------------------------------------------------------
   lapply(
     variables,
     function(variable) {
@@ -190,5 +190,6 @@ ard_effectsize_paired_hedges_g <- function(data, by, variables, id, conf.level =
       by = "stat_name"
     ) |>
     dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::as_card() |>
     cards::tidy_ard_column_order()
 }

R/ard_emmeans_mean_difference.R

@@ -129,6 +129,6 @@ ard_emmeans_mean_difference <- function(data, formula, method,
       error = list(NULL),
       fmt_fn = map(.data$stat, \(.x) if (is.numeric(.x)) 1L else NULL) # styler: off
     ) |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_missing.survey.design.R

@@ -47,6 +47,11 @@ ard_missing.survey.design <- function(data,
     by = {{ by }}
   )
 
+  # return empty ARD if no variables selected ----------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble() |> cards::as_card())
+  }
+
   # convert all variables to T/F whether it's missing --------------------------
   data$variables <- data$variables |>
     dplyr::mutate(across(all_of(variables), Negate(is.na)))
@@ -126,6 +131,6 @@ ard_missing.survey.design <- function(data,
   # return final object --------------------------------------------------------
   result |>
     dplyr::mutate(context = "missing") |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_smd_smd.R

@@ -44,7 +44,6 @@ ard_smd_smd <- function(data, by, variables, std.error = TRUE, conf.level = 0.95
     data <- design$variables
   }
 
-
   # continue check/process inputs ----------------------------------------------
   check_data_frame(data)
   data <- dplyr::ungroup(data)
@@ -53,9 +52,9 @@ ard_smd_smd <- function(data, by, variables, std.error = TRUE, conf.level = 0.95
   # This check can be relaxed, but would require some changes to handle multi-row outputs
   check_n_levels(data[[by]], 2L, message = "The {.arg by} column must have {.val {length}} levels.")
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
 
   # build ARD ------------------------------------------------------------------
@@ -120,5 +119,6 @@ ard_smd_smd <- function(data, by, variables, std.error = TRUE, conf.level = 0.95
       by = "stat_name"
     ) |>
     dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |>
+    cards::as_card() |>
     cards::tidy_ard_column_order()
 }

R/ard_stats_anova.R

@@ -199,6 +199,6 @@ ard_stats_anova.data.frame <- function(x,
           .default = .data$stat_name
         )
     ) |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_stats_aov.R

@@ -53,6 +53,6 @@ ard_stats_aov <- function(formula, data, ...) {
       warning = aov["warning"],
       error = aov["error"]
     ) |>
-    cards::tidy_ard_column_order() %>%
-    {structure(., class = c("card", class(.)))} # styler: off
+    cards::as_card() |>
+    cards::tidy_ard_column_order()
 }

R/ard_stats_chisq_test.R

@@ -34,10 +34,11 @@ ard_stats_chisq_test <- function(data, by, variables, ...) {
   cards::process_selectors(data, by = {{ by }}, variables = {{ variables }})
   check_scalar(by)
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
+
   # build ARD ------------------------------------------------------------------
   lapply(
     variables,
@@ -67,5 +68,6 @@ ard_stats_chisq_test <- function(data, by, variables, ...) {
         )
     }
   ) |>
-    dplyr::bind_rows()
+    dplyr::bind_rows() |>
+    cards::as_card()
 }

R/ard_stats_fisher_test.R

@@ -37,10 +37,11 @@ ard_stats_fisher_test <- function(data, by, variables, conf.level = 0.95, ...) {
   check_scalar(by)
   check_range(conf.level, range = c(0, 1))
 
-  # if no variables selected, return empty tibble ------------------------------
+  # return empty ARD if no variables selected ----------------------------------
   if (is_empty(variables)) {
-    return(dplyr::tibble())
+    return(dplyr::tibble() |> cards::as_card())
   }
+
   # build ARD ------------------------------------------------------------------
   lapply(
     variables,
@@ -72,5 +73,6 @@ ard_stats_fisher_test <- function(data, by, variables, conf.level = 0.95, ...) {
         )
     }
   ) |>
-    dplyr::bind_rows()
+    dplyr::bind_rows() |>
+    cards::as_card()
 }