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_hedges_g and ard_paired_hedges_g #88

Merged
merged 2 commits into from
Mar 15, 2024
Merged

update ard_hedges_g and ard_paired_hedges_g #88

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
c68f10b
update `ard_hedges_g` function to accept multiple variables
ayogasekaram Mar 14, 2024
7789af4
update docs
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
94 changes: 58 additions & 36 deletions R/ard_hedges_g.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 variable. 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::hedges_g(...)`
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_hedges_g(by = ARM, variable = AGE)
#' ard_hedges_g(by = ARM, variables = AGE)
#'
#' # constructing a paired data set,
#' # where patients receive both treatments
Expand All @@ -40,71 +41,92 @@
#' dplyr::arrange(USUBJID, ARM) |>
#' dplyr::group_by(USUBJID) |>
#' dplyr::filter(dplyr::n() > 1) |>
#' ard_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID)
#' ard_paired_hedges_g(by = ARM, variables = AGE, id = USUBJID)
NULL

#' @rdname ard_hedges_g
#' @export
ard_hedges_g <- function(data, by, variable, ...) {
ard_hedges_g <- 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(variables)
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_hedges_g_results(
by = by,
variable = variable,
lst_tidy =
cards::eval_capture_conditions(
effectsize::hedges_g(data[[variable]] ~ data[[by]], paired = FALSE, ...) |>
parameters::standardize_names(style = "broom")
),
paired = FALSE,
...
)
lapply(
variables,
function(variable) {
.format_hedges_g_results(
by = by,
variable = variable,
lst_tidy =
cards::eval_capture_conditions(
effectsize::hedges_g(data[[variable]] ~ data[[by]], paired = FALSE, ...) |>
parameters::standardize_names(style = "broom")
),
paired = FALSE,
...
)
}
) |>
dplyr::bind_rows()
}

#' @rdname ard_hedges_g
#' @export
ard_paired_hedges_g <- function(data, by, variable, id, ...) {
ard_paired_hedges_g <- 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_hedges_g_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::hedges_g(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ...) |>
parameters::standardize_names(style = "broom")
}),
paired = TRUE,
...
)

lapply(
variables,
function(variable) {
.format_hedges_g_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::hedges_g(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ...) |>
parameters::standardize_names(style = "broom")
}),
paired = TRUE,
...
)
}
) |>
dplyr::bind_rows()
}

#' Convert Hedge's G Test to ARD
Expand Down
13 changes: 7 additions & 6 deletions man/ard_hedges_g.Rd
View file
Open in desktop

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

15 changes: 15 additions & 0 deletions tests/testthat/_snaps/ard_hedges_g.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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_hedges_g(
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 hedges_g Effect Size Estimate -0.4347006
2 ARM BMIBL hedges_g CI Confidence Level 0.95
3 ARM BMIBL hedges_g CI Lower Bound -0.7369717
4 ARM HEIGHTBL hedges_g Effect Size Estimate -0.2977188
5 ARM HEIGHTBL hedges_g CI Confidence Level 0.95
6 ARM HEIGHTBL hedges_g CI Lower Bound -0.5982873

# ard_paired_hedges_g() works

Code
Expand Down
11 changes: 11 additions & 0 deletions tests/testthat/test-ard_hedges_g.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,17 @@ test_that("ard_hedges_g() works", {
dplyr::select(c("variable", "stat_name", "error")) |>
as.data.frame()
)

# test that the function works with multiple variables as once
expect_snapshot(
cards::ADSL |>
dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |>
ard_hedges_g(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_hedges_g() works", {
Expand Down
Loading