update cohen's d function to accept multiple variables

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,59 +41,76 @@
 #'   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 ------------------------------------------------------------------
+  lapply(
+    variables,
+    function(variable) {
   .format_cohens_d_results(
     by = by,
     variable = variable,
@@ -107,6 +125,9 @@ ard_paired_cohens_d <- function(data, by, variable, id, ...) {
     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", {
@@ -79,3 +90,5 @@ test_that("ard_paired_cohens_d() works", {
       as.data.frame()
   )
 })
+
+