Skip to content

Commit

Permalink
Merge commit '3752d8a2194f596ea4db3a761d171ca5166ab54b'
Browse files Browse the repository at this point in the history
  • Loading branch information
ddsjoberg committed May 23, 2024
2 parents 30dc408 + 3752d8a commit b096f10
Show file tree
Hide file tree
Showing 42 changed files with 848 additions and 217 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: cardx
Title: Extra Analysis Results Data Utilities
Version: 0.1.0.9033
Version: 0.1.0.9045
Authors@R: c(
person("Daniel", "Sjoberg", , "[email protected]", role = c("aut", "cre")),
person("Abinaya", "Yogasekaram", , "[email protected]", role = "aut"),
Expand All @@ -18,7 +18,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues
Depends:
R (>= 4.1)
Imports:
cards (>= 0.1.0.9014),
cards (>= 0.1.0.9026),
cli (>= 3.6.1),
dplyr (>= 1.1.2),
glue (>= 1.6.2),
Expand All @@ -33,13 +33,13 @@ Suggests:
effectsize (>= 0.6.0),
emmeans (>= 1.7.3),
geepack (>= 1.3.2),
ggsurvfit (>= 1.0.0),
ggsurvfit (>= 1.1.0),
lme4 (>= 1.1-31),
parameters (>= 0.20.2),
smd (>= 0.6.6),
spelling,
survey (>= 4.1),
survival (>= 3.2-11),
survival (>= 3.6-4),
testthat (>= 3.2.0),
withr (>= 2.5.0)
Remotes:
Expand Down
15 changes: 14 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# Generated by roxygen2: do not edit by hand

S3method(ard_attributes,survey.design)
S3method(ard_continuous,survey.design)
S3method(ard_regression,default)
S3method(ard_stats_anova,anova)
S3method(ard_stats_anova,data.frame)
Expand All @@ -9,13 +11,18 @@ export("%>%")
export(all_of)
export(any_of)
export(ard_aod_wald_test)
export(ard_attributes)
export(ard_car_anova)
export(ard_car_vif)
export(ard_categorical)
export(ard_continuous)
export(ard_dichotomous)
export(ard_effectsize_cohens_d)
export(ard_effectsize_hedges_g)
export(ard_effectsize_paired_cohens_d)
export(ard_effectsize_paired_hedges_g)
export(ard_emmeans_mean_difference)
export(ard_missing)
export(ard_proportion_ci)
export(ard_regression)
export(ard_regression_basic)
Expand All @@ -33,9 +40,10 @@ export(ard_stats_paired_t_test)
export(ard_stats_paired_wilcox_test)
export(ard_stats_prop_test)
export(ard_stats_t_test)
export(ard_stats_t_test_onesample)
export(ard_stats_wilcox_test)
export(ard_stats_wilcox_test_onesample)
export(ard_survey_svychisq)
export(ard_survey_svycontinuous)
export(ard_survey_svyranktest)
export(ard_survey_svyttest)
export(ard_survival_survdiff)
Expand All @@ -61,6 +69,11 @@ export(reformulate2)
export(starts_with)
export(where)
import(rlang)
importFrom(cards,ard_attributes)
importFrom(cards,ard_categorical)
importFrom(cards,ard_continuous)
importFrom(cards,ard_dichotomous)
importFrom(cards,ard_missing)
importFrom(dplyr,"%>%")
importFrom(dplyr,across)
importFrom(dplyr,all_of)
Expand Down
7 changes: 5 additions & 2 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# cardx 0.1.0.9033
# cardx 0.1.0.9045

### Breaking Changes

Expand Down Expand Up @@ -30,12 +30,15 @@ ard_moodtest() -> ard_stats_mood_test()
- `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46)
- `ard_smd_smd()` for calculating standardized mean differences using `smd::smd()`. (#4)
- `ard_survival_survfit()` for survival analyses using `survival::survfit()`. (#43)
- `ard_survey_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68)
- `ard_continuous.survey.design()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68)
- `ard_attributes.survey.design()` for summarizing labels and attributes from weighted/survey data using many functions from the {survey} package.
- `ard_survey_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72)
- `ard_survey_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70)
- `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71)
- `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10)
- `ard_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34)
- `ard_stats_wilcox_test_onesample()` for calculating one-sample results.
- `ard_stats_t_test_onesample()` for calculating one-sample results.

* Updated functions `ard_stats_t_test()`, `ard_stats_paired_t_test()`, `ard_stats_wilcox_test()`, `ard_stats_paired_wilcox_test()`, `ard_stats_chisq_test()`, `ard_stats_fisher_test()`, `ard_stats_kruskal_test()`, `ard_stats_mcnemar_test()`, and `ard_stats_mood_test()` to accept multiple variables at once. Independent tests are calculated for each variable. The `variable` argument is renamed to `variables`. (#77)

Expand Down
37 changes: 37 additions & 0 deletions R/ard_attributes.survey.design.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
#' ARD Attributes
#'
#' @description
#' Add variable attributes to an ARD data frame.
#' - The `label` attribute will be added for all columns, and when no label
#' is specified and no label has been set for a column using the `label=` argument,
#' the column name will be placed in the label statistic.
#' - The `class` attribute will also be returned for all columns.
#' - Any other attribute returned by `attributes()` will also be added, e.g. factor levels.
#'
#' @rdname ard_attributes
#' @param data (`survey.design`)\cr
#' a design object often created with [`survey::svydesign()`].
#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
#' variables to include
#' @param label (named `list`)\cr
#' named list of variable labels, e.g. `list(cyl = "No. Cylinders")`.
#' Default is `NULL`
#' @inheritParams rlang::args_dots_empty
#'
#' @return an ARD data frame of class 'card'
#' @export
#'
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx"))
#' data(api, package = "survey")
#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
#'
#' ard_attributes(
#' data = dclus1,
#' variables = c(sname, dname),
#' label = list(sname = "School Name", dname = "District Name")
#' )
ard_attributes.survey.design <- function(data, variables = everything(), label = NULL, ...) {
set_cli_abort_call()

cards::ard_attributes(data = data[["variables"]], variables = {{ variables }}, label = label, ...)
}
4 changes: 2 additions & 2 deletions R/ard_car_anova.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
#' @return data frame
#' @export
#'
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car"), reference_pkg = "cardx"))
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car", "parameters"), reference_pkg = "cardx"))
#' lm(AGE ~ ARM, data = cards::ADSL) |>
#' ard_car_anova()
#'
Expand All @@ -18,7 +18,7 @@ ard_car_anova <- function(x, ...) {
set_cli_abort_call()

# check installed packages ---------------------------------------------------
check_pkg_installed(pkg = c("broom.helpers", "car"), reference_pkg = "cardx")
check_pkg_installed(pkg = c("broom.helpers", "car", "parameters"), reference_pkg = "cardx")

# check inputs ---------------------------------------------------------------
check_not_missing(x)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@
#' the list element is either a named list or a list of formulas defining the
#' statistic labels, e.g. `everything() ~ list(mean = "Mean", sd = "SD")` or
#' `everything() ~ list(mean ~ "Mean", sd ~ "SD")`.
#' @inheritParams rlang::args_dots_empty
#'
#' @section statistic argument:
#'
Expand All @@ -38,16 +39,18 @@
#' data(api, package = "survey")
#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
#'
#' ard_survey_svycontinuous(
#' ard_continuous(
#' data = dclus1,
#' variables = api00,
#' by = stype
#' )
ard_survey_svycontinuous <- function(data, variables, by = NULL,
statistic = everything() ~ c("median", "p25", "p75"),
fmt_fn = NULL,
stat_label = NULL) {
ard_continuous.survey.design <- function(data, variables, by = NULL,
statistic = everything() ~ c("median", "p25", "p75"),
fmt_fn = NULL,
stat_label = NULL,
...) {
set_cli_abort_call()
check_dots_empty()

# check installed packages ---------------------------------------------------
check_pkg_installed(pkg = "survey", reference_pkg = "cardx")
Expand All @@ -68,7 +71,7 @@ ard_survey_svycontinuous <- function(data, variables, by = NULL,
)
cards::fill_formula_selectors(
data$variables[variables],
statistic = formals(ard_survey_svycontinuous)[["statistic"]] |> eval()
statistic = formals(asNamespace("cardx")[["ard_continuous.survey.design"]])[["statistic"]] |> eval()
)
cards::check_list_elements(
x = statistic,
Expand Down
20 changes: 16 additions & 4 deletions R/ard_effectsize_cohens_d.R
Original file line number Diff line number Diff line change
Expand Up @@ -77,8 +77,15 @@ ard_effectsize_cohens_d <- function(data, by, variables, conf.level = 0.95, ...)
variable = variable,
lst_tidy =
cards::eval_capture_conditions(
effectsize::cohens_d(data[[variable]] ~ data[[by]], data = data, paired = FALSE, ci = conf.level, ...) |>
parameters::standardize_names(style = "broom")
effectsize::cohens_d(
reformulate2(by, response = variable),
data = data |> tidyr::drop_na(all_of(c(by, variable))),
paired = FALSE,
ci = conf.level,
...
) |>
parameters::standardize_names(style = "broom") |>
dplyr::mutate(method = "Cohen's D")
),
paired = FALSE,
...
Expand Down Expand Up @@ -124,10 +131,15 @@ ard_effectsize_paired_cohens_d <- function(data, by, variables, id, conf.level =
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)
data_wide <-
data |>
tidyr::drop_na(all_of(c(id, by, variable))) |>
.paired_data_pivot_wider(by = by, variable = variable, id = id) |>
tidyr::drop_na(any_of(c("by1", "by2")))
# perform paired cohen's d test
effectsize::cohens_d(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ci = conf.level, ...) |>
parameters::standardize_names(style = "broom")
parameters::standardize_names(style = "broom") |>
dplyr::mutate(method = "Paired Cohen's D")
}),
paired = TRUE,
...
Expand Down
21 changes: 17 additions & 4 deletions R/ard_effectsize_hedges_g.R
Original file line number Diff line number Diff line change
Expand Up @@ -82,9 +82,17 @@ ard_effectsize_hedges_g <- function(data, by, variables, conf.level = 0.95, ...)
# Will also need to remove `hedges_g` from globalVariables()
withr::with_namespace(
package = "effectsize",
code = hedges_g(data[[variable]] ~ data[[by]], paired = FALSE, ci = conf.level, ...)
code =
hedges_g(
reformulate2(by, response = variable),
data = data |> tidyr::drop_na(all_of(c(by, variable))),
paired = FALSE,
ci = conf.level,
...
)
) |>
parameters::standardize_names(style = "broom")
parameters::standardize_names(style = "broom") |>
dplyr::mutate(method = "Hedge's G")
),
paired = FALSE,
...
Expand Down Expand Up @@ -129,13 +137,18 @@ ard_effectsize_paired_hedges_g <- function(data, by, variables, id, conf.level =
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)
data_wide <-
data |>
tidyr::drop_na(all_of(c(id, by, variable))) |>
.paired_data_pivot_wider(by = by, variable = variable, id = id) |>
tidyr::drop_na(any_of(c("by1", "by2")))
# perform paired cohen's d test
withr::with_namespace(
package = "effectsize",
code = hedges_g(x = data_wide[["by1"]], y = data_wide[["by2"]], paired = TRUE, ci = conf.level, ...)
) |>
parameters::standardize_names(style = "broom")
parameters::standardize_names(style = "broom") |>
dplyr::mutate(method = "Paired Hedge's G")
}),
paired = TRUE,
...
Expand Down
42 changes: 33 additions & 9 deletions R/ard_smd_smd.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@
#'
#' @description
#' Standardized mean difference calculated via [`smd::smd()`] with `na.rm = TRUE`.
#' Additionally, this function add a confidence interval to the SMD when
#' `std.error=TRUE`, which the original `smd::smd()` does not include.
#'
#' @param data (`data.frame`/`survey.design`)\cr
#' a data frame or object of class 'survey.design'
Expand All @@ -11,15 +13,20 @@
#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
#' column names to be compared. Independent tests will be computed for
#' each variable.
#' @inheritDotParams smd::smd -x -g -w -na.rm
#' @param conf.level (scalar `numeric`)\cr
#' confidence level for confidence interval. Default is `0.95`.
#' @param std.error (scalar `logical`)\cr
#' Logical indicator for computing standard errors using `smd::compute_smd_var()`.
#' Default is `TRUE`.
#' @param ... arguments passed to `smd::smd()`
#'
#' @return ARD data frame
#' @export
#'
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "smd", reference_pkg = "cardx"))
#' ard_smd_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE)
#' ard_smd_smd(cards::ADSL, by = ARM, variables = AGEGR1, std.error = TRUE)
ard_smd_smd <- function(data, by, variables, ...) {
#' ard_smd_smd(cards::ADSL, by = SEX, variables = AGE)
#' ard_smd_smd(cards::ADSL, by = SEX, variables = AGEGR1)
ard_smd_smd <- function(data, by, variables, std.error = TRUE, conf.level = 0.95, ...) {
set_cli_abort_call()

# check installed packages ---------------------------------------------------
Expand All @@ -37,11 +44,14 @@ ard_smd_smd <- function(data, by, variables, ...) {
data <- design$variables
}


# continue check/process inputs ----------------------------------------------
check_data_frame(data)
data <- dplyr::ungroup(data)
cards::process_selectors(data, by = {{ by }}, variables = {{ variables }})
check_scalar(by)
# This check can be relaxed, but would require some changes to handle multi-row outputs
check_n_levels(data[[by]], 2L, message = "The {.arg by} column must have {.val {length}} levels.")

# if no variables selected, return empty tibble ------------------------------
if (is_empty(variables)) {
Expand All @@ -58,10 +68,24 @@ ard_smd_smd <- function(data, by, variables, ...) {
lst_tidy =
cards::eval_capture_conditions(
switch(as.character(is_survey),
"TRUE" = smd::smd(x = data[[variable]], g = data[[by]], w = stats::weights(design), na.rm = TRUE, ...),
"FALSE" = smd::smd(x = data[[variable]], g = data[[by]], na.rm = TRUE, ...)
"TRUE" = smd::smd(x = data[[variable]], g = data[[by]], w = stats::weights(design), na.rm = TRUE, std.error = std.error, ...),
"FALSE" = smd::smd(x = data[[variable]], g = data[[by]], na.rm = TRUE, std.error = std.error, ...)
) |>
dplyr::select(-any_of("term"))
dplyr::select(-any_of("term")) %>%
# styler: off
{if (isTRUE(std.error))
dplyr::mutate(
.,
conf.low = .data$estimate + stats::qnorm((1 - .env$conf.level) / 2) * .data$std.error,
conf.high = .data$estimate - stats::qnorm((1 - .env$conf.level) / 2) * .data$std.error,
method = "Standardized Mean Difference"
)
else
dplyr::mutate(
.,
method = "Standardized Mean Difference"
)}
# styler: on
),
...
)
Expand All @@ -77,8 +101,8 @@ ard_smd_smd <- function(data, by, variables, ...) {
cards::tidy_as_ard(
lst_tidy = lst_tidy,
tidy_result_names = c("estimate", "std.error"),
fun_args_to_record = "gref",
formals = formals(smd::smd)["gref"],
fun_args_to_record = c("gref"),
formals = formals(smd::smd)[c("gref")],
# removing the `std.error` ARGUMENT (not the result)
passed_args = dots_list(...) |> utils::modifyList(list(std.error = NULL)),
lst_ard_columns = list(group1 = by, variable = variable, context = "smd_smd")
Expand Down
4 changes: 2 additions & 2 deletions R/ard_stats_aov.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,13 +10,13 @@
#' @return ARD data frame
#' @export
#'
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "parameters"), reference_pkg = "cardx"))
#' ard_stats_aov(AGE ~ ARM, data = cards::ADSL)
ard_stats_aov <- function(formula, data, ...) {
set_cli_abort_call()

# check installed packages ---------------------------------------------------
check_pkg_installed(c("broom.helpers"), reference_pkg = "cardx")
check_pkg_installed(c("broom.helpers", "parameters"), reference_pkg = "cardx")

# check/process inputs -------------------------------------------------------
check_not_missing(formula)
Expand Down
Loading

0 comments on commit b096f10

Please sign in to comment.