Svy ard categorical unit tests

R/ard_categorical.survey.design.R

@@ -97,6 +97,11 @@ 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,
@@ -105,7 +110,8 @@ ard_categorical.survey.design <- function(data,
         cli::cli_abort(
           c("Column {.val {.x}} is all missing and cannot be tabulated.",
             i = "Only columns of class {.cls logical} and {.cls factor} can be tabulated when all values are missing."
-          )
+          ),
+          call = get_cli_abort_call()
         )
       }
     }
@@ -207,6 +213,21 @@ check_na_factor_levels <- function(data, variables) {
 
 # this function returns a tibble with the SE(p) and DEFF
 .svytable_rate_stats <- function(data, variables, by, denominator, deff) {
+  if (!is_empty(by)) by_lvls <- .unique_values_sort(data$variables, by) # styler: off
+  if (!is_empty(by) && length(by_lvls) == 1L) {
+    data$variables[[by]] <-
+      case_switch(
+        inherits(data$variables[[by]], "factor") ~ fct_expand(data$variables[[by]], paste("not", by_lvls)),
+        .default = factor(data$variables[[by]], levels = c(by_lvls, paste("not", by_lvls)))
+      )
+  }
+  if (!is_empty(by) && inherits(data$variables[[by]], "logical")) {
+    data$variables[[by]] <- factor(data$variables[[by]], levels = c(TRUE, FALSE))
+  }
+  if (!is_empty(by) && !inherits(data$variables[[by]], "factor")) {
+    data$variables[[by]] <- factor(data$variables[[by]])
+  }
+
   lapply(
     variables,
     \(variable) {
@@ -217,20 +238,18 @@ check_na_factor_levels <- function(data, variables) {
 
       # there are issues with svymean() when a variable has only one level. adding a second as needed
       variable_lvls <- .unique_values_sort(data$variables, variable)
-      if (!is_empty(by)) by_lvls <- .unique_values_sort(data$variables, by) # styler: off
       if (length(variable_lvls) == 1L) {
         data$variables[[variable]] <-
           case_switch(
-            inherits(data$variables[[by]], "factor") ~ fct_expand(data$variables[[variable]], paste("not", variable_lvls)),
+            inherits(data$variables[[variable]], "factor") ~ fct_expand(data$variables[[variable]], paste("not", variable_lvls)),
             .default = factor(data$variables[[variable]], levels = c(variable_lvls, paste("not", variable_lvls)))
           )
       }
-      if (!is_empty(by) && length(by_lvls) == 1L) {
-        data$variables[[by]] <-
-          case_switch(
-            inherits(data$variables[[by]], "factor") ~ fct_expand(data$variables[[by]], paste("not", by_lvls)),
-            .default = factor(data$variables[[by]], levels = c(by_lvls, paste("not", by_lvls)))
-          )
+      if (inherits(data$variables[[variable]], "logical")) {
+        data$variables[[variable]] <- factor(data$variables[[variable]], levels = c(TRUE, FALSE))
+      }
+      if (!inherits(data$variables[[variable]], "factor")) {
+        data$variables[[variable]] <- factor(data$variables[[variable]])
       }
 
       # each combination of denominator and whether there is a by variable is handled separately
@@ -409,21 +428,21 @@ check_na_factor_levels <- function(data, variables) {
     "column" =
       df_counts |>
         dplyr::mutate(
-          .by = any_of("group1_level"),
+          .by = c(cards::all_ard_groups(), cards::all_ard_variables("names")),
           N = sum(.data$n),
           p = .data$n / .data$N
         ),
     "row" =
       df_counts |>
         dplyr::mutate(
-          .by = any_of("variable_level"),
+          .by = cards::all_ard_variables(),
           N = sum(.data$n),
           p = .data$n / .data$N
         ),
     "cell" =
       df_counts |>
         dplyr::mutate(
-          .by = any_of(c("group1_level", "variable_level")),
+          .by = c(cards::all_ard_groups("names"), cards::all_ard_variables("names")),
           N = sum(.data$n),
           p = .data$n / .data$N
         )

R/ard_continuous.survey.design.R

@@ -76,11 +76,16 @@ ard_continuous.survey.design <- function(data, variables, by = NULL,
   cards::check_list_elements(
     x = statistic,
     predicate = \(x) all(x %in% accepted_svy_stats()),
-    error_msg = c("Error in the values of the {.arg statistic} argument.",
-      i = "Values must be in {.val {accepted_svy_stats(FALSE)}}"
+    error_msg = c("Error in the values of the {.arg statistic} argument for variable {.val {variable}}.",
+      i = "Values must be in {.val {cardx:::accepted_svy_stats(FALSE)}}"
     )
   )
 
+  # return empty tibble if no variables selected -------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble())
+  }
+
   # compute the weighted statistics --------------------------------------------
   df_stats <-
     map(
@@ -117,7 +122,7 @@ ard_continuous.survey.design <- function(data, variables, by = NULL,
             unlist())
         ) |>
           tidyr::unnest(cols = c("stat_name", "stat_label")),
-        by = "stat_name",
+        by = c("variable", "stat_name"),
         unmatched = "ignore"
       )
   }
@@ -134,7 +139,7 @@ ard_continuous.survey.design <- function(data, variables, by = NULL,
           fmt_fn = map(.data$variable, ~ fmt_fn[[.x]] |> unname())
         ) |>
           tidyr::unnest(cols = c("stat_name", "fmt_fn")),
-        by = "stat_name",
+        by = c("variable", "stat_name"),
         unmatched = "ignore"
       )
   }
@@ -306,5 +311,11 @@ accepted_svy_stats <- function(expand_quantiles = TRUE) {
   }
 
   df_stat |>
-    dplyr::mutate(stat_name = .env$stat_name)
+    dplyr::mutate(
+      stat_name = .env$stat_name,
+      across(
+        c(cards::all_ard_groups("levels"), cards::all_ard_variables("levels")),
+        ~ map(.x, as.character)
+      )
+    )
 }

R/ard_dichotomous.survey.design.R

@@ -22,8 +22,12 @@ ard_dichotomous.survey.design <- function(data,
                                           denominator = c("column", "row", "cell"),
                                           fmt_fn = NULL,
                                           stat_label = everything() ~ list(
-                                            p = "%", p.std.error = "SE(%)", deff = "Design Effect",
-                                            "n" = "Unweighted n", "N" = "Unweighted N", "p" = "Unweighted %"
+                                            p = "%",
+                                            p.std.error = "SE(%)",
+                                            deff = "Design Effect",
+                                            "n_unweighted" = "Unweighted n",
+                                            "N_unweighted" = "Unweighted N",
+                                            "p_unweighted" = "Unweighted %"
                                           ),
                                           ...) {
   set_cli_abort_call()

R/ard_missing.survey.design.R

@@ -59,11 +59,11 @@ ard_missing.survey.design <- function(data,
   )
   cards::fill_formula_selectors(
     data$variables[variables],
-    statistic = formals(asNamespace("cards")[["ard_missing.survey.design"]])[["statistic"]] |> eval()
+    statistic = formals(asNamespace("cardx")[["ard_missing.survey.design"]])[["statistic"]] |> eval()
   )
   cards::fill_formula_selectors(
     data$variables[variables],
-    stat_label = formals(asNamespace("cards")[["ard_missing.survey.design"]])[["stat_label"]] |> eval()
+    stat_label = formals(asNamespace("cardx")[["ard_missing.survey.design"]])[["stat_label"]] |> eval()
   )
 
   stats_available <- c(
@@ -104,7 +104,7 @@ ard_missing.survey.design <- function(data,
         )
     ) |>
     dplyr::select(-cards::all_ard_variables("levels"), -"stat_label", -"fmt_fn") |>
-    dplyr::slice(1L, .by = "stat_name")
+    dplyr::slice(1L, .by = c(cards::all_ard_groups(), cards::all_ard_variables(), "stat_name"))
 
   # final processing of fmt_fn -------------------------------------------------
   result <- result |>

tests/testthat/_snaps/ard_categorical.survey.design.md

@@ -0,0 +1,30 @@
+# ard_categorical.survey.design() returns an error when variables have all NAs
+
+    Code
+      ard_categorical(svy_titanic, variables = c(Class, Age), by = Survived,
+      denominator = "row")
+    Condition
+      Error in `ard_categorical()`:
+      ! Column "Class" is all missing and cannot be tabulated.
+      i Only columns of class <logical> and <factor> can be tabulated when all values are missing.
+
+---
+
+    Code
+      ard_categorical(svy_titanic, variables = c(Class, Age), by = Survived,
+      denominator = "column")
+    Condition
+      Error in `ard_categorical()`:
+      ! Column "Class" is all missing and cannot be tabulated.
+      i Only columns of class <logical> and <factor> can be tabulated when all values are missing.
+
+---
+
+    Code
+      ard_categorical(svy_titanic, variables = c(Class, Age), by = Survived,
+      denominator = "cell")
+    Condition
+      Error in `ard_categorical()`:
+      ! Column "Class" is all missing and cannot be tabulated.
+      i Only columns of class <logical> and <factor> can be tabulated when all values are missing.
+

tests/testthat/_snaps/ard_continuous.survey.design.md

@@ -22,33 +22,34 @@
 # ard_continuous.survey.design(fmt_fn)
 
     Code
-      ard_continuous(dclus1, variables = api00, statistic = ~ c("mean", "median",
-        "min", "max"), fmt_fn = list(api00 = list(mean = 2, median = "xx.xx", min = as.character)))
-    Message
-      {cards} data frame: 4 x 8
+      as.data.frame(dplyr::select(ard_continuous(dclus1, variables = c(api99, api00),
+      statistic = ~ c("mean", "median", "min", "max"), fmt_fn = list(api00 = list(
+        mean = 2, median = "xx.xx", min = as.character))), -warning, -error))
     Output
-        variable   context stat_name stat_label    stat fmt_fn
-      1    api00 continuo…      mean       Mean 644.169      2
-      2    api00 continuo…    median     Median     652  xx.xx
-      3    api00 continuo…       min    Minimum     411   <fn>
-      4    api00 continuo…       max    Maximum     905      1
-    Message
-      i 2 more variables: warning, error
+        variable    context stat_name stat_label     stat                     fmt_fn
+      1    api99 continuous      mean       Mean 606.9781                          1
+      2    api99 continuous    median     Median      615                          1
+      3    api99 continuous       min    Minimum      365                          1
+      4    api99 continuous       max    Maximum      890                          1
+      5    api00 continuous      mean       Mean 644.1694                          2
+      6    api00 continuous    median     Median      652                      xx.xx
+      7    api00 continuous       min    Minimum      411 .Primitive("as.character")
+      8    api00 continuous       max    Maximum      905                          1
 
 # ard_continuous.survey.design(stat_label)
 
     Code
-      ard_continuous(dclus1, variables = api00, statistic = ~ c("mean", "median",
-        "min", "max"), stat_label = list(api00 = list(mean = "MeAn", median = "MEDian",
-        min = "MINimum")))
-    Message
-      {cards} data frame: 4 x 8
+      as.data.frame(ard_continuous(dclus1, variables = c(api00, api99), statistic = ~
+      c("mean", "median", "min", "max"), stat_label = list(api00 = list(mean = "MeAn",
+        median = "MEDian", min = "MINimum"))))
     Output
-        variable   context stat_name stat_label    stat fmt_fn
-      1    api00 continuo…      mean       MeAn 644.169      1
-      2    api00 continuo…    median     MEDian     652      1
-      3    api00 continuo…       min    MINimum     411      1
-      4    api00 continuo…       max    Maximum     905      1
-    Message
-      i 2 more variables: warning, error
+        variable    context stat_name stat_label     stat fmt_fn warning error
+      1    api00 continuous      mean       MeAn 644.1694      1    NULL  NULL
+      2    api00 continuous    median     MEDian      652      1    NULL  NULL
+      3    api00 continuous       min    MINimum      411      1    NULL  NULL
+      4    api00 continuous       max    Maximum      905      1    NULL  NULL
+      5    api99 continuous      mean       Mean 606.9781      1    NULL  NULL
+      6    api99 continuous    median     Median      615      1    NULL  NULL
+      7    api99 continuous       min    Minimum      365      1    NULL  NULL
+      8    api99 continuous       max    Maximum      890      1    NULL  NULL
 

tests/testthat/_snaps/ard_dichotomous.survey.design.md

@@ -0,0 +1,30 @@
+# ard_dichotomous.survey.design() returns an error with erroneous input
+
+    Code
+      ard_dichotomous(svy_dicho, by = vs, variables = c(cyl, am), value = list(cyl = 4),
+      denominator = "row")
+    Condition
+      Error in `ard_dichotomous()`:
+      ! Error in argument `value` for variable "cyl".
+      i A value of 4 was passed, but must be one of TRUE and FALSE.
+
+---
+
+    Code
+      ard_dichotomous(svy_dicho, by = cyl, variables = c(vs, am), value = list(vs = 4),
+      denominator = "row")
+    Condition
+      Error in `ard_dichotomous()`:
+      ! Error in argument `value` for variable "vs".
+      i A value of 4 was passed, but must be one of 0 and 1.
+
+---
+
+    Code
+      ard_dichotomous(svy_dicho, by = cyl, variables = c(vs, disp), value = list(
+        disp = "turn"), denominator = "row")
+    Condition
+      Error in `ard_dichotomous()`:
+      ! Error in argument `value` for variable "disp".
+      i A value of "turn" was passed, but must be one of 71.1, 75.7, 78.7, 79, 95.1, 108, 120.1, 120.3, 121, 140.8, 145, 146.7, 160, 167.6, 225, 258, 275.8, 301, ..., 460, and 472.
+