Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

update ard_cohens_d function to accept multiple variables #87

Merged
merged 2 commits into from
Mar 15, 2024
Merged

update ard_cohens_d function to accept multiple variables #87

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
a8afc0f
update cohen's d function to accept multiple variables
ayogasekaram Mar 14, 2024
e7493c8
fix style
ayogasekaram Mar 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
95 changes: 58 additions & 37 deletions R/ard_cohens_d.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(...)`
Expand All @@ -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
Expand All @@ -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() {
Expand Down
13 changes: 7 additions & 6 deletions man/ard_cohens_d.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 16 additions & 1 deletion tests/testthat/_snaps/ard_cohens_d.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand Down
15 changes: 13 additions & 2 deletions tests/testthat/test-ard_cohens_d.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
)

Expand All @@ -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", {
Expand Down
Loading