From a8afc0f8cb1f1281c7b58c4f6371d2955400bb42 Mon Sep 17 00:00:00 2001 From: ayogasekaram Date: Thu, 14 Mar 2024 17:02:48 +0000 Subject: [PATCH] update cohen's d function to accept multiple variables --- R/ard_cohens_d.R | 67 ++++++++++++++++++--------- man/ard_cohens_d.Rd | 13 +++--- tests/testthat/_snaps/ard_cohens_d.md | 17 ++++++- tests/testthat/test-ard_cohens_d.R | 17 ++++++- 4 files changed, 82 insertions(+), 32 deletions(-) diff --git a/R/ard_cohens_d.R b/R/ard_cohens_d.R index ee0e988e0..88248860c 100644 --- a/R/ard_cohens_d.R +++ b/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() { diff --git a/man/ard_cohens_d.Rd b/man/ard_cohens_d.Rd index 3308e27fd..f133e8ea5 100644 --- a/man/ard_cohens_d.Rd +++ b/man/ard_cohens_d.Rd @@ -5,9 +5,9 @@ \alias{ard_paired_cohens_d} \title{ARD Cohen's D Test} \usage{ -ard_cohens_d(data, by, variable, ...) +ard_cohens_d(data, by, variables, ...) -ard_paired_cohens_d(data, by, variable, id, ...) +ard_paired_cohens_d(data, by, variables, id, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -16,8 +16,9 @@ a data frame. See below for details.} \item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr column name to compare by. Must be a categorical variable with exactly two levels.} -\item{variable}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -column name to be compared. Must be a continuous variable.} +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be compared. Must be a continuous variables. +Independent tests will be run for each variable.} \item{...}{arguments passed to \code{effectsize::cohens_d(...)}} @@ -45,7 +46,7 @@ The data are then passed as \dontshow{if (cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 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 @@ -55,6 +56,6 @@ cards::ADSL[c("ARM", "AGE")] |> 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) \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/ard_cohens_d.md b/tests/testthat/_snaps/ard_cohens_d.md index fd6432a12..0ed76a472 100644 --- a/tests/testthat/_snaps/ard_cohens_d.md +++ b/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 diff --git a/tests/testthat/test-ard_cohens_d.R b/tests/testthat/test-ard_cohens_d.R index fd69341dd..0a8fc361a 100644 --- a/tests/testthat/test-ard_cohens_d.R +++ b/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() ) }) + +