update ard_cohens_d function to accept multiple variables (#87)

**What changes are proposed in this pull request?**
update `ard_cohens_d` and `ard_paired_cohens_d` functions to accept
multiple variables

closes #85 


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

Pre-review Checklist (if item does not apply, mark is as complete)
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] PR branch has pulled the most recent updates from master branch:
`usethis::pr_merge_main()`
- [ ] If a bug was fixed, a unit test was added.
- [ ] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`
- [ ] Request a reviewer

Reviewer Checklist (if item does not apply, mark is as complete)

- [ ] If a bug was fixed, a unit test was added.
- [ ] Run `pkgdown::build_site()`. Check the R console for errors, and
review the rendered website.
- [ ] 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 "`# cards (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".

R/ard_cohens_d.R

@@ -8,8 +8,9 @@
 #'   a data frame. See below for details.
 #' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
 #'   column name to compare by. Must be a categorical variable with exactly two levels.
-#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
-#'   column name to be compared. Must be a continuous variable.
+#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
+#'   column names to be compared. Must be a continuous variables.
+#'   Independent tests will be run for each variable.
 #' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
 #'   column name of the subject or participant ID
 #' @param ... arguments passed to `effectsize::cohens_d(...)`
@@ -30,7 +31,7 @@
 #' @examplesIf cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
 #' cards::ADSL |>
 #'   dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
-#'   ard_cohens_d(by = ARM, variable = AGE)
+#'   ard_cohens_d(by = ARM, variables = AGE)
 #'
 #' # constructing a paired data set,
 #' # where patients receive both treatments
@@ -40,73 +41,93 @@
 #'   dplyr::arrange(USUBJID, ARM) |>
 #'   dplyr::group_by(USUBJID) |>
 #'   dplyr::filter(dplyr::n() > 1) |>
-#'   ard_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID)
+#'   ard_paired_cohens_d(by = ARM, variables = AGE, id = USUBJID)
 NULL
 
 #' @rdname ard_cohens_d
 #' @export
-ard_cohens_d <- function(data, by, variable, ...) {
+ard_cohens_d <- function(data, by, variables, ...) {
   # check installed packages ---------------------------------------------------
   cards::check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")
 
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)
-  check_not_missing(variable)
+  check_not_missing(variables)
   check_not_missing(by)
   check_data_frame(data)
   data <- dplyr::ungroup(data)
-  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }})
+  cards::process_selectors(data, by = {{ by }}, variables = {{ variables }})
   check_scalar(by)
-  check_scalar(variable)
+
+  # if no variables selected, return empty tibble ------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble())
+  }
 
   # build ARD ------------------------------------------------------------------
-  .format_cohens_d_results(
-    by = by,
-    variable = variable,
-    lst_tidy =
-      cards::eval_capture_conditions(
-        effectsize::cohens_d(data[[variable]] ~ data[[by]], data = data, paired = FALSE, ...) |>
-          parameters::standardize_names(style = "broom")
-      ),
-    paired = FALSE,
-    ...
-  )
+  lapply(
+    variables,
+    function(variable) {
+      .format_cohens_d_results(
+        by = by,
+        variable = variable,
+        lst_tidy =
+          cards::eval_capture_conditions(
+            effectsize::cohens_d(data[[variable]] ~ data[[by]], data = data, paired = FALSE, ...) |>
+              parameters::standardize_names(style = "broom")
+          ),
+        paired = FALSE,
+        ...
+      )
+    }
+  ) |>
+    dplyr::bind_rows()
 }
 
 
 #' @rdname ard_cohens_d
 #' @export
-ard_paired_cohens_d <- function(data, by, variable, id, ...) {
+ard_paired_cohens_d <- function(data, by, variables, id, ...) {
   # check installed packages ---------------------------------------------------
   cards::check_pkg_installed("effectsize", reference_pkg = "cardx")
   cards::check_pkg_installed("parameters", reference_pkg = "cardx")
   # check/process inputs -------------------------------------------------------
   check_not_missing(data)
-  check_not_missing(variable)
+  check_not_missing(variables)
   check_not_missing(by)
   check_not_missing(id)
   check_data_frame(data)
   data <- dplyr::ungroup(data)
-  cards::process_selectors(data, by = {{ by }}, variable = {{ variable }}, id = {{ id }})
+  cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}, id = {{ id }})
   check_scalar(by)
-  check_scalar(variable)
   check_scalar(id)
 
+  # if no variables selected, return empty tibble ------------------------------
+  if (is_empty(variables)) {
+    return(dplyr::tibble())
+  }
+
   # build ARD ------------------------------------------------------------------
-  .format_cohens_d_results(
-    by = by,
-    variable = variable,
-    lst_tidy =
-      cards::eval_capture_conditions({
-        # adding this reshape inside the eval, so if there is an error it's captured in the ARD object
-        data_wide <- .paired_data_pivot_wider(data, by = by, variable = variable, id = id)
-        # perform paired cohen's d test
-        effectsize::cohens_d(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ...) |>
-          parameters::standardize_names(style = "broom")
-      }),
-    paired = TRUE,
-    ...
-  )
+  lapply(
+    variables,
+    function(variable) {
+      .format_cohens_d_results(
+        by = by,
+        variable = variable,
+        lst_tidy =
+          cards::eval_capture_conditions({
+            # adding this reshape inside the eval, so if there is an error it's captured in the ARD object
+            data_wide <- .paired_data_pivot_wider(data, by = by, variable = variable, id = id)
+            # perform paired cohen's d test
+            effectsize::cohens_d(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ...) |>
+              parameters::standardize_names(style = "broom")
+          }),
+        paired = TRUE,
+        ...
+      )
+    }
+  ) |>
+    dplyr::bind_rows()
 }
 
 .df_effectsize_stat_labels <- function() {

tests/testthat/_snaps/ard_cohens_d.md

@@ -1,7 +1,7 @@
 # ard_cohens_d() works
 
     Code
-      as.data.frame(dplyr::select(ard_cohens_d(cards::ADSL, by = ARM, variable = AGE),
+      as.data.frame(dplyr::select(ard_cohens_d(cards::ADSL, by = ARM, variables = AGE),
       c("variable", "stat_name", "error")))
     Output
         variable   stat_name                                           error
@@ -14,6 +14,21 @@
       7      AGE   pooled_sd Grouping variable y must have exactly 2 levels.
       8      AGE alternative Grouping variable y must have exactly 2 levels.
 
+---
+
+    Code
+      as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select(ard_cohens_d(
+        dplyr::filter(cards::ADSL, ARM %in% c("Placebo", "Xanomeline High Dose")),
+        by = ARM, variables = c(BMIBL, HEIGHTBL)), c(1:3, 5:6)), variable), n = 3))
+    Output
+        group1 variable  context           stat_label       stat
+      1    ARM    BMIBL cohens_d Effect Size Estimate -0.4366533
+      2    ARM    BMIBL cohens_d  CI Confidence Level       0.95
+      3    ARM    BMIBL cohens_d       CI Lower Bound -0.7402823
+      4    ARM HEIGHTBL cohens_d Effect Size Estimate -0.2990562
+      5    ARM HEIGHTBL cohens_d  CI Confidence Level       0.95
+      6    ARM HEIGHTBL cohens_d       CI Lower Bound -0.6009749
+
 # ard_paired_cohens_d() works
 
     Code

tests/testthat/test-ard_cohens_d.R

@@ -5,7 +5,7 @@ test_that("ard_cohens_d() works", {
     ard_cohens_d <-
       cards::ADSL |>
       dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
-      ard_cohens_d(by = ARM, variable = AGE, pooled_sd = FALSE),
+      ard_cohens_d(by = ARM, variables = AGE, pooled_sd = FALSE),
     NA
   )
 
@@ -25,10 +25,21 @@ test_that("ard_cohens_d() works", {
   # errors are properly handled
   expect_snapshot(
     cards::ADSL |>
-      ard_cohens_d(by = ARM, variable = AGE) |>
+      ard_cohens_d(by = ARM, variables = AGE) |>
       dplyr::select(c("variable", "stat_name", "error")) |>
       as.data.frame()
   )
+
+  # test that the function works with multiple variables
+  expect_snapshot(
+    cards::ADSL |>
+      dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
+      ard_cohens_d(by = ARM, variables = c(BMIBL, HEIGHTBL)) |>
+      dplyr::select(c(1:3, 5:6)) |>
+      dplyr::group_by(variable) |>
+      dplyr::slice_head(n = 3) |>
+      as.data.frame()
+  )
 })
 
 test_that("ard_paired_cohens_d() works", {