Adding ard_total_n.survey.design() S3 method (#199)

**What changes are proposed in this pull request?**
* Bug fix in `ard_categorical.survey.design()` where all unweighted
statistics were returned, even in the case where they were explicitly
not requested.

* Added S3 method `ard_total_n.survey.design()` which returns an ARD
with both the survey-weighted and unweighted total sample size.


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

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)

- [x] If a bug was fixed, a unit test was added.
- [x] 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 ✅
- [x] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

DESCRIPTION

@@ -19,7 +19,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
 Depends:
     R (>= 4.1)
 Imports:
-    cards (>= 0.2.0),
+    cards (>= 0.2.1.9003),
     cli (>= 3.6.1),
     dplyr (>= 1.1.2),
     glue (>= 1.6.2),
@@ -30,7 +30,7 @@ Suggests:
     broom (>= 1.0.5),
     broom.helpers (>= 1.15.0),
     broom.mixed (>= 0.2.9),
-    car (>= 3.0-11),
+    car (>= 3.1-2),
     effectsize (>= 0.8.8),
     emmeans (>= 1.7.3),
     geepack (>= 1.3.2),
@@ -43,6 +43,7 @@ Suggests:
     survival (>= 3.6-4),
     testthat (>= 3.2.0),
     withr (>= 2.5.0)
+Remotes: insightsengineering/cards
 Config/Needs/website: insightsengineering/nesttemplate
 Config/testthat/edition: 3
 Config/testthat/parallel: true

NAMESPACE

@@ -12,6 +12,7 @@ S3method(ard_missing,survey.design)
 S3method(ard_regression,default)
 S3method(ard_stats_anova,anova)
 S3method(ard_stats_anova,data.frame)
+S3method(ard_total_n,survey.design)
 S3method(construct_model,data.frame)
 S3method(construct_model,survey.design)
 export("%>%")
@@ -57,6 +58,7 @@ export(ard_survey_svyttest)
 export(ard_survival_survdiff)
 export(ard_survival_survfit)
 export(ard_survival_survfit_diff)
+export(ard_total_n)
 export(bt)
 export(bt_strip)
 export(construct_model)
@@ -83,6 +85,7 @@ importFrom(cards,ard_categorical)
 importFrom(cards,ard_continuous)
 importFrom(cards,ard_dichotomous)
 importFrom(cards,ard_missing)
+importFrom(cards,ard_total_n)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,across)
 importFrom(dplyr,all_of)

NEWS.md

@@ -1,5 +1,9 @@
 # cardx 0.2.0.9005
 
+* Bug fix in `ard_categorical.survey.design()` where all unweighted statistics were returned, even in the case where they were explicitly not requested.
+
+* Added S3 method `ard_total_n.survey.design()` which returns an ARD with both the survey-weighted and unweighted total sample size.
+
 # cardx 0.2.0
 
 ### Breaking Changes

R/add_total_n.survey.design.R

@@ -0,0 +1,33 @@
+#' ARD Total N
+#'
+#' Returns the total N for a survey object.
+#' The placeholder variable name returned in the object is `"..ard_total_n.."`
+#'
+#' @inheritParams ard_dichotomous.survey.design
+#' @inheritParams rlang::args_dots_empty
+#'
+#' @return an ARD data frame of class 'card'
+#' @export
+#'
+#' @examplesIf cardx:::is_pkg_installed("survey", reference_pkg = "cardx")
+#' svy_titanic <- survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq)
+#'
+#' ard_total_n(svy_titanic)
+ard_total_n.survey.design <- function(data, ...) {
+  # process inputs -------------------------------------------------------------
+  set_cli_abort_call()
+  check_dots_empty()
+
+  # calculate total N ----------------------------------------------------------
+  data$variables <-
+    data$variables |>
+    dplyr::mutate(..ard_total_n.. = TRUE)
+
+  data |>
+    ard_dichotomous(
+      variables = "..ard_total_n..",
+      statistic = list(..ard_total_n.. = c("N", "N_unweighted"))
+    ) |>
+    dplyr::mutate(context = "total_n") |>
+    dplyr::select(-cards::all_ard_variables("levels"))
+}

R/ard_categorical.survey.design.R

@@ -163,26 +163,33 @@ ard_categorical.survey.design <- function(data,
     )
 
   # add unweighted statistics --------------------------------------------------
-  cards_unweighted <-
-    ard_categorical(
-      data = data[["variables"]],
-      variables = all_of(variables),
-      by = any_of(by),
-      denominator = denominator
-    ) |>
-    # all the survey levels are reported as character, so we do the same here.
-    dplyr::mutate(
-      across(
-        c(cards::all_ard_groups("levels"), cards::all_ard_variables("levels")),
-        ~ map(.x, as.character)
+  statistic_unweighted <- statistic |>
+    lapply(\(x) keep(x, ~ endsWith(.x, "_unweighted")) |> str_remove("_unweighted$")) |>
+    compact()
+
+  if (!is_empty(statistic_unweighted)) {
+    cards_unweighted <-
+      ard_categorical(
+        data = data[["variables"]],
+        variables = all_of(names(statistic_unweighted)),
+        by = any_of(by),
+        statistic = statistic_unweighted,
+        denominator = denominator
+      ) |>
+      # all the survey levels are reported as character, so we do the same here.
+      dplyr::mutate(
+        across(
+          c(cards::all_ard_groups("levels"), cards::all_ard_variables("levels")),
+          ~ map(.x, as.character)
+        )
+      ) |>
+      dplyr::select(-c("stat_label", "fmt_fn", "warning", "error")) |>
+      dplyr::mutate(
+        stat_name =
+          dplyr::case_match(.data$stat_name, "n" ~ "n_unweighted", "N" ~ "N_unweighted", "p" ~ "p_unweighted")
       )
-    ) |>
-    dplyr::select(-c("stat_label", "fmt_fn", "warning", "error")) |>
-    dplyr::mutate(
-      stat_name =
-        dplyr::case_match(.data$stat_name, "n" ~ "n_unweighted", "N" ~ "N_unweighted", "p" ~ "p_unweighted")
-    )
-  cards <- cards |> dplyr::bind_rows(cards_unweighted) # styler: off
+    cards <- cards |> dplyr::bind_rows(cards_unweighted) # styler: off
+  }
 
   # final processing of fmt_fn -------------------------------------------------
   cards <- cards |>

R/reexports.R

@@ -19,6 +19,10 @@ cards::ard_missing
 #' @export
 cards::ard_attributes
 
+#' @importFrom cards ard_total_n
+#' @export
+cards::ard_total_n
+
 # dplyr ------------------------------------------------------------------------
 #' @export
 #' @importFrom dplyr %>%

_pkgdown.yml

@@ -69,6 +69,7 @@ reference:
       - ard_attributes.survey.design
       - ard_continuous_ci.survey.design
       - ard_categorical_ci.survey.design
+      - ard_total_n.survey.design
       - ard_survey_svychisq
       - ard_survey_svyranktest
       - ard_survey_svyttest

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

@@ -0,0 +1,14 @@
+# ard_total_n.survey.design() works
+
+    Code
+      ard_total_n(survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~
+      Freq))
+    Message
+      {cards} data frame: 2 x 8
+    Output
+               variable context    stat_name stat_label stat fmt_fn
+      1 ..ard_total_n.. total_n            N          N 2201   <fn>
+      2 ..ard_total_n.. total_n N_unweighted  Unweight…   32   <fn>
+    Message
+      i 2 more variables: warning, error
+

tests/testthat/test-ard_categorical.survey.design.R

@@ -1290,3 +1290,22 @@ test_that("ard_categorical.survey.design() works when using generic names ", {
     ard_categorical(svy_titanic2, variables = c(row, column), by = cell, denominator = "row") |> dplyr::select(stat)
   )
 })
+
+test_that("ard_categorical.survey.design(statistic) properly excluded unweighted stats not selected", {
+  svy_titanic <- survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq)
+
+  expect_equal(
+    ard_categorical(
+      svy_titanic,
+      variables = Sex,
+      statistic = ~ c("N", "N_unweighted")
+    ) |>
+      dplyr::select(variable, variable_level, stat_name, stat_label, stat),
+    ard_categorical(
+      svy_titanic,
+      variables = Sex
+    ) |>
+      dplyr::filter(stat_name %in% c("N", "N_unweighted")) |>
+      dplyr::select(variable, variable_level, stat_name, stat_label, stat)
+  )
+})

tests/testthat/test-ard_total_n.survey.design.R

@@ -0,0 +1,16 @@
+skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx"))
+
+test_that("ard_total_n.survey.design() works", {
+  expect_snapshot(
+    survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq) |>
+      ard_total_n()
+  )
+})
+
+test_that("ard_total_n.survey.design() follows ard structure", {
+  expect_silent(
+    survey::svydesign(~1, data = as.data.frame(Titanic), weights = ~Freq) |>
+      ard_total_n() |>
+      cards::check_ard_structure(method = FALSE)
+  )
+})