diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index d5682bc9e..e878a8cc6 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -13,17 +13,17 @@ Pre-review Checklist (if item does not apply, mark is as complete) - [ ] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()` - [ ] If a bug was fixed, a unit test was added. - [ ] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`. +- [ ] If a new `ard_*()` function was added, `set_cli_abort_call()` has been set. +- [ ] If a new `ard_*()` function was added and it depends on another package (such as, `broom`), `is_pkg_installed("broom", reference_pkg = "cardx")` has been set in the function call and the following added to the roxygen comments: `@examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom"", reference_pkg = "cardx"))` - [ ] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` -- [ ] Request a reviewer Reviewer Checklist (if item does not apply, mark is as complete) - [ ] If a bug was fixed, a unit test was added. -- [ ] Run `pkgdown::build_site()`. Check the R console for errors, and review the rendered website. - [ ] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: -- [ ] Update `NEWS.md` with the changes from this pull request under the heading "`# cards (development version)`". If there is an issue associated with the pull request, reference it in parentheses at the end update (see `NEWS.md` for examples). +- [ ] Update `NEWS.md` with the changes from this pull request under the heading "`# cardx (development version)`". If there is an issue associated with the pull request, reference it in parentheses at the end update (see `NEWS.md` for examples). - [ ] **All** GitHub Action workflows pass with a :white_check_mark: - [ ] Approve Pull Request - [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge". diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 9f9b10800..50de31520 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -8,7 +8,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] name: R-CMD-check diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 104df4189..9a3c754f4 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -8,8 +8,6 @@ on: - synchronize - reopened - ready_for_review - branches: - - main push: branches: - main diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 2c5bb5029..1ccc71c5f 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -4,7 +4,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] name: test-coverage diff --git a/DESCRIPTION b/DESCRIPTION index 52217c9ac..4905778da 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,10 @@ Package: cardx Title: Extra Analysis Results Data Utilities -Version: 0.1.0.9008 +Version: 0.1.0.9021 Authors@R: c( person("Daniel", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre")), person("Abinaya", "Yogasekaram", , "abinaya.yogasekaram@contractors.roche.com", role = "aut"), + person("Emily", "de la Rua", , "emily.de_la_rua@contractors.roche.com", role = "aut"), person("F. Hoffmann-La Roche AG", role = c("cph", "fnd")) ) Description: Create extra Analysis Results Data (ARD) summary objects. @@ -17,23 +18,28 @@ BugReports: https://github.com/insightsengineering/cardx/issues Depends: R (>= 4.1) Imports: - cards (>= 0.1.0.9002), + cards (>= 0.1.0.9014), cli (>= 3.6.1), dplyr (>= 1.1.2), glue (>= 1.6.2), rlang (>= 1.1.1), tidyr (>= 1.3.0) Suggests: + aod (>= 1.3.3), broom (>= 1.0.5), - broom.helpers (>= 1.13.0), + broom.helpers (>= 1.15.0), car (>= 3.0-11), effectsize (>= 0.6.0), + geepack (>= 1.3.2), + ggsurvfit (>= 1.0.0), + lme4 (>= 1.1-31), parameters (>= 0.20.2), smd (>= 0.6.6), spelling, survey (>= 4.1), + survival (>= 3.2-11), testthat (>= 3.2.0), - withr + withr (>= 2.5.0) Remotes: insightsengineering/cards Config/Needs/website: insightsengineering/nesttemplate diff --git a/NAMESPACE b/NAMESPACE index 1ec6bbfe6..b2033afd1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,32 +1,41 @@ # Generated by roxygen2: do not edit by hand S3method(ard_regression,default) +S3method(ard_stats_anova,anova) +S3method(ard_stats_anova,data.frame) export("%>%") export(all_of) export(any_of) +export(ard_aod_wald_test) export(ard_car_anova) -export(ard_chisqtest) -export(ard_cohens_d) -export(ard_fishertest) -export(ard_hedges_g) -export(ard_kruskaltest) -export(ard_mcnemartest) -export(ard_moodtest) -export(ard_paired_cohens_d) -export(ard_paired_hedges_g) -export(ard_paired_ttest) -export(ard_paired_wilcoxtest) +export(ard_car_vif) +export(ard_effectsize_cohens_d) +export(ard_effectsize_hedges_g) +export(ard_effectsize_paired_cohens_d) +export(ard_effectsize_paired_hedges_g) export(ard_proportion_ci) -export(ard_proptest) export(ard_regression) export(ard_regression_basic) -export(ard_smd) -export(ard_svychisq) -export(ard_svycontinuous) -export(ard_svyttest) -export(ard_ttest) -export(ard_vif) -export(ard_wilcoxtest) +export(ard_smd_smd) +export(ard_stats_anova) +export(ard_stats_aov) +export(ard_stats_chisq_test) +export(ard_stats_fisher_test) +export(ard_stats_kruskal_test) +export(ard_stats_mcnemar_test) +export(ard_stats_mood_test) +export(ard_stats_oneway_test) +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_wilcox_test) +export(ard_survey_svychisq) +export(ard_survey_svycontinuous) +export(ard_survey_svyranktest) +export(ard_survey_svyttest) +export(ard_survival_survdiff) +export(ard_survival_survfit) export(contains) export(ends_with) export(everything) @@ -44,6 +53,7 @@ export(starts_with) export(where) import(rlang) importFrom(dplyr,"%>%") +importFrom(dplyr,across) importFrom(dplyr,all_of) importFrom(dplyr,any_of) importFrom(dplyr,contains) diff --git a/NEWS.md b/NEWS.md index 5997d603f..70cedb7af 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,19 +1,47 @@ -# cardx 0.1.0.9008 +# cardx 0.1.0.9021 + +### Breaking Changes + +* Updated function names to follow the pattern `ard__()`. Former functions names have _not_ been deprecated. (#106) + +```r +ard_ttest() -> ard_stats_t_test() +ard_paired_ttest() -> ard_stats_paired_t_test() +ard_wilcoxtest() -> ard_stats_wilcox_test() +ard_paired_wilcoxtest() -> ard_stats_paired_wilcox_test() +ard_chisqtest() -> ard_stats_chisq_test() +ard_fishertest() -> ard_stats_fisher_test() +ard_kruskaltest() -> ard_stats_kruskal_test() +ard_mcnemartest() -> ard_stats_mcnemar_test() +ard_moodtest() -> ard_stats_mood_test() +``` + +### New Features * Added the following functions for calculating Analysis Results Data (ARD). + - `ard_stats_aov()` for calculating ANOVA results using `stats::aov()`. (#3) + - `ard_stats_anova()` for calculating ANOVA results using `stats::anova()`. (#12) + - `ard_aod_wald_test()` for calculating Wald Tests for regression models using `aod::wald.test()`. (#84) - `ard_car_anova()` for calculating ANOVA results using `car::Anova()`. (#3) - - `ard_cohens_d()`, `ard_paired_cohens_d()`, `ard_hedges_g()`, and `ard_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50) - - `ard_proptest()` for tests of proportions using `stats::prop.test()`. (#64) + - `ard_stats_oneway_test()` for calculating ANOVA results using `stats::oneway.test()`. (#3) + - `ard_effectsize_cohens_d()`, `ard_effectsize_paired_cohens_d()`, `ard_effectsize_hedges_g()`, and `ard_effectsize_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50) + - `ard_stats_prop_test()` for tests of proportions using `stats::prop.test()`. (#64) - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) - - `ard_smd()` for calculating standardized mean differences using `smd::smd()`. (#4) - - `ard_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) - - `ard_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72) - - `ard_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70) - - `ard_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) + - `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_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) + +* 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) + +* Updated `ard_stats_t_test()` and `ard_stats_wilcox_test()` to no longer require the `by` argument, which yields central estimates with their confidence intervals. (#82) -* Updated functions `ard_ttest()`, `ard_paired_ttest()`, `ard_wilcoxtest()`, `ard_paired_wilcoxtest()`, `ard_chisqtest()`, `ard_fishertest()`, `ard_kruskaltest()`, `ard_mcnemartest()`, and `ard_moodtest()` to accept multiple variables at once. Independent tests are calculated for each variable. The `variable` argument is renamed to `variables`. (#77) +* Imported cli call environment functions from `https://github.com/ddsjoberg/standalone/blob/main/R/standalone-cli_call_env.R` and implemented `set_cli_abort_call` in user-facing functions. (#111) -* Updated `ard_ttest()` and `ard_wilcoxtest()` to no longer require the `by` argument, which yields central estimates with their confidence intervals. (#82) +* Added `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113) # cardx 0.1.0 diff --git a/R/ard_aod_wald_test.R b/R/ard_aod_wald_test.R new file mode 100644 index 000000000..ec87532ab --- /dev/null +++ b/R/ard_aod_wald_test.R @@ -0,0 +1,116 @@ +#' ARD Wald Test +#' +#' @description +#' Function takes a regression model object and calculates Wald +#' statistical test using [`aod::wald.test()`]. +#' +#' @param x regression model object +#' @param ... arguments passed to `aod::wald.test(...)` +#' +#' @return data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "aod", reference_pkg = "cardx")) +#' lm(AGE ~ ARM, data = cards::ADSL) |> +#' ard_aod_wald_test() +ard_aod_wald_test <- function(x, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- + check_pkg_installed("aod", reference_pkg = "cardx") + + # check inputs --------------------------------------------------------------- + check_not_missing(x) + + # run regression() ----------------------------------------------------------- + reg_model <- cards::eval_capture_conditions( + ard_regression_basic(x, intercept = TRUE, stats_to_remove = c( + "var_type", + "var_label", + "var_class", "label", + "contrasts_type", "contrasts", "var_nlevels", "std.error", + "conf.low", "conf.high", "statistic", "p.value", "estimate" + )) + ) + + if (!is.null(reg_model[["error"]])) { + cli::cli_abort( + c("Unable to identify underlying variable names in regression model.", + i = "Is this model type supported by {.fun broom.helpers::tidy_plus_plus}, which is the function used to identify variable names?" + ), + call = get_cli_abort_call() + ) + } + aod <- + reg_model[["result"]] %>% + dplyr::select(c( + variable = "variable", + model_terms = "stat" + )) %>% + dplyr::mutate(term_id = dplyr::row_number()) %>% + tidyr::nest(data = -"variable") %>% + dplyr::rowwise() %>% + dplyr::mutate( + model_terms = unlist(.data$data[["model_terms"]]) %>% list(), + model_terms_id = rlang::set_names(.data$data[["term_id"]]) %>% list() + ) + # run wald.test() ----------------------------------------------------------- + wald_test <- + cards::eval_capture_conditions(lapply(seq_len(length(aod$model_terms_id)), function(terms_id) { + aod::wald.test( + Sigma = stats::vcov(x), + b = stats::coef(x), Terms = aod$model_terms_id[[terms_id]] + ) + })) + + + df_list <- do.call(rbind, lapply(wald_test$result, .extract_wald_results)) + + cbind(aod$variable, df_list) %>% + tidyr::pivot_longer( + cols = !"aod$variable", + names_to = "stat_name", + values_to = "stat" + ) %>% + dplyr::rename( + "variable" = "aod$variable" + ) |> + dplyr::mutate( + stat = as.list(.data$stat), + stat_label = + dplyr::case_when( + .data$stat_name %in% "statistic" ~ "Statistic", + .data$stat_name %in% "df" ~ "Degrees of Freedom", + .data$stat_name %in% "p.value" ~ "p-value", + TRUE ~ .data$stat_name + ), + fmt_fn = + map( + .data$stat, + function(.x) { + # styler: off + if (is.integer(.x)) return(0L) + if (is.numeric(.x)) return(1L) + # styler: on + NULL + } + ), + context = "aod_wald_test", + warning = wald_test["warning"], + error = wald_test["error"] + ) |> + cards::tidy_ard_column_order() %>% + {structure(., class = c("card", class(.)))} # styler: off +} + +#' Extract data from wald.test object +#' +#' @param wald_test (`data.frame`)\cr wald test object object from `aod::wald.test()` +#' +#' @return a data frame containing the wald test results. +#' @keywords internal +.extract_wald_results <- function(wald_test) { + df <- wald_test$result$chi2[("df")] + statistic <- wald_test$result$chi2[("chi2")] + p.value <- wald_test$result$chi2[("P")] + data.frame(df, statistic, p.value) +} diff --git a/R/ard_car_anova.R b/R/ard_car_anova.R index 1c02fb524..2b4f91270 100644 --- a/R/ard_car_anova.R +++ b/R/ard_car_anova.R @@ -8,15 +8,17 @@ #' @return data frame #' @export #' -#' @examplesIf cards::is_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car"), reference_pkg = "cardx")) #' lm(AGE ~ ARM, data = cards::ADSL) |> #' ard_car_anova() #' #' glm(vs ~ factor(cyl) + factor(am), data = mtcars, family = binomial) |> #' ard_car_anova(test.statistic = "Wald") ard_car_anova <- function(x, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx") + check_pkg_installed(pkg = c("broom.helpers", "car"), reference_pkg = "cardx") # check inputs --------------------------------------------------------------- check_not_missing(x) @@ -25,10 +27,13 @@ ard_car_anova <- function(x, ...) { car_anova <- cards::eval_capture_conditions(car::Anova(x, ...)) if (!is.null(car_anova[["error"]])) { - cli::cli_abort(c( - "There was an error running {.fun car::Anova}. See error message below.", - x = car_anova[["error"]] - )) + cli::cli_abort( + c( + "There was an error running {.fun car::Anova}. See error message below.", + x = car_anova[["error"]] + ), + call = get_cli_abort_call() + ) } car_anova[["result"]] |> diff --git a/R/ard_vif.R b/R/ard_car_vif.R similarity index 84% rename from R/ard_vif.R rename to R/ard_car_vif.R index d44a20e99..74088eb4b 100644 --- a/R/ard_vif.R +++ b/R/ard_car_vif.R @@ -10,14 +10,19 @@ #' @param ... arguments passed to `car::vif(...)` #' #' @return data frame -#' @name ard_vif -#' @rdname ard_vif +#' @name ard_car_vif +#' @rdname ard_car_vif #' @export #' -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "car", reference_pkg = "cardx")) #' lm(AGE ~ ARM + SEX, data = cards::ADSL) |> -#' ard_vif() -ard_vif <- function(x, ...) { +#' ard_car_vif() +ard_car_vif <- function(x, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed("car", reference_pkg = "cardx") + # check inputs --------------------------------------------------------------- check_not_missing(x) @@ -30,7 +35,8 @@ ard_vif <- function(x, ...) { # we cannot get variable names, error out if (!is.null(lst_terms[["error"]])) { cli::cli_abort( - c("There was an error running {.fun car::vif}. See below.", x = vif[["error"]]) + c("There was an error running {.fun car::vif}. See below.", x = vif[["error"]]), + call = get_cli_abort_call() ) } vif$result <- dplyr::tibble( @@ -67,7 +73,7 @@ ard_vif <- function(x, ...) { values_to = "stat" ) |> dplyr::mutate( - context = "vif", + context = "car_vif", stat_label = ifelse( .data$stat_name == "aGVIF", "Adjusted GVIF", diff --git a/R/ard_cohens_d.R b/R/ard_effectsize_cohens_d.R similarity index 84% rename from R/ard_cohens_d.R rename to R/ard_effectsize_cohens_d.R index b1b70221b..b0c51df9b 100644 --- a/R/ard_cohens_d.R +++ b/R/ard_effectsize_cohens_d.R @@ -16,22 +16,22 @@ #' @param ... arguments passed to `effectsize::cohens_d(...)` #' #' @return ARD data frame -#' @name ard_cohens_d +#' @name ard_effectsize_cohens_d #' #' @details -#' For the `ard_cohens_d()` function, the data is expected to be one row per subject. +#' For the `ard_effectsize_cohens_d()` function, the data is expected to be one row per subject. #' The data is passed as `effectsize::cohens_d(data[[variable]]~data[[by]], data, paired = FALSE, ...)`. #' -#' For the `ard_paired_cohens_d()` function, the data is expected to be one row +#' For the `ard_effectsize_paired_cohens_d()` function, the data is expected to be one row #' per subject per by level. Before the effect size is calculated, the data are #' reshaped to a wide format to be one row per subject. #' The data are then passed as #' `effectsize::cohens_d(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. #' -#' @examplesIf cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx")) #' cards::ADSL |> #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' ard_cohens_d(by = ARM, variables = AGE) +#' ard_effectsize_cohens_d(by = ARM, variables = AGE) #' #' # constructing a paired data set, #' # where patients receive both treatments @@ -41,14 +41,16 @@ #' dplyr::arrange(USUBJID, ARM) |> #' dplyr::group_by(USUBJID) |> #' dplyr::filter(dplyr::n() > 1) |> -#' ard_paired_cohens_d(by = ARM, variables = AGE, id = USUBJID) +#' ard_effectsize_paired_cohens_d(by = ARM, variables = AGE, id = USUBJID) NULL -#' @rdname ard_cohens_d +#' @rdname ard_effectsize_cohens_d #' @export -ard_cohens_d <- function(data, by, variables, ...) { +ard_effectsize_cohens_d <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx") + check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -85,12 +87,14 @@ ard_cohens_d <- function(data, by, variables, ...) { } -#' @rdname ard_cohens_d +#' @rdname ard_effectsize_cohens_d #' @export -ard_paired_cohens_d <- function(data, by, variables, id, ...) { +ard_effectsize_paired_cohens_d <- function(data, by, variables, id, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("effectsize", reference_pkg = "cardx") - cards::check_pkg_installed("parameters", reference_pkg = "cardx") + check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx") + # check/process inputs ------------------------------------------------------- check_not_missing(data) check_not_missing(variables) @@ -155,7 +159,7 @@ ard_paired_cohens_d <- function(data, by, variables, id, ...) { #' #' @return ARD data frame #' @keywords internal -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx")) #' cardx:::.format_cohens_d_results( #' by = "ARM", #' variable = "AGE", @@ -177,7 +181,7 @@ ard_paired_cohens_d <- function(data, by, variables, id, ...) { fun_args_to_record = c("mu", "paired", "pooled_sd", "alternative"), formals = formals(asNamespace("effectsize")[["cohens_d"]]), passed_args = c(list(paired = paired), dots_list(...)), - lst_ard_columns = list(group1 = by, variable = variable, context = "cohens_d") + lst_ard_columns = list(group1 = by, variable = variable, context = "effectsize_cohens_d") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_hedges_g.R b/R/ard_effectsize_hedges_g.R similarity index 84% rename from R/ard_hedges_g.R rename to R/ard_effectsize_hedges_g.R index 33e0e719e..3cdcf3a8d 100644 --- a/R/ard_hedges_g.R +++ b/R/ard_effectsize_hedges_g.R @@ -16,22 +16,22 @@ #' @param ... arguments passed to `effectsize::hedges_g(...)` #' #' @return ARD data frame -#' @name ard_hedges_g +#' @name ard_effectsize_hedges_g #' #' @details -#' For the `ard_hedges_g()` function, the data is expected to be one row per subject. +#' For the `ard_effectsize_hedges_g()` function, the data is expected to be one row per subject. #' The data is passed as `effectsize::hedges_g(data[[variable]]~data[[by]], data, paired = FALSE, ...)`. #' -#' For the `ard_paired_hedges_g()` function, the data is expected to be one row +#' For the `ard_effectsize_paired_hedges_g()` function, the data is expected to be one row #' per subject per by level. Before the effect size is calculated, the data are #' reshaped to a wide format to be one row per subject. #' The data are then passed as #' `effectsize::hedges_g(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. #' -#' @examplesIf cards::is_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters", "withr"), reference_pkg = "cardx")) #' cards::ADSL |> #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' ard_hedges_g(by = ARM, variables = AGE) +#' ard_effectsize_hedges_g(by = ARM, variables = AGE) #' #' # constructing a paired data set, #' # where patients receive both treatments @@ -41,14 +41,16 @@ #' dplyr::arrange(USUBJID, ARM) |> #' dplyr::group_by(USUBJID) |> #' dplyr::filter(dplyr::n() > 1) |> -#' ard_paired_hedges_g(by = ARM, variables = AGE, id = USUBJID) +#' ard_effectsize_paired_hedges_g(by = ARM, variables = AGE, id = USUBJID) NULL -#' @rdname ard_hedges_g +#' @rdname ard_effectsize_hedges_g #' @export -ard_hedges_g <- function(data, by, variables, ...) { +ard_effectsize_hedges_g <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx") + check_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -89,12 +91,13 @@ ard_hedges_g <- function(data, by, variables, ...) { dplyr::bind_rows() } -#' @rdname ard_hedges_g +#' @rdname ard_effectsize_hedges_g #' @export -ard_paired_hedges_g <- function(data, by, variables, id, ...) { +ard_effectsize_paired_hedges_g <- function(data, by, variables, id, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("effectsize", reference_pkg = "cardx") - cards::check_pkg_installed("parameters", reference_pkg = "cardx") + check_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -148,7 +151,7 @@ ard_paired_hedges_g <- function(data, by, variables, id, ...) { #' #' @return ARD data frame #' @keywords internal -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx")) #' cardx:::.format_hedges_g_results( #' by = "ARM", #' variable = "AGE", @@ -170,7 +173,7 @@ ard_paired_hedges_g <- function(data, by, variables, id, ...) { fun_args_to_record = c("mu", "paired", "pooled_sd", "alternative"), formals = formals(asNamespace("effectsize")[["hedges_g"]]), passed_args = c(list(paired = paired), dots_list(...)), - lst_ard_columns = list(group1 = by, variable = variable, context = "hedges_g") + lst_ard_columns = list(group1 = by, variable = variable, context = "effectsize_hedges_g") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_proportion_ci.R b/R/ard_proportion_ci.R index 9ceabe174..dad57e5ee 100644 --- a/R/ard_proportion_ci.R +++ b/R/ard_proportion_ci.R @@ -14,7 +14,7 @@ #' Default is `0.95` #' @param method (`string`)\cr #' string indicating the type of confidence interval to calculate. -#' Must be one of `r formals(ard_proportion_ci)[["method"]] |> eval() |> shQuote()`. +#' Must be one of `r formals(ard_proportion_ci)[["method"]] |> eval() |> shQuote("sh")`. #' See `?proportion_ci` for details. #' @param strata,weights,max.iterations arguments passed to `proportion_ci_strat_wilson()`, #' when `method='strat_wilson'` @@ -22,7 +22,7 @@ #' @return an ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' ard_proportion_ci(mtcars, variables = c(vs, am), method = "wilson") ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data), conf.level = 0.95, @@ -35,6 +35,11 @@ ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data), "strat_wilson", "strat_wilsoncc", "agresti-coull", "jeffreys" )) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(pkg = "broom", reference_pkg = "cardx") + # process inputs ------------------------------------------------------------- cards::process_selectors(data, variables = {{ variables }}, by = {{ by }}) method <- arg_match(method) diff --git a/R/ard_regression.R b/R/ard_regression.R index 974787778..a7b0561cb 100644 --- a/R/ard_regression.R +++ b/R/ard_regression.R @@ -11,7 +11,7 @@ #' @return data frame #' @name ard_regression #' -#' @examplesIf cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx")) #' lm(AGE ~ ARM, data = cards::ADSL) |> #' ard_regression(add_estimate_to_reference_rows = TRUE) NULL @@ -25,8 +25,10 @@ ard_regression <- function(x, ...) { #' @rdname ard_regression #' @export ard_regression.default <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx") + check_pkg_installed(pkg = "broom.helpers", reference_pkg = "cardx") # check inputs --------------------------------------------------------------- check_not_missing(x) diff --git a/R/ard_regression_basic.R b/R/ard_regression_basic.R index 2093cd8f2..e923245fb 100644 --- a/R/ard_regression_basic.R +++ b/R/ard_regression_basic.R @@ -26,7 +26,7 @@ #' @name ard_regression_basic #' @export #' -#' @examplesIf cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx")) #' lm(AGE ~ ARM, data = cards::ADSL) |> #' ard_regression_basic() ard_regression_basic <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, @@ -35,8 +35,10 @@ ard_regression_basic <- function(x, tidy_fun = broom.helpers::tidy_with_broom_or "label", "contrasts_type", "contrasts", "var_nlevels" ), ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom.helpers", reference_pkg = "cardx") + check_pkg_installed(pkg = "broom.helpers", reference_pkg = "cardx") # check inputs --------------------------------------------------------------- check_not_missing(x) diff --git a/R/ard_smd.R b/R/ard_smd_smd.R similarity index 88% rename from R/ard_smd.R rename to R/ard_smd_smd.R index 40050339e..7bcd80c85 100644 --- a/R/ard_smd.R +++ b/R/ard_smd_smd.R @@ -16,12 +16,14 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("smd", reference_pkg = "cardx") -#' ard_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE) -#' ard_smd(cards::ADSL, by = ARM, variables = AGEGR1, std.error = TRUE) -ard_smd <- function(data, by, variables, ...) { +#' @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, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("smd", reference_pkg = "cardx") + check_pkg_installed("smd", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -79,7 +81,7 @@ ard_smd <- function(data, by, variables, ...) { formals = formals(smd::smd)["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") + lst_ard_columns = list(group1 = by, variable = variable, context = "smd_smd") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_stats_anova.R b/R/ard_stats_anova.R new file mode 100644 index 000000000..4e4ef5f23 --- /dev/null +++ b/R/ard_stats_anova.R @@ -0,0 +1,224 @@ +#' ARD ANOVA +#' +#' Prepare ANOVA results from the `stats::anova()` function. +#' Users may pass a pre-calculated `stats::anova()` object or a list of +#' formulas. In the latter case, the models will be constructed using the +#' information passed and models will be passed to `stats::anova()`. +#' +#' @param x (`anova` or `data.frame`)\cr +#' an object of class `'anova'` created with `stats::anova()` or +#' a data frame +#' @param formulas (`list`)\cr +#' a list of formulas +#' @param fn (`string`)\cr +#' string naming the function to be called, e.g. `"glm"`. +#' If function belongs to a library that is not attached, the package name +#' must be specified in the `package` argument. +#' @param fn.args (named `list`)\cr +#' named list of arguments that will be passed to `fn`. +#' @param package (`string`)\cr +#' string of package name that will be temporarily loaded when function +#' specified in `method` is executed. +#' @param method (`string`)\cr +#' string of the method used. Default is `"ANOVA results from `stats::anova()`"`. +#' We provide the option to change this as `stats::anova()` can produce +#' results from many types of models that may warrant a more precise +#' description. +#' @inheritParams rlang::args_dots_empty +#' +#' @details +#' When a list of formulas is supplied to `ard_stats_anova()`, these formulas +#' along with information from other arguments, are used to construct models +#' and pass those models to `stats::anova()`. +#' +#' The models are constructed using `rlang::exec()`, which is similar to `do.call()`. +#' +#' ```r +#' rlang::exec(.fn = fn, formula = formula, data = data, !!!fn.args) +#' ``` +#' +#' The above function is executed in `withr::with_namespace(package)`, which +#' allows for the use of `ard_stats_anova(fn)` from packages, +#' e.g. `package = 'lme4'` must be specified when `fn = 'glmer'`. +#' See example below. +#' +#' @return ARD data frame +#' @name ard_stats_anova +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom", "withr", "lme4"), reference_pkg = "cardx")) +#' anova( +#' lm(mpg ~ am, mtcars), +#' lm(mpg ~ am + hp, mtcars) +#' ) |> +#' ard_stats_anova() +#' +#' ard_stats_anova( +#' x = mtcars, +#' formulas = list(am ~ mpg, am ~ mpg + hp), +#' fn = "glm", +#' fn.args = list(family = binomial) +#' ) +#' +#' ard_stats_anova( +#' x = mtcars, +#' formulas = list(am ~ 1 + (1 | vs), am ~ mpg + (1 | vs)), +#' fn = "glmer", +#' fn.args = list(family = binomial), +#' package = "lme4" +#' ) +NULL + +#' @rdname ard_stats_anova +#' @export +ard_stats_anova <- function(x, ...) { + UseMethod("ard_stats_anova") +} + +#' @rdname ard_stats_anova +#' @export +ard_stats_anova.anova <- function(x, method = "ANOVA results from `stats::anova()`", ...) { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_dots_empty() + check_pkg_installed("broom", reference_pkg = "cardx") + check_string(method, message = "Argument {.arg method} must be a string of a function name.") + + # return df in cards formats ------------------------------------------------- + lst_results <- + cards::eval_capture_conditions( + .anova_tidy_and_reshape(x, method = method) + ) + + # final tidying up of cards data frame --------------------------------------- + .anova_final_ard_prep(lst_results, method = method) +} + + +#' @rdname ard_stats_anova +#' @export +ard_stats_anova.data.frame <- function(x, + formulas, + fn, + fn.args = list(), + package = "base", + method = "ANOVA results from `stats::anova()`", + ...) { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_dots_empty() + check_string(package) + check_pkg_installed(c("broom", "withr", package), reference_pkg = "cardx") + check_not_missing(formulas) + check_not_missing(x) + check_not_missing(fn) + check_string(method, message = "Argument {.arg method} must be a string of a function name.") + check_data_frame(x) + check_string(fn) + if (str_detect(fn, "::")) { + cli::cli_abort( + c( + "Argument {.arg fn} cannot be namespaced.", + i = "Put the package name in the {.arg package} argument." + ), + call = get_cli_abort_call() + ) + } + + # calculate results and return df in cards formats --------------------------- + # process fn.args argument + fn.args <- rlang::call_args(rlang::enexpr(fn.args)) + + # create models + lst_results <- + cards::eval_capture_conditions({ + # first build the models + models <- + lapply( + formulas, + function(formula) { + withr::with_namespace( + package = package, + call2(.fn = fn, formula = formula, data = x, !!!fn.args) |> + eval_tidy() + ) + } + ) + + # now calculate `stats::anova()` and reshape results + rlang::inject(stats::anova(!!!models)) |> + .anova_tidy_and_reshape(method = method) + }) + + # final tidying up of cards data frame --------------------------------------- + .anova_final_ard_prep(lst_results, method = method) +} + +.anova_tidy_and_reshape <- function(x, method) { + broom::tidy(x) |> + dplyr::mutate( + across(everything(), as.list), + variable = paste0("model_", dplyr::row_number()) + ) |> + tidyr::pivot_longer( + cols = -"variable", + names_to = "stat_name", + values_to = "stat" + ) |> + dplyr::filter(!is.na(.data$stat)) %>% + # add one more row with the method + { + dplyr::bind_rows( + ., + dplyr::filter(., dplyr::n() == dplyr::row_number()) |> + dplyr::mutate( + stat_name = "method", + stat = list(.env$method) + ) + ) + } +} + +.anova_final_ard_prep <- function(lst_results, method) { + # saving the results in data frame ------------------------------------------- + df_card <- + if (!is.null(lst_results[["result"]])) { + lst_results[["result"]] + } else { # if there was an error return a shell of an ARD data frame + dplyr::tibble( + variable = "model_1", + stat_name = c("p.value", "method"), + stat = list(NULL, method) + ) + } + + # final tidying up of cards data frame --------------------------------------- + df_card |> + dplyr::mutate( + warning = lst_results["warning"], + error = lst_results["error"], + context = "stats_anova", + fmt_fn = lapply( + .data$stat, + function(x) { + switch(is.integer(x), + 0L + ) %||% switch(is.numeric(x), + 1L + ) + } + ), + stat_label = + dplyr::case_when( + .data$stat_name %in% "p.value" ~ "p-value", + .data$stat_name %in% "sumsq" ~ "Sum of Squares", + .data$stat_name %in% "rss" ~ "Residual Sum of Squares", + .data$stat_name %in% "df" ~ "Degrees of Freedom", + .data$stat_name %in% "df.residual" ~ "df for residuals", + .default = .data$stat_name + ) + ) |> + cards::tidy_ard_column_order() %>% + {structure(., class = c("card", class(.)))} # styler: off +} diff --git a/R/ard_stats_aov.R b/R/ard_stats_aov.R new file mode 100644 index 000000000..81849ba42 --- /dev/null +++ b/R/ard_stats_aov.R @@ -0,0 +1,58 @@ +#' ARD ANOVA +#' +#' @description +#' Analysis results data for Analysis of Variance. +#' Calculated with `stats::aov()` +#' +#' @inheritParams stats::aov +#' @param ... arguments passed to `stats::aov(...)` +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", 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/process inputs ------------------------------------------------------- + check_not_missing(formula) + check_not_missing(data) + check_data_frame(data) + check_class(formula, cls = "formula") + + # build ARD ------------------------------------------------------------------ + aov <- + cards::eval_capture_conditions( + stats::aov(formula, data, ...) + ) + aov[["result"]] |> + broom.helpers::tidy_parameters() |> # using broom.helpers, because it handle non-syntactic names + dplyr::filter(!(dplyr::row_number() == dplyr::n() & .data$term %in% "Residuals")) |> # removing Residual rows + dplyr::rename(variable = "term") |> + tidyr::pivot_longer( + cols = -"variable", + names_to = "stat_name", + values_to = "stat" + ) |> + dplyr::mutate( + stat = as.list(.data$stat), + stat_label = + dplyr::case_when( + .data$stat_name %in% "statistic" ~ "Statistic", + .data$stat_name %in% "df" ~ "Degrees of Freedom", + .data$stat_name %in% "p.value" ~ "p-value", + .data$stat_name %in% "sumsq" ~ "Sum of Squares", + .data$stat_name %in% "meansq" ~ "Mean of Sum of Squares", + TRUE ~ .data$stat_name + ), + context = "stats_aov", + warning = aov["warning"], + error = aov["error"] + ) |> + cards::tidy_ard_column_order() %>% + {structure(., class = c("card", class(.)))} # styler: off +} diff --git a/R/ard_chisqtest.R b/R/ard_stats_chisq_test.R similarity index 86% rename from R/ard_chisqtest.R rename to R/ard_stats_chisq_test.R index 5dd139f17..8ab8c6ff8 100644 --- a/R/ard_chisqtest.R +++ b/R/ard_stats_chisq_test.R @@ -17,12 +17,14 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> -#' ard_chisqtest(by = "ARM", variables = "AGEGR1") -ard_chisqtest <- function(data, by, variables, ...) { +#' ard_stats_chisq_test(by = "ARM", variables = "AGEGR1") +ard_stats_chisq_test <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -51,7 +53,7 @@ ard_chisqtest <- function(data, by, variables, ...) { c("correct", "p", "rescale.p", "simulate.p.value", "B"), formals = formals(stats::chisq.test), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "chisqtest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_chisq_test") ) |> dplyr::mutate( .after = "stat_name", diff --git a/R/ard_fishertest.R b/R/ard_stats_fisher_test.R similarity index 86% rename from R/ard_fishertest.R rename to R/ard_stats_fisher_test.R index c7f25f0f4..8fa50ce46 100644 --- a/R/ard_fishertest.R +++ b/R/ard_stats_fisher_test.R @@ -17,12 +17,14 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL[1:30, ] |> -#' ard_fishertest(by = "ARM", variables = "AGEGR1") -ard_fishertest <- function(data, by, variables, ...) { +#' ard_stats_fisher_test(by = "ARM", variables = "AGEGR1") +ard_stats_fisher_test <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -55,7 +57,7 @@ ard_fishertest <- function(data, by, variables, ...) { ), formals = formals(stats::fisher.test), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "fishertest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_fisher_test") ) |> dplyr::mutate( .after = "stat_name", diff --git a/R/ard_kruskaltest.R b/R/ard_stats_kruskal_test.R similarity index 85% rename from R/ard_kruskaltest.R rename to R/ard_stats_kruskal_test.R index 5021b6910..7f7b3b359 100644 --- a/R/ard_kruskaltest.R +++ b/R/ard_stats_kruskal_test.R @@ -16,12 +16,14 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> -#' ard_kruskaltest(by = "ARM", variables = "AGE") -ard_kruskaltest <- function(data, by, variables) { +#' ard_stats_kruskal_test(by = "ARM", variables = "AGE") +ard_stats_kruskal_test <- function(data, by, variables) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -46,7 +48,7 @@ ard_kruskaltest <- function(data, by, variables) { broom::tidy() ), tidy_result_names = c("statistic", "p.value", "parameter", "method"), - lst_ard_columns = list(group1 = by, variable = variable, context = "kruskaltest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_kruskal_test") ) |> dplyr::mutate( .after = "stat_name", diff --git a/R/ard_mcnemartest.R b/R/ard_stats_mcnemar_test.R similarity index 85% rename from R/ard_mcnemartest.R rename to R/ard_stats_mcnemar_test.R index b4735def9..fb6f31221 100644 --- a/R/ard_mcnemartest.R +++ b/R/ard_stats_mcnemar_test.R @@ -16,16 +16,18 @@ #' @export #' #' @details -#' For the `ard_mcnemartest()` function, the data is expected to be one row per subject. +#' For the `ard_stats_mcnemar_test()` function, the data is expected to be one row per subject. #' The data is passed as `stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...)`. #' Please use `table(x = data[[variable]], y = data[[by]])` to check the contingency table. #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> -#' ard_mcnemartest(by = "SEX", variables = "EFFFL") -ard_mcnemartest <- function(data, by, variables, ...) { +#' ard_stats_mcnemar_test(by = "SEX", variables = "EFFFL") +ard_stats_mcnemar_test <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -69,7 +71,7 @@ ard_mcnemartest <- function(data, by, variables, ...) { #' #' @return ARD data frame #' -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cardx:::.format_mcnemartest_results( #' by = "ARM", #' variable = "AGE", @@ -90,7 +92,7 @@ ard_mcnemartest <- function(data, by, variables, ...) { fun_args_to_record = c("correct"), formals = formals(asNamespace("stats")[["mcnemar.test"]]), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "mcnemartest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_mcnemar_test") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_moodtest.R b/R/ard_stats_mood_test.R similarity index 84% rename from R/ard_moodtest.R rename to R/ard_stats_mood_test.R index dddb82128..75d3464e4 100644 --- a/R/ard_moodtest.R +++ b/R/ard_stats_mood_test.R @@ -14,20 +14,22 @@ #' @param ... arguments passed to `mood.test(...)` #' #' @return ARD data frame -#' @name ard_moodtest +#' @name ard_stats_mood_test #' #' @details -#' For the `ard_moodtest()` function, the data is expected to be one row per subject. +#' For the `ard_stats_mood_test()` function, the data is expected to be one row per subject. #' The data is passed as `mood.test(data[[variable]] ~ data[[by]], ...)`. -#' @rdname ard_moodtest +#' @rdname ard_stats_mood_test #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> -#' ard_moodtest(by = "SEX", variables = "AGE") -ard_moodtest <- function(data, by, variables, ...) { +#' ard_stats_mood_test(by = "SEX", variables = "AGE") +ard_stats_mood_test <- function(data, by, variables, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -71,7 +73,7 @@ ard_moodtest <- function(data, by, variables, ...) { #' #' @return ARD data frame #' @keywords internal -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cardx:::.format_moodtest_results( #' by = "SEX", #' variable = "AGE", @@ -89,7 +91,7 @@ ard_moodtest <- function(data, by, variables, ...) { tidy_result_names = c("statistic", "p.value", "method", "alternative"), formals = formals(asNamespace("stats")[["mood.test.default"]]), passed_args = c(dots_list(...)), - lst_ard_columns = list(group1 = by, variable = variable, context = "moodtest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_mood_test") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_stats_oneway_test.R b/R/ard_stats_oneway_test.R new file mode 100644 index 000000000..ed4eadded --- /dev/null +++ b/R/ard_stats_oneway_test.R @@ -0,0 +1,54 @@ +#' ARD One-way Test +#' +#' @description +#' Analysis results data for Testing Equal Means in a One-Way Layout. +#' calculated with `oneway.test()` +#' +#' @inheritParams stats::oneway.test +#' @param ... additional arguments passed to `oneway.test(...)` +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' ard_stats_oneway_test(AGE ~ ARM, data = cards::ADSL) +ard_stats_oneway_test <- function(formula, data, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(c("broom"), reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(formula) + check_not_missing(data) + check_data_frame(data) + check_class(formula, cls = "formula") + + # build ARD ------------------------------------------------------------------ + + cards::tidy_as_ard( + lst_tidy = + cards::eval_capture_conditions( + stats::oneway.test(formula, data = data, ...) |> + broom::tidy() + ), + tidy_result_names = c("num.df", "den.df", "statistic", "p.value", "method"), + fun_args_to_record = + c("var.equal"), + formals = formals(stats::oneway.test), + passed_args = dots_list(...), + lst_ard_columns = list(context = "stats_oneway_test") + ) |> + dplyr::mutate( + .after = "stat_name", + stat_label = + dplyr::case_when( + .data$stat_name %in% "num.df" ~ "Degrees of Freedom", + .data$stat_name %in% "den.df" ~ "Denominator Degrees of Freedom", + .data$stat_name %in% "statistic" ~ "F Statistic", + .data$stat_name %in% "p.value" ~ "p-value", + .data$stat_name %in% "method" ~ "Method", + TRUE ~ .data$stat_name, + ) + ) +} diff --git a/R/ard_proptest.R b/R/ard_stats_prop_test.R similarity index 85% rename from R/ard_proptest.R rename to R/ard_stats_prop_test.R index 72336982b..f96784737 100644 --- a/R/ard_proptest.R +++ b/R/ard_stats_prop_test.R @@ -15,11 +15,15 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' mtcars |> -#' ard_proptest(by = vs, variables = am) -ard_proptest <- function(data, by, variables, ...) { - cards::check_pkg_installed("broom", reference_pkg = "cardx") +#' ard_stats_prop_test(by = vs, variables = am) +ard_stats_prop_test <- function(data, by, variables, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(pkg = "broom", reference_pkg = "cardx") + # check inputs --------------------------------------------------------------- check_not_missing(data) check_not_missing(variables) @@ -56,10 +60,13 @@ ard_proptest <- function(data, by, variables, ...) { ) if (nrow(data_counts) != 2) { - cli::cli_abort(c( - "The {.arg by} column must have exactly 2 levels.", - "The levels are {.val {data_counts[[by]]}}" - )) + cli::cli_abort( + c( + "The {.arg by} column must have exactly 2 levels.", + "The levels are {.val {data_counts[[by]]}}" + ), + call = get_cli_abort_call() + ) } stats::prop.test( @@ -101,7 +108,7 @@ ard_proptest <- function(data, by, variables, ...) { fun_args_to_record = c("p", "conf.level", "correct"), formals = formals(stats::prop.test), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "proptest") + lst_ard_columns = list(group1 = by, variable = variable, context = "stats_prop_test") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_ttest.R b/R/ard_stats_t_test.R similarity index 86% rename from R/ard_ttest.R rename to R/ard_stats_t_test.R index 0b2b7a940..b506d981c 100644 --- a/R/ard_ttest.R +++ b/R/ard_stats_t_test.R @@ -15,22 +15,22 @@ #' @param ... arguments passed to `t.test(...)` #' #' @return ARD data frame -#' @name ard_ttest +#' @name ard_stats_t_test #' #' @details -#' For the `ard_ttest()` function, the data is expected to be one row per subject. +#' For the `ard_stats_t_test()` function, the data is expected to be one row per subject. #' The data is passed as `t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. #' -#' For the `ard_paired_ttest()` function, the data is expected to be one row +#' For the `ard_stats_paired_t_test()` function, the data is expected to be one row #' per subject per by level. Before the t-test is calculated, the data are #' reshaped to a wide format to be one row per subject. #' The data are then passed as #' `t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' ard_ttest(by = ARM, variables = c(AGE, BMIBL)) +#' ard_stats_t_test(by = ARM, variables = c(AGE, BMIBL)) #' #' # constructing a paired data set, #' # where patients receive both treatments @@ -38,14 +38,16 @@ #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> #' dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> #' dplyr::arrange(USUBJID, ARM) |> -#' ard_paired_ttest(by = ARM, variables = AGE, id = USUBJID) +#' ard_stats_paired_t_test(by = ARM, variables = AGE, id = USUBJID) NULL -#' @rdname ard_ttest +#' @rdname ard_stats_t_test #' @export -ard_ttest <- function(data, variables, by = NULL, ...) { +ard_stats_t_test <- function(data, variables, by = NULL, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -82,11 +84,13 @@ ard_ttest <- function(data, variables, by = NULL, ...) { dplyr::bind_rows() } -#' @rdname ard_ttest +#' @rdname ard_stats_t_test #' @export -ard_paired_ttest <- function(data, by, variables, id, ...) { +ard_stats_paired_t_test <- function(data, by, variables, id, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -137,7 +141,7 @@ ard_paired_ttest <- function(data, by, variables, id, ...) { #' #' @return ARD data frame #' @keywords internal -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cardx:::.format_ttest_results( #' by = "ARM", #' variable = "AGE", @@ -164,7 +168,7 @@ ard_paired_ttest <- function(data, by, variables, id, ...) { fun_args_to_record = c("mu", "paired", "var.equal", "conf.level"), formals = formals(asNamespace("stats")[["t.test.default"]]), passed_args = c(list(paired = paired), dots_list(...)), - lst_ard_columns = list(variable = variable, context = "ttest") + lst_ard_columns = list(variable = variable, context = "stats_t_test") ) if (!is_empty(by)) { @@ -190,7 +194,6 @@ ard_paired_ttest <- function(data, by, variables, id, ...) { #' @param by (`string`)\cr by column name #' @param variable (`string`)\cr variable column name #' @param id (`string`)\cr subject id column name -#' @param env (`environment`) used for error messaging. Default is `rlang::caller_env()` #' #' @return a wide data frame #' @keywords internal @@ -200,10 +203,12 @@ ard_paired_ttest <- function(data, by, variables, id, ...) { #' dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> #' dplyr::arrange(USUBJID, ARM) |> #' cardx:::.paired_data_pivot_wider(by = "ARM", variable = "AGE", id = "USUBJID") -.paired_data_pivot_wider <- function(data, by, variable, id, env = rlang::caller_env()) { +.paired_data_pivot_wider <- function(data, by, variable, id) { # check the number of levels before pivoting data to wider format if (dplyr::n_distinct(data[[by]], na.rm = TRUE) != 2L) { - cli::cli_abort("The {.arg by} argument must have two and only two levels.", call = env) + cli::cli_abort("The {.arg by} argument must have two and only two levels.", + call = get_cli_abort_call() + ) } data |> diff --git a/R/ard_wilcoxtest.R b/R/ard_stats_wilcox_test.R similarity index 74% rename from R/ard_wilcoxtest.R rename to R/ard_stats_wilcox_test.R index d17185609..c2a14bd49 100644 --- a/R/ard_wilcoxtest.R +++ b/R/ard_stats_wilcox_test.R @@ -15,22 +15,22 @@ #' @param ... arguments passed to `wilcox.test(...)` #' #' @return ARD data frame -#' @name ard_wilcoxtest +#' @name ard_stats_wilcox_test #' #' @details -#' For the `ard_wilcoxtest()` function, the data is expected to be one row per subject. +#' For the `ard_stats_wilcox_test()` function, the data is expected to be one row per subject. #' The data is passed as `wilcox.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. #' -#' For the `ard_paired_wilcoxtest()` function, the data is expected to be one row +#' For the `ard_stats_paired_wilcox_test()` function, the data is expected to be one row #' per subject per by level. Before the test is calculated, the data are #' reshaped to a wide format to be one row per subject. #' The data are then passed as #' `wilcox.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. #' -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' cards::ADSL |> #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' ard_wilcoxtest(by = "ARM", variables = "AGE") +#' ard_stats_wilcox_test(by = "ARM", variables = "AGE") #' #' # constructing a paired data set, #' # where patients receive both treatments @@ -38,14 +38,16 @@ #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> #' dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> #' dplyr::arrange(USUBJID, ARM) |> -#' ard_paired_wilcoxtest(by = ARM, variables = AGE, id = USUBJID) +#' ard_stats_paired_wilcox_test(by = ARM, variables = AGE, id = USUBJID) NULL -#' @rdname ard_wilcoxtest +#' @rdname ard_stats_wilcox_test #' @export -ard_wilcoxtest <- function(data, variables, by = NULL, ...) { +ard_stats_wilcox_test <- function(data, variables, by = NULL, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -88,11 +90,13 @@ ard_wilcoxtest <- function(data, variables, by = NULL, ...) { dplyr::bind_rows() } -#' @rdname ard_wilcoxtest +#' @rdname ard_stats_wilcox_test #' @export -ard_paired_wilcoxtest <- function(data, by, variables, id, ...) { +ard_stats_paired_wilcox_test <- function(data, by, variables, id, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed("broom", reference_pkg = "cardx") + check_pkg_installed("broom", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -144,11 +148,11 @@ ard_paired_wilcoxtest <- function(data, by, variables, id, ...) { #' #' @return ARD data frame #' -#' @examples +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' # Pre-processing ADSL to have grouping factor (ARM here) with 2 levels #' ADSL <- cards::ADSL |> #' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' ard_wilcoxtest(by = "ARM", variables = "AGE") +#' ard_stats_wilcox_test(by = "ARM", variables = "AGE") #' #' cardx:::.format_wilcoxtest_results( #' by = "ARM", @@ -174,7 +178,7 @@ ard_paired_wilcoxtest <- function(data, by, variables, id, ...) { ), formals = formals(asNamespace("stats")[["wilcox.test.default"]]), passed_args = c(list(paired = paired), dots_list(...)), - lst_ard_columns = list(variable = variable, context = "wilcoxtest") + lst_ard_columns = list(variable = variable, context = "stats_wilcox_test") ) if (!is_empty(by)) { @@ -193,40 +197,6 @@ ard_paired_wilcoxtest <- function(data, by, variables, id, ...) { } -#' Convert long paired data to wide -#' -#' -#' @param data (`data.frame`)\cr a data frame that is one line per subject per group -#' @param by (`string`)\cr by column name -#' @param variable (`string`)\cr variable column name -#' @param id (`string`)\cr subject id column name -#' @param env (`environment`) used for error messaging. Default is `rlang::caller_env()` -#' -#' @return a wide data frame -#' @keywords internal -#' @examples -#' cards::ADSL[c("ARM", "AGE")] |> -#' dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> -#' dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> -#' dplyr::arrange(USUBJID, ARM) |> -#' cardx:::.paired_data_pivot_wider(by = "ARM", variable = "AGE", id = "USUBJID") -.paired_data_pivot_wider <- function(data, by, variable, id, env = rlang::caller_env()) { - # check the number of levels before pivoting data to wider format - if (dplyr::n_distinct(data[[by]], na.rm = TRUE) != 2L) { - cli::cli_abort("The {.arg by} argument must have two and only two levels.", call = env) - } - - data |> - # arrange data so the first group always appears first - dplyr::arrange(.data[[by]]) |> - tidyr::pivot_wider( - id_cols = all_of(id), - names_from = all_of(by), - values_from = all_of(variable) - ) |> - stats::setNames(c(id, "by1", "by2")) -} - .df_wilcoxtest_stat_labels <- function(by = NULL) { dplyr::tribble( ~stat_name, ~stat_label, diff --git a/R/ard_svychisq.R b/R/ard_survey_svychisq.R similarity index 86% rename from R/ard_svychisq.R rename to R/ard_survey_svychisq.R index 08e09d5cb..f5c092c99 100644 --- a/R/ard_svychisq.R +++ b/R/ard_survey_svychisq.R @@ -20,14 +20,16 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx")) #' data(api, package = "survey") #' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) #' -#' ard_svychisq(dclus1, variables = sch.wide, by = comp.imp, statistic = "F") -ard_svychisq <- function(data, by, variables, statistic = "F", ...) { +#' ard_survey_svychisq(dclus1, variables = sch.wide, by = comp.imp, statistic = "F") +ard_survey_svychisq <- function(data, by, variables, statistic = "F", ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") + check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -53,7 +55,7 @@ ard_svychisq <- function(data, by, variables, statistic = "F", ...) { ), tidy_result_names = c("statistic", "p.value", "ndf", "ddf", "method"), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "svychisq") + lst_ard_columns = list(group1 = by, variable = variable, context = "survey_svychisq") ) |> dplyr::mutate( .after = "stat_name", diff --git a/R/ard_svycontinuous.R b/R/ard_survey_svycontinuous.R similarity index 93% rename from R/ard_svycontinuous.R rename to R/ard_survey_svycontinuous.R index cb719d27b..d9c40afa4 100644 --- a/R/ard_svycontinuous.R +++ b/R/ard_survey_svycontinuous.R @@ -27,27 +27,30 @@ #' @section statistic argument: #' #' The following statistics are available: -#' `r cardx:::accepted_svy_stats(FALSE) |> shQuote() |> paste(collapse = ", ")`, +#' `r cardx:::accepted_svy_stats(FALSE) |> shQuote("sh") |> paste(collapse = ", ")`, #' where 'p##' is are the percentiles and `##` is an integer between 0 and 100. #' #' #' @return an ARD data frame of class 'card' #' @export #' -#' @examplesIf cards::is_pkg_installed("survey", reference_pkg = "cardx") +#' @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_svycontinuous( +#' ard_survey_svycontinuous( #' data = dclus1, #' variables = api00, #' by = stype #' ) -ard_svycontinuous <- function(data, variables, by = NULL, - statistic = everything() ~ c("median", "p25", "p75"), - fmt_fn = NULL, - stat_label = NULL) { - cards::check_pkg_installed("survey", reference_pkg = "cardx") +ard_survey_svycontinuous <- function(data, variables, by = NULL, + statistic = everything() ~ c("median", "p25", "p75"), + fmt_fn = NULL, + stat_label = NULL) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(pkg = "survey", reference_pkg = "cardx") # check inputs --------------------------------------------------------------- check_not_missing(data) @@ -65,7 +68,7 @@ ard_svycontinuous <- function(data, variables, by = NULL, ) cards::fill_formula_selectors( data$variables[variables], - statistic = formals(ard_svycontinuous)[["statistic"]] |> eval() + statistic = formals(ard_survey_svycontinuous)[["statistic"]] |> eval() ) cards::check_list_elements( x = statistic, @@ -135,7 +138,7 @@ ard_svycontinuous <- function(data, variables, by = NULL, # add class and return ARD object -------------------------------------------- df_stats |> - dplyr::mutate(context = "continuous") |> + dplyr::mutate(context = "survey_svycontinuous") |> cards::tidy_ard_column_order() %>% {structure(., class = c("card", class(.)))} # styler: off } diff --git a/R/ard_survey_svyranktest.R b/R/ard_survey_svyranktest.R new file mode 100644 index 000000000..38fe77c5e --- /dev/null +++ b/R/ard_survey_svyranktest.R @@ -0,0 +1,96 @@ +#' ARD Survey rank test +#' +#' @description +#' Analysis results data for survey wilcox test using [`survey::svyranktest()`]. +#' +#' @param data (`survey.design`)\cr +#' a survey design object often created with [`survey::svydesign()`] +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name to compare by +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column names to be compared. Independent tests will be run for each variable. +#' @param test (`string`)\cr +#' a string to denote which rank test to use: +#' `"wilcoxon"`, `"vanderWaerden"`, `"median"`, `"KruskalWallis"` +#' @param ... arguments passed to [`survey::svyranktest()`] +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx")) +#' data(api, package = "survey") +#' dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) +#' +#' ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "wilcoxon") +#' ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "vanderWaerden") +#' ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "median") +#' ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "KruskalWallis") +ard_survey_svyranktest <- function(data, by, variables, test, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_not_missing(by) + check_class(data, cls = "survey.design") + cards::process_selectors(data[["variables"]], by = {{ by }}, variables = {{ variables }}) + check_scalar(by) + + # build ARD ------------------------------------------------------------------ + lapply( + variables, + function(variable) { + .format_svyranktest_results( + by = by, + variable = variable, + lst_tidy = + cards::eval_capture_conditions( + survey::svyranktest(stats::reformulate(by, response = variable), design = data, test = test, ...) |> + broom::tidy() + ) + ) + } + ) |> + dplyr::bind_rows() +} + +.format_svyranktest_results <- function(by, variable, lst_tidy, ...) { + # build ARD ------------------------------------------------------------------ + ret <- + cards::tidy_as_ard( + lst_tidy = lst_tidy, + tidy_result_names = c( + "estimate", "statistic", + "p.value", "parameter", + "method", "alternative" + ), + passed_args = dots_list(...), + lst_ard_columns = list(group1 = by, variable = variable, context = "survey_svyranktest") + ) + + # add the stat label --------------------------------------------------------- + ret |> + dplyr::left_join( + .df_surveyrank_stat_labels(), + by = "stat_name" + ) |> + dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |> + cards::tidy_ard_column_order() +} + + +.df_surveyrank_stat_labels <- function() { + dplyr::tribble( + ~stat_name, ~stat_label, + "statistic", "Statistic", + "parameter", "Degrees of Freedom", + "estimate", "Median of the Difference", + "null.value", "Null Value", + "alternative", "Alternative Hypothesis", + "data.name", "Data Name", + "p.value", "p-value" + ) +} diff --git a/R/ard_svyttest.R b/R/ard_survey_svyttest.R similarity index 87% rename from R/ard_svyttest.R rename to R/ard_survey_svyttest.R index 8e0e86cec..2e6ea91d6 100644 --- a/R/ard_svyttest.R +++ b/R/ard_survey_svyttest.R @@ -17,14 +17,16 @@ #' @return ARD data frame #' @export #' -#' @examplesIf cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx")) #' data(api, package = "survey") #' dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) #' -#' ard_svyttest(dclus2, variables = enroll, by = comp.imp, conf.level = 0.9) -ard_svyttest <- function(data, by, variables, conf.level = 0.95, ...) { +#' ard_survey_svyttest(dclus2, variables = enroll, by = comp.imp, conf.level = 0.9) +ard_survey_svyttest <- function(data, by, variables, conf.level = 0.95, ...) { + set_cli_abort_call() + # check installed packages --------------------------------------------------- - cards::check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") + check_pkg_installed(c("survey", "broom"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(data) @@ -73,7 +75,7 @@ ard_svyttest <- function(data, by, variables, conf.level = 0.95, ...) { "conf.level", "method", "alternative" ), passed_args = dots_list(...), - lst_ard_columns = list(group1 = by, variable = variable, context = "svyttest") + lst_ard_columns = list(group1 = by, variable = variable, context = "survey_svyttest") ) # add the stat label --------------------------------------------------------- diff --git a/R/ard_survival_survdiff.R b/R/ard_survival_survdiff.R new file mode 100644 index 000000000..59a4cc3e5 --- /dev/null +++ b/R/ard_survival_survdiff.R @@ -0,0 +1,146 @@ +#' ARD for Difference in Survival +#' +#' @description +#' Analysis results data for comparison of survival using [survival::survdiff()]. +#' +#' @param formula (`formula`)\cr +#' a formula +#' @param data (`data.frame`)\cr +#' a data frame +#' @param rho (`scalar numeric`)\cr +#' numeric scalar passed to `survival::survdiff(rho)`. Default is `rho=0`. +#' @param ... additional arguments passed to `survival::survdiff()` +#' +#' @return an ARD data frame of class 'card' +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom", "ggsurvfit"), reference_pkg = "cardx")) +#' library(survival) +#' library(ggsurvfit) +#' +#' ard_survival_survdiff(Surv_CNSR(AVAL, CNSR) ~ TRTA, data = cards::ADTTE) +ard_survival_survdiff <- function(formula, data, rho = 0, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(formula) + check_class(formula, cls = "formula") + if (!missing(data)) check_class(data, cls = "data.frame") + check_scalar(rho) + check_class(rho, cls = "numeric") + + # assign method + method <- dplyr::case_when( + rho == 0 ~ "Log-rank test", + rho == 1.5 ~ "Tarone-Ware test", + rho == 1 ~ "Peto & Peto modification of Gehan-Wilcoxon test", + .default = glue::glue("G-rho test (\U03C1 = {rho})") + ) |> + as.character() + + # calculate survdiff() results ----------------------------------------------- + lst_glance <- + cards::eval_capture_conditions( + survival::survdiff(formula = formula, data = data, rho = rho, ...) |> + broom::glance() |> + dplyr::mutate(method = .env$method) + ) + + # tidy results up in an ARD format ------------------------------------------- + # extract variable names from formula + variables <- stats::terms(formula) |> + attr("term.labels") |> + .strip_backticks() + + # if there was an error, return results early + if (is.null(lst_glance[["result"]])) { + # if no variables in formula, then return an error + # otherwise, if we do have variable names, then we can construct an empty ARD which will be done below + if (is_empty(variables)) { + cli::cli_abort( + message = + c("There was an error in {.fun survival::survdiff}. See below:", + "x" = lst_glance[["error"]] + ), + call = get_cli_abort_call() + ) + } + } + + .variables_to_survdiff_ard( + variables = variables, + method = method, + # styler: off + stat_names = + if (!is.null(lst_glance[["result"]])) names(lst_glance[["result"]]) + else c("statistic", "df", "p.value", "method"), + stats = + if (!is.null(lst_glance[["result"]])) unname(as.list(lst_glance[["result"]])) + else rep_along(c("statistic", "df", "p.value"), list(NULL)) |> c(list(method = method)) + # styler: on + ) |> + .add_survdiff_stat_labels() |> + dplyr::mutate( + context = "survival_survdiff", + warning = lst_glance["warning"], + error = lst_glance["error"], + fmt_fn = map( + .data$stat, + function(x) { + if (is.numeric(x)) return(1L) # styler: off + NULL + } + ) + ) |> + cards::tidy_ard_column_order() %>% + {structure(., class = c("card", class(.)))} # styler: off +} + +.variables_to_survdiff_ard <- function(variables, + method, + stat_names, + stats) { + len <- length(variables) + + df_vars <- dplyr::tibble(!!!rev(variables)) |> + set_names( + ifelse( + len > 1L, + c(paste0("group_", rev(seq_len(len - 1L))), "variable"), + "variable" + ) + ) + + dplyr::bind_cols( + df_vars, + dplyr::tibble( + stat_name = .env$stat_names, + stat = .env$stats + ) + ) +} + +.add_survdiff_stat_labels <- function(x) { + x |> + dplyr::left_join( + dplyr::tribble( + ~stat_name, ~stat_label, + "statistic", "X^2 Statistic", + "df", "Degrees of Freedom", + "p.value", "p-value" + ), + by = "stat_name" + ) |> + dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) +} + +.strip_backticks <- function(x) { + ifelse( + str_detect(x, "^`.*`$"), + substr(x, 2, nchar(x) - 1), + x + ) +} diff --git a/R/ard_survival_survfit.R b/R/ard_survival_survfit.R new file mode 100644 index 000000000..9a30adf5f --- /dev/null +++ b/R/ard_survival_survfit.R @@ -0,0 +1,352 @@ +#' ARD Survival Estimates +#' +#' @description +#' Analysis results data for survival quantiles and x-year survival estimates, extracted +#' from a [survival::survfit()] model. +#' +#' @param x ([survival::survfit()])\cr +#' a [survival::survfit()] object. See below for details. +#' @param times (`numeric`)\cr +#' a vector of times for which to return survival probabilities. +#' @param probs (`numeric`)\cr +#' a vector of probabilities with values in (0,1) specifying the survival quantiles to return. +#' @param type (`string` or `NULL`)\cr +#' type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise `type` +#' is ignored. Default is `NULL`. +#' Must be one of the following: +#' ```{r, echo = FALSE} +#' dplyr::tribble( +#' ~type, ~transformation, +#' '`"survival"`', '`x`', +#' '`"risk"`', '`1 - x`', +#' '`"cumhaz"`', '`-log(x)`', +#' ) %>% +#' knitr::kable() +#' ``` +#' +#' @return an ARD data frame of class 'card' +#' @name ard_survival_survfit +#' +#' @details +#' * Only one of either the `times` or `probs` parameters can be specified. +#' * Times should be provided using the same scale as the time variable used to fit the provided +#' survival fit model. +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom", "ggsurvfit"), reference_pkg = "cardx")) +#' library(survival) +#' library(ggsurvfit) +#' +#' survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' ard_survival_survfit(times = c(60, 180)) +#' +#' survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' ard_survival_survfit(probs = c(0.25, 0.5, 0.75)) +#' +#' # Competing Risks Example --------------------------- +#' set.seed(1) +#' ADTTE_MS <- cards::ADTTE %>% +#' dplyr::mutate( +#' CNSR = dplyr::case_when( +#' CNSR == 0 ~ "censor", +#' runif(dplyr::n()) < 0.5 ~ "death from cancer", +#' TRUE ~ "death other causes" +#' ) %>% factor() +#' ) +#' +#' survfit(Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% +#' ard_survival_survfit(times = c(60, 180)) +NULL + +#' @rdname ard_survival_survfit +#' @export +ard_survival_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(x) + check_class(x, cls = "survfit") + if (inherits(x, "survfitcox")) { + cli::cli_abort("Argument {.arg x} cannot be class {.cls survfitcox}.", + call = get_cli_abort_call() + ) + } + + # competing risks models cannot use the type argument + if (inherits(x, c("survfitms", "survfitcoxms")) && !is.null(type)) { + cli::cli_abort("Cannot use {.arg type} argument with {.code survfit} models with class {.cls {c('survfitms', 'survfitcoxms')}}.", + call = get_cli_abort_call() + ) + } + if (!is.null(probs)) check_range(probs, c(0, 1)) + if (sum(is.null(times), is.null(probs)) != 1) { + cli::cli_abort("One and only one of {.arg times} and {.arg probs} must be specified.") + } + + # for regular KM estimators, we allow the type argument + if (!inherits(x, "survfitms") && !is.null(type)) { + type <- arg_match(type, values = c("survival", "risk", "cumhaz")) + } + + # cannot specify type arg when probs supplied + if (!is.null(probs) && !is.null(type)) { + cli::cli_abort("Cannot use {.arg type} argument when {.arg probs} argument specifed.", + call = get_cli_abort_call() + ) + } + + # build ARD ------------------------------------------------------------------ + est_type <- ifelse(is.null(probs), "times", "probs") + tidy_survfit <- switch(est_type, + "times" = .process_survfit_time(x, times, type %||% "survival"), + "probs" = .process_survfit_probs(x, probs) + ) + + .format_survfit_results(tidy_survfit) +} + +#' Process Survival Fit For Time Estimates +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams ard_survival_survfit +#' +#' @return a `tibble` +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"), reference_pkg = "cardx")) +#' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk") +#' +#' @keywords internal +.process_survfit_time <- function(x, times, type) { + # tidy survfit results + tidy_x <- broom::tidy(x) + + # process competing risks/multi-state models + multi_state <- inherits(x, "survfitms") + + if (multi_state == TRUE) { + # selecting state to show + state <- setdiff(unique(tidy_x$state), "(s0)")[[1]] + cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") + tidy_x <- dplyr::filter(tidy_x, .data$state == .env$state) + } + + # adding time 0 to data frame + tidy_x <- tidy_x %>% + # make strata a fct to preserve ordering + dplyr::mutate(dplyr::across(dplyr::any_of("strata"), ~ factor(., levels = unique(.)))) %>% + # if CI is missing and SE is 0, use estimate as the CI + dplyr::mutate_at( + dplyr::vars("conf.high", "conf.low"), + ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) + ) %>% + dplyr::select(dplyr::any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% + # add data for time 0 + dplyr::bind_rows( + dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% + dplyr::slice(1) %>% + dplyr::mutate( + time = 0, + estimate = ifelse(multi_state, 0, 1), + conf.low = ifelse(multi_state, 0, 1), + conf.high = ifelse(multi_state, 0, 1) + ) + ) %>% + dplyr::ungroup() + + strat <- "strata" %in% names(tidy_x) + + # get requested estimates + df_stat <- tidy_x %>% + # find max time + dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% + dplyr::mutate(time_max = max(.data$time)) %>% + dplyr::ungroup() %>% + # add requested timepoints + dplyr::full_join( + tidy_x %>% + dplyr::select(any_of("strata")) %>% + dplyr::distinct() %>% + dplyr::mutate( + time = list(.env$times), + col_name = list(paste("stat", seq_len(length(.env$times)), sep = "_")) + ) %>% + tidyr::unnest(cols = c("time", "col_name")), + by = unlist(intersect(c("strata", "time"), names(tidy_x))) + ) + + if (strat) { + df_stat <- df_stat %>% dplyr::arrange(.data$strata) + } + + df_stat <- df_stat %>% + # if user-specifed time is unobserved, fill estimate with previous value + dplyr::arrange(.data$time) %>% + dplyr::group_by_at(dplyr::vars(dplyr::any_of("strata"))) %>% + tidyr::fill( + "estimate", "conf.high", "conf.low", "time_max", + .direction = "down" + ) %>% + dplyr::ungroup() %>% + # keep only user-specified times + dplyr::filter(!is.na(.data$col_name)) %>% + # if user-specified time is after max time, make estimate NA + dplyr::mutate_at( + dplyr::vars("estimate", "conf.high", "conf.low"), + ~ ifelse(.data$time > .data$time_max, NA_real_, .) + ) %>% + dplyr::mutate(context = type) %>% + dplyr::select(!dplyr::any_of(c("time_max", "col_name"))) + + # convert estimates to requested type + if (type != "survival") { + df_stat <- df_stat %>% + dplyr::mutate(dplyr::across( + any_of(c("estimate", "conf.low", "conf.high")), + if (type == "cumhaz") ~ -log(.x) else ~ 1 - .x + )) %>% + dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") + } + + df_stat <- extract_multi_strata(x, df_stat) + + df_stat +} + +#' Process Survival Fit For Quantile Estimates +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams ard_survival_survfit +#' +#' @return a `tibble` +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survival", reference_pkg = "cardx")) +#' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) +#' +#' @keywords internal +.process_survfit_probs <- function(x, probs) { + # calculate survival quantiles and add estimates to df + df_stat <- map2( + probs, + seq_along(probs), + ~ stats::quantile(x, probs = .x) %>% + as.data.frame() %>% + set_names(c("estimate", "conf.low", "conf.high")) %>% + dplyr::mutate(strata = row.names(.)) %>% + dplyr::select(dplyr::any_of(c("strata", "estimate", "conf.low", "conf.high"))) %>% + dplyr::mutate(prob = .x) + ) %>% + dplyr::bind_rows() %>% + `rownames<-`(NULL) %>% + dplyr::mutate(context = "survival_survfit") %>% + dplyr::as_tibble() + + if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-"strata") + + df_stat <- extract_multi_strata(x, df_stat) + + df_stat +} + +# process multiple stratifying variables +extract_multi_strata <- function(x, df_stat) { + x_terms <- attr(stats::terms(stats::as.formula(x$call$formula)), "term.labels") + x_terms <- gsub(".*\\(", "", gsub("\\)", "", x_terms)) + if (length(x_terms) > 1) { + strata_lvls <- data.frame() + + for (i in df_stat[["strata"]]) { + i <- gsub(".*\\(", "", gsub("\\)", "", i)) + terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[1]] + s_lvl <- terms_str[nchar(terms_str) > 0] + strata_lvls <- rbind(strata_lvls, s_lvl) + } + if (nrow(strata_lvls) > 0) { + strata_lvls <- cbind(strata_lvls, t(x_terms)) + names(strata_lvls) <- c( + t(sapply(seq_along(x_terms), function(i) c(paste0("group", i, "_level"), paste0("group", i)))) + ) + df_stat <- cbind(df_stat, strata_lvls) %>% + dplyr::select(-"strata") + } + } + df_stat +} + +#' Convert Tidied Survival Fit to ARD +#' +#' @inheritParams cards::tidy_as_ard +#' +#' @return an ARD data frame of class 'card' +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"), reference_pkg = "cardx")) +#' cardx:::.format_survfit_results( +#' broom::tidy(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +#' ) +#' +#' @keywords internal +.format_survfit_results <- function(tidy_survfit) { + est <- if ("time" %in% names(tidy_survfit)) "time" else "prob" + + ret <- tidy_survfit %>% + dplyr::mutate(dplyr::across( + dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) + )) %>% + tidyr::pivot_longer( + cols = dplyr::any_of(c("estimate", "conf.high", "conf.low")), + names_to = "stat_name", + values_to = "stat" + ) %>% + dplyr::mutate( + variable = est, + variable_level = .data[[est]] + ) %>% + dplyr::select(-all_of(est)) + + if ("strata" %in% names(ret)) { + ret <- ret %>% + tidyr::separate_wider_delim("strata", "=", names = c("group1", "group1_level")) + } + + ret %>% + dplyr::left_join( + .df_survfit_stat_labels(), + by = "stat_name" + ) %>% + dplyr::mutate( + fmt_fn = lapply( + .data$stat, + function(x) { + switch(is.integer(x), + 0L + ) %||% switch(is.numeric(x), + 1L + ) + } + ), + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) + ) %>% + dplyr::mutate(dplyr::across(matches("group[0-9]*_level"), ~ as.list(as.factor(.x)))) %>% + dplyr::mutate( + warning = list(NULL), + error = list(NULL) + ) %>% + structure(., class = c("card", class(.))) %>% + cards::tidy_ard_column_order() %>% + cards::tidy_ard_row_order() +} + +.df_survfit_stat_labels <- function() { + dplyr::tribble( + ~stat_name, ~stat_label, + "estimate", "Survival Probability", + "conf.low", "CI Lower Bound", + "conf.high", "CI Upper Bound", + "conf.level", "CI Confidence Level", + "prob", "Quantile", + "time", "Time" + ) +} diff --git a/R/cardx-package.R b/R/cardx-package.R index df5d79a4b..9a843b1bf 100644 --- a/R/cardx-package.R +++ b/R/cardx-package.R @@ -1,5 +1,6 @@ #' @keywords internal #' @import rlang +#' @importFrom dplyr across "_PACKAGE" ## usethis namespace: start diff --git a/R/import-standalone-check_pkg_installed.R b/R/import-standalone-check_pkg_installed.R new file mode 100644 index 000000000..8f6522da3 --- /dev/null +++ b/R/import-standalone-check_pkg_installed.R @@ -0,0 +1,211 @@ +# Standalone file: do not edit by hand +# Source: +# ---------------------------------------------------------------------- +# +# --- +# repo: ddsjoberg/standalone +# file: standalone-check_pkg_installed.R +# last-updated: 2024-04-10 +# license: https://unlicense.org +# dependencies: standalone-cli_call_env.R +# imports: [rlang, dplyr, tidyr] +# --- +# +# This file provides functions to check package installation. +# +# ## Changelog +# nocov start +# styler: off + +#' Check Package Installation +#' +#' @description +#' - `check_pkg_installed()`: checks whether a package is installed and +#' returns an error if not available, or interactively asks user to install +#' missing dependency. If a package search is provided, +#' the function will check whether a minimum version of a package is required and installed. +#' +#' - `is_pkg_installed()`: checks whether a package is installed and +#' returns `TRUE` or `FALSE` depending on availability. If a package search is provided, +#' the function will check whether a minimum version of a package is required and installed. +#' +#' - `get_pkg_dependencies()` returns a tibble with all +#' dependencies of a specific package. +#' +#' - `get_min_version_required()` will return, if any, the minimum version +#' of `pkg` required by `reference_pkg`. +#' +#' @param pkg (`character`)\cr +#' vector of package names to check. +#' @param call (`environment`)\cr +#' frame for error messaging. Default is [get_cli_abort_call()]. +#' @param reference_pkg (`string`)\cr +#' name of the package the function will search for a minimum required version from. +#' @param lib.loc (`path`)\cr +#' location of `R` library trees to search through, see [utils::packageDescription()]. +#' +#' @return `is_pkg_installed()` and `check_pkg_installed()` returns a logical or error, +#' `get_min_version_required()` returns a data frame with the minimum version required, +#' `get_pkg_dependencies()` returns a tibble. +#' +#' @examples +#' check_pkg_installed("dplyr") +#' +#' is_pkg_installed("dplyr") +#' +#' get_pkg_dependencies() +#' +#' get_min_version_required("dplyr") +#' +#' @name check_pkg_installed +#' @noRd +NULL + +#' @inheritParams check_pkg_installed +#' @keywords internal +#' @noRd +check_pkg_installed <- function(pkg, + reference_pkg = "cards", + call = get_cli_abort_call()) { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_not_missing(pkg) + check_class(pkg, cls = "character") + check_string(reference_pkg, allow_empty = TRUE) + + # get min version data ------------------------------------------------------- + df_pkg_min_version <- + get_min_version_required(pkg = pkg, reference_pkg = reference_pkg, call = call) + + # prompt user to install package --------------------------------------------- + rlang::check_installed( + pkg = df_pkg_min_version$pkg, + version = df_pkg_min_version$version, + compare = df_pkg_min_version$compare, + call = call + ) |> + # this can be removed after this issue is resolved https://github.com/r-lib/rlang/issues/1694 + suppressWarnings() +} + +#' @inheritParams check_pkg_installed +#' @keywords internal +#' @noRd +is_pkg_installed <- function(pkg, + reference_pkg = "cards", + call = get_cli_abort_call()) { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_not_missing(pkg) + check_class(pkg, cls = "character") + check_string(reference_pkg, allow_empty = TRUE) + + # get min version data ------------------------------------------------------- + df_pkg_min_version <- + get_min_version_required(pkg = pkg, reference_pkg = reference_pkg, call = call) + + # check installation TRUE/FALSE ---------------------------------------------- + rlang::is_installed( + pkg = df_pkg_min_version$pkg, + version = df_pkg_min_version$version, + compare = df_pkg_min_version$compare + ) |> + # this can be removed after this issue is resolved https://github.com/r-lib/rlang/issues/1694 + suppressWarnings() +} + +#' @inheritParams check_pkg_installed +#' @keywords internal +#' @noRd +get_pkg_dependencies <- function(reference_pkg = "cards", lib.loc = NULL, call = get_cli_abort_call()) { + set_cli_abort_call() + + check_string(reference_pkg, allow_empty = TRUE, call = call) + + if (rlang::is_empty(reference_pkg)) { + return(.empty_pkg_deps_df()) + } + + description <- utils::packageDescription(reference_pkg, lib.loc = lib.loc) |> suppressWarnings() + if (identical(description, NA)) { + return(.empty_pkg_deps_df()) + } + description |> + unclass() |> + dplyr::as_tibble() |> + dplyr::select( + dplyr::any_of(c( + "Package", "Version", "Imports", "Depends", + "Suggests", "Enhances", "LinkingTo" + )) + ) |> + dplyr::rename( + reference_pkg = "Package", + reference_pkg_version = "Version" + ) |> + tidyr::pivot_longer( + -dplyr::all_of(c("reference_pkg", "reference_pkg_version")), + values_to = "pkg", + names_to = "dependency_type", + ) |> + tidyr::separate_rows("pkg", sep = ",") |> + dplyr::mutate(pkg = str_squish(.data$pkg)) |> + dplyr::filter(!is.na(.data$pkg)) |> + tidyr::separate( + .data$pkg, + into = c("pkg", "version"), + sep = " ", extra = "merge", fill = "right" + ) |> + dplyr::mutate( + compare = .data$version |> str_extract(pattern = "[>=<]+"), + version = .data$version |> str_remove_all(pattern = "[\\(\\) >=<]") + ) +} + +.empty_pkg_deps_df <- function() { + dplyr::tibble( + reference_pkg = character(0L), reference_pkg_version = character(0L), + dependency_type = character(0L), pkg = character(0L), + version = character(0L), compare = character(0L) + ) +} + +#' @inheritParams check_pkg_installed +#' @keywords internal +#' @noRd +get_min_version_required <- function(pkg, reference_pkg = "cards", + lib.loc = NULL, call = get_cli_abort_call()) { + set_cli_abort_call() + + check_not_missing(pkg, call = call) + check_class(pkg, cls = "character", call = call) + check_string(reference_pkg, allow_empty = TRUE, call = call) + + # if no package reference, return a df with just the pkg names + if (rlang::is_empty(reference_pkg)) { + return( + .empty_pkg_deps_df() |> + dplyr::full_join( + dplyr::tibble(pkg = pkg), + by = "pkg" + ) + ) + } + + # get the package_ref deps and subset on requested pkgs, also supplement df with pkgs + # that may not be proper deps of the reference package (these pkgs don't have min versions) + res <- + get_pkg_dependencies(reference_pkg, lib.loc = lib.loc) |> + dplyr::filter(.data$pkg %in% .env$pkg) |> + dplyr::full_join( + dplyr::tibble(pkg = pkg), + by = "pkg" + ) + + res +} + +# nocov end +# styler: on diff --git a/R/import-standalone-checks.R b/R/import-standalone-checks.R index 252cb1048..5d1379822 100644 --- a/R/import-standalone-checks.R +++ b/R/import-standalone-checks.R @@ -5,8 +5,9 @@ # --- # repo: ddsjoberg/standalone # file: standalone-checks.R -# last-updated: 2024-01-24 +# last-updated: 2024-04-10 # license: https://unlicense.org +# dependencies: standalone-cli_call_env.R # imports: [rlang, cli] # --- # @@ -49,7 +50,7 @@ check_class <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_class", - call = parent.frame()) { + call = get_cli_abort_call()) { # if empty, skip test if (isTRUE(allow_empty) && rlang::is_empty(x)) { return(invisible(x)) @@ -78,7 +79,7 @@ check_data_frame <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_data_frame", - call = parent.frame()) { + call = get_cli_abort_call()) { check_class( x = x, cls = "data.frame", allow_empty = allow_empty, message = message, arg_name = arg_name, class = class, call = call @@ -102,7 +103,7 @@ check_logical <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_logical", - call = parent.frame()) { + call = get_cli_abort_call()) { check_class( x = x, cls = "logical", allow_empty = allow_empty, message = message, arg_name = arg_name, class = class, call = call @@ -126,7 +127,7 @@ check_scalar_logical <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_scalar_logical", - call = parent.frame()) { + call = get_cli_abort_call()) { check_logical( x = x, allow_empty = allow_empty, message = message, arg_name = arg_name, @@ -157,7 +158,7 @@ check_string <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_string", - call = parent.frame()) { + call = get_cli_abort_call()) { check_class( x = x, cls = "character", allow_empty = allow_empty, message = message, arg_name = arg_name, @@ -180,7 +181,7 @@ check_not_missing <- function(x, message = "The {.arg {arg_name}} argument cannot be missing.", arg_name = rlang::caller_arg(x), class = "check_not_missing", - call = parent.frame()) { + call = get_cli_abort_call()) { if (missing(x)) { cli::cli_abort(message, class = c(class, "standalone-checks"), call = call) } @@ -206,7 +207,7 @@ check_length <- function(x, length, allow_empty = FALSE, arg_name = rlang::caller_arg(x), class = "check_length", - call = parent.frame()) { + call = get_cli_abort_call()) { # if empty, skip test if (isTRUE(allow_empty) && rlang::is_empty(x)) { return(invisible(x)) @@ -235,7 +236,7 @@ check_scalar <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_scalar", - call = parent.frame()) { + call = get_cli_abort_call()) { check_length( x = x, length = 1L, message = message, allow_empty = allow_empty, arg_name = arg_name, @@ -264,7 +265,7 @@ check_range <- function(x, allow_empty = FALSE, arg_name = rlang::caller_arg(x), class = "check_range", - call = parent.frame()) { + call = get_cli_abort_call()) { # if empty, skip test if (isTRUE(allow_empty) && rlang::is_empty(x)) { return(invisible(x)) @@ -322,7 +323,7 @@ check_scalar_range <- function(x, and length {.val {1}}.", arg_name = rlang::caller_arg(x), class = "check_scalar_range", - call = parent.frame()) { + call = get_cli_abort_call()) { check_scalar(x, message = message, arg_name = arg_name, allow_empty = allow_empty, class = class, call = call) @@ -355,7 +356,7 @@ check_binary <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_binary", - call = parent.frame()) { + call = get_cli_abort_call()) { # if empty, skip test if (isTRUE(allow_empty) && rlang::is_empty(x)) { return(invisible(x)) @@ -398,7 +399,7 @@ check_formula_list_selector <- function(x, ), arg_name = rlang::caller_arg(x), class = "check_formula_list_selector", - call = parent.frame()) { + call = get_cli_abort_call()) { # if empty, skip test if (isTRUE(allow_empty) && rlang::is_empty(x)) { return(invisible(x)) diff --git a/R/import-standalone-cli_call_env.R b/R/import-standalone-cli_call_env.R new file mode 100644 index 000000000..88ccd6934 --- /dev/null +++ b/R/import-standalone-cli_call_env.R @@ -0,0 +1,53 @@ +# Standalone file: do not edit by hand +# Source: +# ---------------------------------------------------------------------- +# +# --- +# repo: ddsjoberg/standalone +# file: standalone-cli_call_env.R +# last-updated: 2024-04-10 +# license: https://unlicense.org +# imports: [rlang, cli] +# --- +# +# This file provides functions to set and access the call environment to use in cli::cli_abort() in check functions. +# +# ## Changelog +# nocov start +# styler: off + +#' Set Call Environment for [cli::cli_abort()] +#' +#' Set a call environment to be used as the `call` parameter in [cli::cli_abort()] for package checks. This function +#' is used to ensure that the correct user-facing function is reported for errors generated by internal checks that +#' use [cli::cli_abort()]. +#' +#' @param env (`enviroment`)\cr +#' call environment used as the `call` parameter in [cli::cli_abort()] for package checks +#' +#' @seealso [get_cli_abort_call()] +#' +#' @keywords internal +#' @noRd +set_cli_abort_call <- function(env = rlang::caller_env()) { + if (getOption("cli_abort_call") |> is.null()) { + options(cli_abort_call = env) + set_call <- as.call(list(function() options(cli_abort_call = NULL))) + do.call(on.exit, list(expr = set_call, after = FALSE), envir = env) + } + invisible() +} + +#' Get Call Environment for [cli::cli_abort()] +#' +#' @inheritParams set_cli_abort_call +#' @seealso [set_cli_abort_call()] +#' +#' @keywords internal +#' @noRd +get_cli_abort_call <- function() { + getOption("cli_abort_call", default = parent.frame()) +} + +# nocov end +# styler: on diff --git a/R/import-standalone-forcats.R b/R/import-standalone-forcats.R index f3370a2f2..db001fd9e 100644 --- a/R/import-standalone-forcats.R +++ b/R/import-standalone-forcats.R @@ -2,7 +2,6 @@ # Source: # ---------------------------------------------------------------------- # -# DO NOT MODIFY THIS FILE. INSTEAD MODIFY THE VERSION IN https://github.com/ddsjoberg/standalone/tree/main/R # --- # file: standalone-forcats.R # last-updated: 2024-01-24 diff --git a/R/import-standalone-stringr.R b/R/import-standalone-stringr.R index 3fb357e40..263bde5bc 100644 --- a/R/import-standalone-stringr.R +++ b/R/import-standalone-stringr.R @@ -2,12 +2,11 @@ # Source: # ---------------------------------------------------------------------- # -# DO NOT MODIFY THIS FILE. INSTEAD MODIFY THE VERSION IN https://github.com/ddsjoberg/standalone/tree/main/R # --- # file: standalone-stringr.R # last-updated: 2024-01-24 # license: https://unlicense.org -# imports: +# imports: rlang # --- # # This file provides a minimal shim to provide a stringr-like API on top of diff --git a/R/proportion_ci.R b/R/proportion_ci.R index d2b8e4c61..34aef53d2 100644 --- a/R/proportion_ci.R +++ b/R/proportion_ci.R @@ -7,7 +7,7 @@ #' @return Confidence interval of a proportion. #' #' @name proportion_ci -#' @examplesIf cards::is_pkg_installed("broom", reference_pkg = "cardx") +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) #' x <- c( #' TRUE, TRUE, TRUE, TRUE, TRUE, #' FALSE, FALSE, FALSE, FALSE, FALSE @@ -29,6 +29,8 @@ NULL #' #' @export proportion_ci_wald <- function(x, conf.level = 0.95, correct = FALSE) { + set_cli_abort_call() + # check inputs --------------------------------------------------------------- check_not_missing(x) check_binary(x) @@ -70,7 +72,10 @@ proportion_ci_wald <- function(x, conf.level = 0.95, correct = FALSE) { #' #' @export proportion_ci_wilson <- function(x, conf.level = 0.95, correct = FALSE) { - cards::check_pkg_installed("broom", reference_pkg = "cardx") + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(pkg = "broom", reference_pkg = "cardx") # check inputs --------------------------------------------------------------- check_not_missing(x) @@ -105,7 +110,11 @@ proportion_ci_wilson <- function(x, conf.level = 0.95, correct = FALSE) { #' #' @export proportion_ci_clopper_pearson <- function(x, conf.level = 0.95) { - cards::check_pkg_installed("broom", reference_pkg = "cardx") + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(pkg = "broom", reference_pkg = "cardx") + # check inputs --------------------------------------------------------------- check_not_missing(x) check_binary(x) @@ -132,6 +141,8 @@ proportion_ci_clopper_pearson <- function(x, conf.level = 0.95) { #' #' @export proportion_ci_agresti_coull <- function(x, conf.level = 0.95) { + set_cli_abort_call() + # check inputs --------------------------------------------------------------- check_not_missing(x) check_binary(x) @@ -173,6 +184,8 @@ proportion_ci_agresti_coull <- function(x, conf.level = 0.95) { #' #' @export proportion_ci_jeffreys <- function(x, conf.level = 0.95) { + set_cli_abort_call() + # check inputs --------------------------------------------------------------- check_not_missing(x) check_binary(x) @@ -258,6 +271,8 @@ proportion_ci_strat_wilson <- function(x, conf.level = 0.95, max.iterations = 10L, correct = FALSE) { + set_cli_abort_call() + # check inputs --------------------------------------------------------------- check_not_missing(x) check_not_missing(strata) @@ -360,6 +375,7 @@ proportion_ci_strat_wilson <- function(x, #' @seealso [proportion_ci_strat_wilson()] #' #' @keywords internal +#' #' @examples #' strata_data <- table(data.frame( #' "f1" = sample(c(TRUE, FALSE), 100, TRUE), diff --git a/_pkgdown.yml b/_pkgdown.yml index 6c9e147ea..a6cd431cf 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -11,10 +11,10 @@ template: # github: # icon: fa-github # href: https://github.com/insightsengineering/cardx - -development: - mode: auto - version_label: default +# +# development: +# mode: auto +# version_label: default authors: Daniel D. Sjoberg: @@ -24,28 +24,35 @@ reference: - title: "ARD Creation" - subtitle: "Inference" - contents: + - ard_aod_wald_test - ard_car_anova - - ard_chisqtest - - ard_fishertest - - ard_kruskaltest - - ard_moodtest - - ard_mcnemartest - - ard_proptest - - ard_svychisq - - ard_svyttest - - ard_ttest - - ard_wilcoxtest + - ard_stats_anova + - ard_stats_aov + - ard_stats_chisq_test + - ard_stats_fisher_test + - ard_stats_kruskal_test + - ard_stats_mood_test + - ard_stats_mcnemar_test + - ard_stats_oneway_test + - ard_stats_prop_test + - ard_stats_t_test + - ard_stats_wilcox_test + - ard_survey_svychisq + - ard_survey_svyranktest + - ard_survey_svyttest + - ard_survival_survdiff - subtitle: "Estimation" - contents: - - ard_cohens_d - - ard_hedges_g + - ard_car_vif + - ard_effectsize_cohens_d + - ard_effectsize_hedges_g - ard_proportion_ci - ard_regression - ard_regression_basic - - ard_smd - - ard_svycontinuous - - ard_vif + - ard_smd_smd + - ard_survival_survfit + - ard_survey_svycontinuous - title: "Helpers" - contents: diff --git a/inst/WORDLIST b/inst/WORDLIST index c3613546a..4b9ae88ff 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -6,25 +6,32 @@ Clopper Codecov Hoffmann Jeffreys +Kaplan Lifecycle McNemar's Newcombe Rao +Rua Su VIF XG Xin agresti +anova +cli clopper coull +de deff funder jeffreys pearson +pre sd strat vif wald waldcc +wilcox wilson wilsoncc diff --git a/man/ard_aod_wald_test.Rd b/man/ard_aod_wald_test.Rd new file mode 100644 index 000000000..2469ac1ba --- /dev/null +++ b/man/ard_aod_wald_test.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_aod_wald_test.R +\name{ard_aod_wald_test} +\alias{ard_aod_wald_test} +\title{ARD Wald Test} +\usage{ +ard_aod_wald_test(x, ...) +} +\arguments{ +\item{x}{regression model object} + +\item{...}{arguments passed to \code{aod::wald.test(...)}} +} +\value{ +data frame +} +\description{ +Function takes a regression model object and calculates Wald +statistical test using \code{\link[aod:wald.test]{aod::wald.test()}}. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "aod", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +lm(AGE ~ ARM, data = cards::ADSL) |> + ard_aod_wald_test() +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_car_anova.Rd b/man/ard_car_anova.Rd index 0a7df8c1b..3b300f4ad 100644 --- a/man/ard_car_anova.Rd +++ b/man/ard_car_anova.Rd @@ -18,7 +18,7 @@ data frame Function takes a regression model object and calculated ANOVA using \code{\link[car:Anova]{car::Anova()}}. } \examples{ -\dontshow{if (cards::is_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} lm(AGE ~ ARM, data = cards::ADSL) |> ard_car_anova() diff --git a/man/ard_vif.Rd b/man/ard_car_vif.Rd similarity index 58% rename from man/ard_vif.Rd rename to man/ard_car_vif.Rd index ca9b9bd6f..994a3863e 100644 --- a/man/ard_vif.Rd +++ b/man/ard_car_vif.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_vif.R -\name{ard_vif} -\alias{ard_vif} +% Please edit documentation in R/ard_car_vif.R +\name{ard_car_vif} +\alias{ard_car_vif} \title{Regression VIF ARD} \usage{ -ard_vif(x, ...) +ard_car_vif(x, ...) } \arguments{ \item{x}{regression model object @@ -20,6 +20,8 @@ Function takes a regression model object and returns the variance inflation fact using \code{\link[car:vif]{car::vif()}} and converts it to a ARD structure } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "car", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} lm(AGE ~ ARM + SEX, data = cards::ADSL) |> - ard_vif() + ard_car_vif() +\dontshow{\}) # examplesIf} } diff --git a/man/ard_cohens_d.Rd b/man/ard_effectsize_cohens_d.Rd similarity index 68% rename from man/ard_cohens_d.Rd rename to man/ard_effectsize_cohens_d.Rd index f133e8ea5..3eb2ac94e 100644 --- a/man/ard_cohens_d.Rd +++ b/man/ard_effectsize_cohens_d.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_cohens_d.R -\name{ard_cohens_d} -\alias{ard_cohens_d} -\alias{ard_paired_cohens_d} +% Please edit documentation in R/ard_effectsize_cohens_d.R +\name{ard_effectsize_cohens_d} +\alias{ard_effectsize_cohens_d} +\alias{ard_effectsize_paired_cohens_d} \title{ARD Cohen's D Test} \usage{ -ard_cohens_d(data, by, variables, ...) +ard_effectsize_cohens_d(data, by, variables, ...) -ard_paired_cohens_d(data, by, variables, id, ...) +ard_effectsize_paired_cohens_d(data, by, variables, id, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -33,20 +33,20 @@ Analysis results data for paired and non-paired Cohen's D Effect Size Test using \code{\link[effectsize:cohens_d]{effectsize::cohens_d()}}. } \details{ -For the \code{ard_cohens_d()} function, the data is expected to be one row per subject. +For the \code{ard_effectsize_cohens_d()} function, the data is expected to be one row per subject. The data is passed as \code{effectsize::cohens_d(data[[variable]]~data[[by]], data, paired = FALSE, ...)}. -For the \code{ard_paired_cohens_d()} function, the data is expected to be one row +For the \code{ard_effectsize_paired_cohens_d()} function, the data is expected to be one row per subject per by level. Before the effect size is calculated, the data are reshaped to a wide format to be one row per subject. The data are then passed as \verb{effectsize::cohens_d(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. } \examples{ -\dontshow{if (cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = 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, variables = AGE) + ard_effectsize_cohens_d(by = ARM, variables = AGE) # constructing a paired data set, # where patients receive both treatments @@ -56,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, variables = AGE, id = USUBJID) + ard_effectsize_paired_cohens_d(by = ARM, variables = AGE, id = USUBJID) \dontshow{\}) # examplesIf} } diff --git a/man/ard_hedges_g.Rd b/man/ard_effectsize_hedges_g.Rd similarity index 68% rename from man/ard_hedges_g.Rd rename to man/ard_effectsize_hedges_g.Rd index 9e4f47509..5ec59117a 100644 --- a/man/ard_hedges_g.Rd +++ b/man/ard_effectsize_hedges_g.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_hedges_g.R -\name{ard_hedges_g} -\alias{ard_hedges_g} -\alias{ard_paired_hedges_g} +% Please edit documentation in R/ard_effectsize_hedges_g.R +\name{ard_effectsize_hedges_g} +\alias{ard_effectsize_hedges_g} +\alias{ard_effectsize_paired_hedges_g} \title{ARD Hedge's G Test} \usage{ -ard_hedges_g(data, by, variables, ...) +ard_effectsize_hedges_g(data, by, variables, ...) -ard_paired_hedges_g(data, by, variables, id, ...) +ard_effectsize_paired_hedges_g(data, by, variables, id, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -33,20 +33,20 @@ Analysis results data for paired and non-paired Hedge's G Effect Size Test using \code{\link[effectsize:cohens_d]{effectsize::hedges_g()}}. } \details{ -For the \code{ard_hedges_g()} function, the data is expected to be one row per subject. +For the \code{ard_effectsize_hedges_g()} function, the data is expected to be one row per subject. The data is passed as \code{effectsize::hedges_g(data[[variable]]~data[[by]], data, paired = FALSE, ...)}. -For the \code{ard_paired_hedges_g()} function, the data is expected to be one row +For the \code{ard_effectsize_paired_hedges_g()} function, the data is expected to be one row per subject per by level. Before the effect size is calculated, the data are reshaped to a wide format to be one row per subject. The data are then passed as \verb{effectsize::hedges_g(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. } \examples{ -\dontshow{if (cards::is_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters", "withr"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> - ard_hedges_g(by = ARM, variables = AGE) + ard_effectsize_hedges_g(by = ARM, variables = AGE) # constructing a paired data set, # where patients receive both treatments @@ -56,6 +56,6 @@ cards::ADSL[c("ARM", "AGE")] |> dplyr::arrange(USUBJID, ARM) |> dplyr::group_by(USUBJID) |> dplyr::filter(dplyr::n() > 1) |> - ard_paired_hedges_g(by = ARM, variables = AGE, id = USUBJID) + ard_effectsize_paired_hedges_g(by = ARM, variables = AGE, id = USUBJID) \dontshow{\}) # examplesIf} } diff --git a/man/ard_proportion_ci.Rd b/man/ard_proportion_ci.Rd index 2d3ea6a9f..50349110b 100644 --- a/man/ard_proportion_ci.Rd +++ b/man/ard_proportion_ci.Rd @@ -47,7 +47,7 @@ an ARD data frame Calculate confidence intervals for proportions. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} ard_proportion_ci(mtcars, variables = c(vs, am), method = "wilson") \dontshow{\}) # examplesIf} } diff --git a/man/ard_regression.Rd b/man/ard_regression.Rd index db2077c48..10b423c69 100644 --- a/man/ard_regression.Rd +++ b/man/ard_regression.Rd @@ -25,7 +25,7 @@ Function takes a regression model object and converts it to a ARD structure using the \code{broom.helpers} package. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} lm(AGE ~ ARM, data = cards::ADSL) |> ard_regression(add_estimate_to_reference_rows = TRUE) \dontshow{\}) # examplesIf} diff --git a/man/ard_regression_basic.Rd b/man/ard_regression_basic.Rd index f2a2be0c1..8d500a6b3 100644 --- a/man/ard_regression_basic.Rd +++ b/man/ard_regression_basic.Rd @@ -44,7 +44,7 @@ The default arguments used are }\if{html}{\out{}} } \examples{ -\dontshow{if (cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} lm(AGE ~ ARM, data = cards::ADSL) |> ard_regression_basic() \dontshow{\}) # examplesIf} diff --git a/man/ard_smd.Rd b/man/ard_smd_smd.Rd similarity index 70% rename from man/ard_smd.Rd rename to man/ard_smd_smd.Rd index 046f2826b..27ffee4e4 100644 --- a/man/ard_smd.Rd +++ b/man/ard_smd_smd.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_smd.R -\name{ard_smd} -\alias{ard_smd} +% Please edit documentation in R/ard_smd_smd.R +\name{ard_smd_smd} +\alias{ard_smd_smd} \title{ARD Standardized Mean Difference} \usage{ -ard_smd(data, by, variables, ...) +ard_smd_smd(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame}/\code{survey.design})\cr @@ -34,8 +34,8 @@ ARD data frame Standardized mean difference calculated via \code{\link[smd:smd]{smd::smd()}} with \code{na.rm = TRUE}. } \examples{ -\dontshow{if (cards::is_pkg_installed("smd", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -ard_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE) -ard_smd(cards::ADSL, by = ARM, variables = AGEGR1, std.error = TRUE) +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "smd", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +ard_smd_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE) +ard_smd_smd(cards::ADSL, by = ARM, variables = AGEGR1, std.error = TRUE) \dontshow{\}) # examplesIf} } diff --git a/man/ard_stats_anova.Rd b/man/ard_stats_anova.Rd new file mode 100644 index 000000000..9e71a91df --- /dev/null +++ b/man/ard_stats_anova.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_anova.R +\name{ard_stats_anova} +\alias{ard_stats_anova} +\alias{ard_stats_anova.anova} +\alias{ard_stats_anova.data.frame} +\title{ARD ANOVA} +\usage{ +ard_stats_anova(x, ...) + +\method{ard_stats_anova}{anova}(x, method = "ANOVA results from `stats::anova()`", ...) + +\method{ard_stats_anova}{data.frame}( + x, + formulas, + fn, + fn.args = list(), + package = "base", + method = "ANOVA results from `stats::anova()`", + ... +) +} +\arguments{ +\item{x}{(\code{anova} or \code{data.frame})\cr +an object of class \code{'anova'} created with \code{stats::anova()} or +a data frame} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{method}{(\code{string})\cr +string of the method used. Default is \verb{"ANOVA results from }stats::anova()\verb{"}. +We provide the option to change this as \code{stats::anova()} can produce +results from many types of models that may warrant a more precise +description.} + +\item{formulas}{(\code{list})\cr +a list of formulas} + +\item{fn}{(\code{string})\cr +string naming the function to be called, e.g. \code{"glm"}. +If function belongs to a library that is not attached, the package name +must be specified in the \code{package} argument.} + +\item{fn.args}{(named \code{list})\cr +named list of arguments that will be passed to \code{fn}.} + +\item{package}{(\code{string})\cr +string of package name that will be temporarily loaded when function +specified in \code{method} is executed.} +} +\value{ +ARD data frame +} +\description{ +Prepare ANOVA results from the \code{stats::anova()} function. +Users may pass a pre-calculated \code{stats::anova()} object or a list of +formulas. In the latter case, the models will be constructed using the +information passed and models will be passed to \code{stats::anova()}. +} +\details{ +When a list of formulas is supplied to \code{ard_stats_anova()}, these formulas +along with information from other arguments, are used to construct models +and pass those models to \code{stats::anova()}. + +The models are constructed using \code{rlang::exec()}, which is similar to \code{do.call()}. + +\if{html}{\out{
}}\preformatted{rlang::exec(.fn = fn, formula = formula, data = data, !!!fn.args) +}\if{html}{\out{
}} + +The above function is executed in \code{withr::with_namespace(package)}, which +allows for the use of \code{ard_stats_anova(fn)} from packages, +e.g. \code{package = 'lme4'} must be specified when \code{fn = 'glmer'}. +See example below. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom", "withr", "lme4"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +anova( + lm(mpg ~ am, mtcars), + lm(mpg ~ am + hp, mtcars) +) |> + ard_stats_anova() + +ard_stats_anova( + x = mtcars, + formulas = list(am ~ mpg, am ~ mpg + hp), + fn = "glm", + fn.args = list(family = binomial) +) + +ard_stats_anova( + x = mtcars, + formulas = list(am ~ 1 + (1 | vs), am ~ mpg + (1 | vs)), + fn = "glmer", + fn.args = list(family = binomial), + package = "lme4" +) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_stats_aov.Rd b/man/ard_stats_aov.Rd new file mode 100644 index 000000000..c38d1a37e --- /dev/null +++ b/man/ard_stats_aov.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_aov.R +\name{ard_stats_aov} +\alias{ard_stats_aov} +\title{ARD ANOVA} +\usage{ +ard_stats_aov(formula, data, ...) +} +\arguments{ +\item{formula}{A formula specifying the model.} + +\item{data}{A data frame in which the variables specified in the + formula will be found. If missing, the variables are searched for in + the standard way.} + +\item{...}{arguments passed to \code{stats::aov(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for Analysis of Variance. +Calculated with \code{stats::aov()} +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +ard_stats_aov(AGE ~ ARM, data = cards::ADSL) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_chisqtest.Rd b/man/ard_stats_chisq_test.Rd similarity index 63% rename from man/ard_chisqtest.Rd rename to man/ard_stats_chisq_test.Rd index da1a7f1ca..5dc96cb67 100644 --- a/man/ard_chisqtest.Rd +++ b/man/ard_stats_chisq_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_chisqtest.R -\name{ard_chisqtest} -\alias{ard_chisqtest} +% Please edit documentation in R/ard_stats_chisq_test.R +\name{ard_stats_chisq_test} +\alias{ard_stats_chisq_test} \title{ARD Chi-squared Test} \usage{ -ard_chisqtest(data, by, variables, ...) +ard_stats_chisq_test(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -27,8 +27,8 @@ Analysis results data for Pearson's Chi-squared Test. Calculated with \code{chisq.test(x = data[[variable]], y = data[[by]], ...)} } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> - ard_chisqtest(by = "ARM", variables = "AGEGR1") + ard_stats_chisq_test(by = "ARM", variables = "AGEGR1") \dontshow{\}) # examplesIf} } diff --git a/man/ard_fishertest.Rd b/man/ard_stats_fisher_test.Rd similarity index 63% rename from man/ard_fishertest.Rd rename to man/ard_stats_fisher_test.Rd index 7fafb357e..1e07809b0 100644 --- a/man/ard_fishertest.Rd +++ b/man/ard_stats_fisher_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_fishertest.R -\name{ard_fishertest} -\alias{ard_fishertest} +% Please edit documentation in R/ard_stats_fisher_test.R +\name{ard_stats_fisher_test} +\alias{ard_stats_fisher_test} \title{ARD Fisher's Exact Test} \usage{ -ard_fishertest(data, by, variables, ...) +ard_stats_fisher_test(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -27,8 +27,8 @@ Analysis results data for Fisher's Exact Test. Calculated with \code{fisher.test(x = data[[variable]], y = data[[by]], ...)} } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL[1:30, ] |> - ard_fishertest(by = "ARM", variables = "AGEGR1") + ard_stats_fisher_test(by = "ARM", variables = "AGEGR1") \dontshow{\}) # examplesIf} } diff --git a/man/ard_kruskaltest.Rd b/man/ard_stats_kruskal_test.Rd similarity index 61% rename from man/ard_kruskaltest.Rd rename to man/ard_stats_kruskal_test.Rd index 341ef739a..e9f4596cb 100644 --- a/man/ard_kruskaltest.Rd +++ b/man/ard_stats_kruskal_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_kruskaltest.R -\name{ard_kruskaltest} -\alias{ard_kruskaltest} +% Please edit documentation in R/ard_stats_kruskal_test.R +\name{ard_stats_kruskal_test} +\alias{ard_stats_kruskal_test} \title{ARD Kruskal-Wallis Test} \usage{ -ard_kruskaltest(data, by, variables) +ard_stats_kruskal_test(data, by, variables) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -26,8 +26,8 @@ Analysis results data for Kruskal-Wallis Rank Sum Test. Calculated with \code{kruskal.test(data[[variable]], data[[by]], ...)} } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> - ard_kruskaltest(by = "ARM", variables = "AGE") + ard_stats_kruskal_test(by = "ARM", variables = "AGE") \dontshow{\}) # examplesIf} } diff --git a/man/ard_mcnemartest.Rd b/man/ard_stats_mcnemar_test.Rd similarity index 62% rename from man/ard_mcnemartest.Rd rename to man/ard_stats_mcnemar_test.Rd index 8bbcf6915..0f1327b8b 100644 --- a/man/ard_mcnemartest.Rd +++ b/man/ard_stats_mcnemar_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_mcnemartest.R -\name{ard_mcnemartest} -\alias{ard_mcnemartest} +% Please edit documentation in R/ard_stats_mcnemar_test.R +\name{ard_stats_mcnemar_test} +\alias{ard_stats_mcnemar_test} \title{ARD McNemar's Test} \usage{ -ard_mcnemartest(data, by, variables, ...) +ard_stats_mcnemar_test(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -26,13 +26,13 @@ ARD data frame Analysis results data for McNemar's statistical test. } \details{ -For the \code{ard_mcnemartest()} function, the data is expected to be one row per subject. +For the \code{ard_stats_mcnemar_test()} function, the data is expected to be one row per subject. The data is passed as \code{stats::mcnemar.test(x = data[[variable]], y = data[[by]], ...)}. Please use \code{table(x = data[[variable]], y = data[[by]])} to check the contingency table. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> - ard_mcnemartest(by = "SEX", variables = "EFFFL") + ard_stats_mcnemar_test(by = "SEX", variables = "EFFFL") \dontshow{\}) # examplesIf} } diff --git a/man/ard_moodtest.Rd b/man/ard_stats_mood_test.Rd similarity index 61% rename from man/ard_moodtest.Rd rename to man/ard_stats_mood_test.Rd index 8af20f89f..5a06c6c76 100644 --- a/man/ard_moodtest.Rd +++ b/man/ard_stats_mood_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_moodtest.R -\name{ard_moodtest} -\alias{ard_moodtest} +% Please edit documentation in R/ard_stats_mood_test.R +\name{ard_stats_mood_test} +\alias{ard_stats_mood_test} \title{ARD Mood Test} \usage{ -ard_moodtest(data, by, variables, ...) +ard_stats_mood_test(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -27,12 +27,12 @@ Analysis results data for Mood two sample test of scale. Note this not to be con the Brown-Mood test of medians. } \details{ -For the \code{ard_moodtest()} function, the data is expected to be one row per subject. +For the \code{ard_stats_mood_test()} function, the data is expected to be one row per subject. The data is passed as \code{mood.test(data[[variable]] ~ data[[by]], ...)}. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> - ard_moodtest(by = "SEX", variables = "AGE") + ard_stats_mood_test(by = "SEX", variables = "AGE") \dontshow{\}) # examplesIf} } diff --git a/man/ard_stats_oneway_test.Rd b/man/ard_stats_oneway_test.Rd new file mode 100644 index 000000000..439fb9c3f --- /dev/null +++ b/man/ard_stats_oneway_test.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_oneway_test.R +\name{ard_stats_oneway_test} +\alias{ard_stats_oneway_test} +\title{ARD One-way Test} +\usage{ +ard_stats_oneway_test(formula, data, ...) +} +\arguments{ +\item{formula}{a formula of the form \code{lhs ~ rhs} where \code{lhs} + gives the sample values and \code{rhs} the corresponding groups.} + +\item{data}{an optional matrix or data frame (or similar: see + \code{\link[stats]{model.frame}}) containing the variables in the + formula \code{formula}. By default the variables are taken from + \code{environment(formula)}.} + +\item{...}{additional arguments passed to \code{oneway.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for Testing Equal Means in a One-Way Layout. +calculated with \code{oneway.test()} +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +ard_stats_oneway_test(AGE ~ ARM, data = cards::ADSL) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_proptest.Rd b/man/ard_stats_prop_test.Rd similarity index 66% rename from man/ard_proptest.Rd rename to man/ard_stats_prop_test.Rd index 3fa0add66..cb966e1c4 100644 --- a/man/ard_proptest.Rd +++ b/man/ard_stats_prop_test.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_proptest.R -\name{ard_proptest} -\alias{ard_proptest} +% Please edit documentation in R/ard_stats_prop_test.R +\name{ard_stats_prop_test} +\alias{ard_stats_prop_test} \title{ARD 2-sample proportion test} \usage{ -ard_proptest(data, by, variables, ...) +ard_stats_prop_test(data, by, variables, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -26,8 +26,8 @@ ARD data frame Analysis results data for a 2-sample test or proportions using \code{\link[stats:prop.test]{stats::prop.test()}}. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} mtcars |> - ard_proptest(by = vs, variables = am) + ard_stats_prop_test(by = vs, variables = am) \dontshow{\}) # examplesIf} } diff --git a/man/ard_ttest.Rd b/man/ard_stats_t_test.Rd similarity index 66% rename from man/ard_ttest.Rd rename to man/ard_stats_t_test.Rd index 78951dd5d..1bfb7fbe9 100644 --- a/man/ard_ttest.Rd +++ b/man/ard_stats_t_test.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_ttest.R -\name{ard_ttest} -\alias{ard_ttest} -\alias{ard_paired_ttest} +% Please edit documentation in R/ard_stats_t_test.R +\name{ard_stats_t_test} +\alias{ard_stats_t_test} +\alias{ard_stats_paired_t_test} \title{ARD t-test} \usage{ -ard_ttest(data, variables, by = NULL, ...) +ard_stats_t_test(data, variables, by = NULL, ...) -ard_paired_ttest(data, by, variables, id, ...) +ard_stats_paired_t_test(data, by, variables, id, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -32,20 +32,20 @@ ARD data frame Analysis results data for paired and non-paired t-tests. } \details{ -For the \code{ard_ttest()} function, the data is expected to be one row per subject. +For the \code{ard_stats_t_test()} function, the data is expected to be one row per subject. The data is passed as \code{t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)}. -For the \code{ard_paired_ttest()} function, the data is expected to be one row +For the \code{ard_stats_paired_t_test()} function, the data is expected to be one row per subject per by level. Before the t-test is calculated, the data are reshaped to a wide format to be one row per subject. The data are then passed as \verb{t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> - ard_ttest(by = ARM, variables = c(AGE, BMIBL)) + ard_stats_t_test(by = ARM, variables = c(AGE, BMIBL)) # constructing a paired data set, # where patients receive both treatments @@ -53,6 +53,6 @@ cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> dplyr::arrange(USUBJID, ARM) |> - ard_paired_ttest(by = ARM, variables = AGE, id = USUBJID) + ard_stats_paired_t_test(by = ARM, variables = AGE, id = USUBJID) \dontshow{\}) # examplesIf} } diff --git a/man/ard_wilcoxtest.Rd b/man/ard_stats_wilcox_test.Rd similarity index 66% rename from man/ard_wilcoxtest.Rd rename to man/ard_stats_wilcox_test.Rd index f1619625e..14f48b213 100644 --- a/man/ard_wilcoxtest.Rd +++ b/man/ard_stats_wilcox_test.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_wilcoxtest.R -\name{ard_wilcoxtest} -\alias{ard_wilcoxtest} -\alias{ard_paired_wilcoxtest} +% Please edit documentation in R/ard_stats_wilcox_test.R +\name{ard_stats_wilcox_test} +\alias{ard_stats_wilcox_test} +\alias{ard_stats_paired_wilcox_test} \title{ARD Wilcoxon Rank-Sum Test} \usage{ -ard_wilcoxtest(data, variables, by = NULL, ...) +ard_stats_wilcox_test(data, variables, by = NULL, ...) -ard_paired_wilcoxtest(data, by, variables, id, ...) +ard_stats_paired_wilcox_test(data, by, variables, id, ...) } \arguments{ \item{data}{(\code{data.frame})\cr @@ -32,20 +32,20 @@ ARD data frame Analysis results data for paired and non-paired Wilcoxon Rank-Sum tests. } \details{ -For the \code{ard_wilcoxtest()} function, the data is expected to be one row per subject. +For the \code{ard_stats_wilcox_test()} function, the data is expected to be one row per subject. The data is passed as \code{wilcox.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)}. -For the \code{ard_paired_wilcoxtest()} function, the data is expected to be one row +For the \code{ard_stats_paired_wilcox_test()} function, the data is expected to be one row per subject per by level. Before the test is calculated, the data are reshaped to a wide format to be one row per subject. The data are then passed as \verb{wilcox.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. } \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cards::ADSL |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> - ard_wilcoxtest(by = "ARM", variables = "AGE") + ard_stats_wilcox_test(by = "ARM", variables = "AGE") # constructing a paired data set, # where patients receive both treatments @@ -53,6 +53,6 @@ cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> dplyr::arrange(USUBJID, ARM) |> - ard_paired_wilcoxtest(by = ARM, variables = AGE, id = USUBJID) + ard_stats_paired_wilcox_test(by = ARM, variables = AGE, id = USUBJID) \dontshow{\}) # examplesIf} } diff --git a/man/ard_svychisq.Rd b/man/ard_survey_svychisq.Rd similarity index 71% rename from man/ard_svychisq.Rd rename to man/ard_survey_svychisq.Rd index 9206ff03c..e645f5c00 100644 --- a/man/ard_svychisq.Rd +++ b/man/ard_survey_svychisq.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_svychisq.R -\name{ard_svychisq} -\alias{ard_svychisq} +% Please edit documentation in R/ard_survey_svychisq.R +\name{ard_survey_svychisq} +\alias{ard_survey_svychisq} \title{ARD Survey Chi-Square Test} \usage{ -ard_svychisq(data, by, variables, statistic = "F", ...) +ard_survey_svychisq(data, by, variables, statistic = "F", ...) } \arguments{ \item{data}{(\code{survey.design})\cr @@ -32,10 +32,10 @@ Analysis results data for survey Chi-Square test using \code{\link[survey:svychi Only two-way comparisons are supported. } \examples{ -\dontshow{if (cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) -ard_svychisq(dclus1, variables = sch.wide, by = comp.imp, statistic = "F") +ard_survey_svychisq(dclus1, variables = sch.wide, by = comp.imp, statistic = "F") \dontshow{\}) # examplesIf} } diff --git a/man/ard_svycontinuous.Rd b/man/ard_survey_svycontinuous.Rd similarity index 85% rename from man/ard_svycontinuous.Rd rename to man/ard_survey_svycontinuous.Rd index 8e13d8a63..8e5df93d2 100644 --- a/man/ard_svycontinuous.Rd +++ b/man/ard_survey_svycontinuous.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_svycontinuous.R -\name{ard_svycontinuous} -\alias{ard_svycontinuous} +% Please edit documentation in R/ard_survey_svycontinuous.R +\name{ard_survey_svycontinuous} +\alias{ard_survey_svycontinuous} \title{ARD Continuous Survey Statistics} \usage{ -ard_svycontinuous( +ard_survey_svycontinuous( data, variables, by = NULL, @@ -56,11 +56,11 @@ where 'p##' is are the percentiles and \verb{##} is an integer between 0 and 100 } \examples{ -\dontshow{if (cards::is_pkg_installed("survey", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) -ard_svycontinuous( +ard_survey_svycontinuous( data = dclus1, variables = api00, by = stype diff --git a/man/ard_survey_svyranktest.Rd b/man/ard_survey_svyranktest.Rd new file mode 100644 index 000000000..e42c17620 --- /dev/null +++ b/man/ard_survey_svyranktest.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survey_svyranktest.R +\name{ard_survey_svyranktest} +\alias{ard_survey_svyranktest} +\title{ARD Survey rank test} +\usage{ +ard_survey_svyranktest(data, by, variables, test, ...) +} +\arguments{ +\item{data}{(\code{survey.design})\cr +a survey design object often created with \code{\link[survey:svydesign]{survey::svydesign()}}} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column name to compare by} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be compared. Independent tests will be run for each variable.} + +\item{test}{(\code{string})\cr +a string to denote which rank test to use: +\code{"wilcoxon"}, \code{"vanderWaerden"}, \code{"median"}, \code{"KruskalWallis"}} + +\item{...}{arguments passed to \code{\link[survey:svyranktest]{survey::svyranktest()}}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for survey wilcox test using \code{\link[survey:svyranktest]{survey::svyranktest()}}. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(api, package = "survey") +dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) + +ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "wilcoxon") +ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "vanderWaerden") +ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "median") +ard_survey_svyranktest(dclus2, variables = enroll, by = comp.imp, test = "KruskalWallis") +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_svyttest.Rd b/man/ard_survey_svyttest.Rd similarity index 69% rename from man/ard_svyttest.Rd rename to man/ard_survey_svyttest.Rd index b29f806b9..b305f4912 100644 --- a/man/ard_svyttest.Rd +++ b/man/ard_survey_svyttest.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_svyttest.R -\name{ard_svyttest} -\alias{ard_svyttest} +% Please edit documentation in R/ard_survey_svyttest.R +\name{ard_survey_svyttest} +\alias{ard_survey_svyttest} \title{ARD Survey t-test} \usage{ -ard_svyttest(data, by, variables, conf.level = 0.95, ...) +ard_survey_svyttest(data, by, variables, conf.level = 0.95, ...) } \arguments{ \item{data}{(\code{survey.design})\cr @@ -29,10 +29,10 @@ ARD data frame Analysis results data for survey t-test using \code{\link[survey:svyttest]{survey::svyttest()}}. } \examples{ -\dontshow{if (cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survey", "broom"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(api, package = "survey") dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) -ard_svyttest(dclus2, variables = enroll, by = comp.imp, conf.level = 0.9) +ard_survey_svyttest(dclus2, variables = enroll, by = comp.imp, conf.level = 0.9) \dontshow{\}) # examplesIf} } diff --git a/man/ard_survival_survdiff.Rd b/man/ard_survival_survdiff.Rd new file mode 100644 index 000000000..49478e5d7 --- /dev/null +++ b/man/ard_survival_survdiff.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survdiff.R +\name{ard_survival_survdiff} +\alias{ard_survival_survdiff} +\title{ARD for Difference in Survival} +\usage{ +ard_survival_survdiff(formula, data, rho = 0, ...) +} +\arguments{ +\item{formula}{(\code{formula})\cr +a formula} + +\item{data}{(\code{data.frame})\cr +a data frame} + +\item{rho}{(\verb{scalar numeric})\cr +numeric scalar passed to \code{survival::survdiff(rho)}. Default is \code{rho=0}.} + +\item{...}{additional arguments passed to \code{survival::survdiff()}} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Analysis results data for comparison of survival using \code{\link[survival:survdiff]{survival::survdiff()}}. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom", "ggsurvfit"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(survival) +library(ggsurvfit) + +ard_survival_survdiff(Surv_CNSR(AVAL, CNSR) ~ TRTA, data = cards::ADTTE) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_survival_survfit.Rd b/man/ard_survival_survfit.Rd new file mode 100644 index 000000000..c5f396197 --- /dev/null +++ b/man/ard_survival_survfit.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survfit.R +\name{ard_survival_survfit} +\alias{ard_survival_survfit} +\title{ARD Survival Estimates} +\usage{ +ard_survival_survfit(x, times = NULL, probs = NULL, type = NULL) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{times}{(\code{numeric})\cr +a vector of times for which to return survival probabilities.} + +\item{probs}{(\code{numeric})\cr +a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} + +\item{type}{(\code{string} or \code{NULL})\cr +type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} +is ignored. Default is \code{NULL}. +Must be one of the following:\tabular{ll}{ + type \tab transformation \cr + \code{"survival"} \tab \code{x} \cr + \code{"risk"} \tab \code{1 - x} \cr + \code{"cumhaz"} \tab \code{-log(x)} \cr +}} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Analysis results data for survival quantiles and x-year survival estimates, extracted +from a \code{\link[survival:survfit]{survival::survfit()}} model. +} +\details{ +\itemize{ +\item Only one of either the \code{times} or \code{probs} parameters can be specified. +\item Times should be provided using the same scale as the time variable used to fit the provided +survival fit model. +} +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom", "ggsurvfit"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(survival) +library(ggsurvfit) + +survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = c(60, 180)) + +survfit(Surv_CNSR(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(probs = c(0.25, 0.5, 0.75)) + +# Competing Risks Example --------------------------- +set.seed(1) +ADTTE_MS <- cards::ADTTE \%>\% + dplyr::mutate( + CNSR = dplyr::case_when( + CNSR == 0 ~ "censor", + runif(dplyr::n()) < 0.5 ~ "death from cancer", + TRUE ~ "death other causes" + ) \%>\% factor() + ) + +survfit(Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) \%>\% + ard_survival_survfit(times = c(60, 180)) +\dontshow{\}) # examplesIf} +} diff --git a/man/cardx-package.Rd b/man/cardx-package.Rd index 545747c76..2afc46c23 100644 --- a/man/cardx-package.Rd +++ b/man/cardx-package.Rd @@ -24,6 +24,7 @@ Useful links: Authors: \itemize{ \item Abinaya Yogasekaram \email{abinaya.yogasekaram@contractors.roche.com} + \item Emily de la Rua \email{emily.de_la_rua@contractors.roche.com} } Other contributors: diff --git a/man/dot-extract_wald_results.Rd b/man/dot-extract_wald_results.Rd new file mode 100644 index 000000000..24b23eb78 --- /dev/null +++ b/man/dot-extract_wald_results.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_aod_wald_test.R +\name{.extract_wald_results} +\alias{.extract_wald_results} +\title{Extract data from wald.test object} +\usage{ +.extract_wald_results(wald_test) +} +\arguments{ +\item{wald_test}{(\code{data.frame})\cr wald test object object from \code{aod::wald.test()}} +} +\value{ +a data frame containing the wald test results. +} +\description{ +Extract data from wald.test object +} +\keyword{internal} diff --git a/man/dot-format_cohens_d_results.Rd b/man/dot-format_cohens_d_results.Rd index 1d6dec528..20edfa95e 100644 --- a/man/dot-format_cohens_d_results.Rd +++ b/man/dot-format_cohens_d_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_cohens_d.R +% Please edit documentation in R/ard_effectsize_cohens_d.R \name{.format_cohens_d_results} \alias{.format_cohens_d_results} \title{Convert Cohen's D Test to ARD} @@ -28,6 +28,7 @@ ARD data frame Convert Cohen's D Test to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cardx:::.format_cohens_d_results( by = "ARM", variable = "AGE", @@ -38,5 +39,6 @@ cardx:::.format_cohens_d_results( parameters::standardize_names(style = "broom") ) ) +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-format_hedges_g_results.Rd b/man/dot-format_hedges_g_results.Rd index 95deb3ee9..d22e5b762 100644 --- a/man/dot-format_hedges_g_results.Rd +++ b/man/dot-format_hedges_g_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_hedges_g.R +% Please edit documentation in R/ard_effectsize_hedges_g.R \name{.format_hedges_g_results} \alias{.format_hedges_g_results} \title{Convert Hedge's G Test to ARD} @@ -28,6 +28,7 @@ ARD data frame Convert Hedge's G Test to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("effectsize", "parameters"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cardx:::.format_hedges_g_results( by = "ARM", variable = "AGE", @@ -38,5 +39,6 @@ cardx:::.format_hedges_g_results( parameters::standardize_names(style = "broom") ) ) +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-format_mcnemartest_results.Rd b/man/dot-format_mcnemartest_results.Rd index a809a791c..a373a3f6b 100644 --- a/man/dot-format_mcnemartest_results.Rd +++ b/man/dot-format_mcnemartest_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_mcnemartest.R +% Please edit documentation in R/ard_stats_mcnemar_test.R \name{.format_mcnemartest_results} \alias{.format_mcnemartest_results} \title{Convert McNemar's test to ARD} @@ -24,6 +24,7 @@ ARD data frame Convert McNemar's test to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cardx:::.format_mcnemartest_results( by = "ARM", variable = "AGE", @@ -33,6 +34,6 @@ cardx:::.format_mcnemartest_results( broom::tidy() ) ) - +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-format_moodtest_results.Rd b/man/dot-format_moodtest_results.Rd index 95cae344e..a3be12b12 100644 --- a/man/dot-format_moodtest_results.Rd +++ b/man/dot-format_moodtest_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_moodtest.R +% Please edit documentation in R/ard_stats_mood_test.R \name{.format_moodtest_results} \alias{.format_moodtest_results} \title{Convert mood test results to ARD} @@ -24,6 +24,7 @@ ARD data frame Convert mood test results to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cardx:::.format_moodtest_results( by = "SEX", variable = "AGE", @@ -33,5 +34,6 @@ cardx:::.format_moodtest_results( broom::tidy() ) ) +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-format_proptest_results.Rd b/man/dot-format_proptest_results.Rd index 8719c7275..05c97ef24 100644 --- a/man/dot-format_proptest_results.Rd +++ b/man/dot-format_proptest_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_proptest.R +% Please edit documentation in R/ard_stats_prop_test.R \name{.format_proptest_results} \alias{.format_proptest_results} \title{Convert prop.test to ARD} diff --git a/man/dot-format_survfit_results.Rd b/man/dot-format_survfit_results.Rd new file mode 100644 index 000000000..0e52d8fe4 --- /dev/null +++ b/man/dot-format_survfit_results.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survfit.R +\name{.format_survfit_results} +\alias{.format_survfit_results} +\title{Convert Tidied Survival Fit to ARD} +\usage{ +.format_survfit_results(tidy_survfit) +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Convert Tidied Survival Fit to ARD +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +cardx:::.format_survfit_results( + broom::tidy(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +) +\dontshow{\}) # examplesIf} +} +\keyword{internal} diff --git a/man/dot-format_ttest_results.Rd b/man/dot-format_ttest_results.Rd index d8304df9f..5896cc6d5 100644 --- a/man/dot-format_ttest_results.Rd +++ b/man/dot-format_ttest_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_ttest.R +% Please edit documentation in R/ard_stats_t_test.R \name{.format_ttest_results} \alias{.format_ttest_results} \title{Convert t-test to ARD} @@ -27,6 +27,7 @@ ARD data frame Convert t-test to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} cardx:::.format_ttest_results( by = "ARM", variable = "AGE", @@ -37,5 +38,6 @@ cardx:::.format_ttest_results( broom::tidy() ) ) +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-format_wilcoxtest_results.Rd b/man/dot-format_wilcoxtest_results.Rd index 69fde1ef4..ad4cbd2fe 100644 --- a/man/dot-format_wilcoxtest_results.Rd +++ b/man/dot-format_wilcoxtest_results.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_wilcoxtest.R +% Please edit documentation in R/ard_stats_wilcox_test.R \name{.format_wilcoxtest_results} \alias{.format_wilcoxtest_results} \title{Convert Wilcoxon test to ARD} @@ -26,10 +26,11 @@ ARD data frame Convert Wilcoxon test to ARD } \examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Pre-processing ADSL to have grouping factor (ARM here) with 2 levels ADSL <- cards::ADSL |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> - ard_wilcoxtest(by = "ARM", variables = "AGE") + ard_stats_wilcox_test(by = "ARM", variables = "AGE") cardx:::.format_wilcoxtest_results( by = "ARM", @@ -41,6 +42,6 @@ cardx:::.format_wilcoxtest_results( broom::tidy() ) ) - +\dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/dot-paired_data_pivot_wider.Rd b/man/dot-paired_data_pivot_wider.Rd index a73b469e3..e51632add 100644 --- a/man/dot-paired_data_pivot_wider.Rd +++ b/man/dot-paired_data_pivot_wider.Rd @@ -1,12 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_ttest.R, R/ard_wilcoxtest.R +% Please edit documentation in R/ard_stats_t_test.R \name{.paired_data_pivot_wider} \alias{.paired_data_pivot_wider} \title{Convert long paired data to wide} \usage{ -.paired_data_pivot_wider(data, by, variable, id, env = rlang::caller_env()) - -.paired_data_pivot_wider(data, by, variable, id, env = rlang::caller_env()) +.paired_data_pivot_wider(data, by, variable, id) } \arguments{ \item{data}{(\code{data.frame})\cr a data frame that is one line per subject per group} @@ -16,25 +14,14 @@ \item{variable}{(\code{string})\cr variable column name} \item{id}{(\code{string})\cr subject id column name} - -\item{env}{(\code{environment}) used for error messaging. Default is \code{rlang::caller_env()}} } \value{ -a wide data frame - a wide data frame } \description{ -Convert long paired data to wide - Convert long paired data to wide } \examples{ -cards::ADSL[c("ARM", "AGE")] |> - dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> - dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> - dplyr::arrange(USUBJID, ARM) |> - cardx:::.paired_data_pivot_wider(by = "ARM", variable = "AGE", id = "USUBJID") cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM \%in\% c("Placebo", "Xanomeline High Dose")) |> dplyr::mutate(.by = ARM, USUBJID = dplyr::row_number()) |> diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd new file mode 100644 index 000000000..036f9039f --- /dev/null +++ b/man/dot-process_survfit_probs.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survfit.R +\name{.process_survfit_probs} +\alias{.process_survfit_probs} +\title{Process Survival Fit For Quantile Estimates} +\usage{ +.process_survfit_probs(x, probs) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{probs}{(\code{numeric})\cr +a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} +} +\value{ +a \code{tibble} +} +\description{ +Process Survival Fit For Quantile Estimates +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survival", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) +\dontshow{\}) # examplesIf} +} +\keyword{internal} diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd new file mode 100644 index 000000000..c6f9bee25 --- /dev/null +++ b/man/dot-process_survfit_time.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survfit.R +\name{.process_survfit_time} +\alias{.process_survfit_time} +\title{Process Survival Fit For Time Estimates} +\usage{ +.process_survfit_time(x, times, type) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{times}{(\code{numeric})\cr +a vector of times for which to return survival probabilities.} + +\item{type}{(\code{string} or \code{NULL})\cr +type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} +is ignored. Default is \code{NULL}. +Must be one of the following:\tabular{ll}{ + type \tab transformation \cr + \code{"survival"} \tab \code{x} \cr + \code{"risk"} \tab \code{1 - x} \cr + \code{"cumhaz"} \tab \code{-log(x)} \cr +}} +} +\value{ +a \code{tibble} +} +\description{ +Process Survival Fit For Time Estimates +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "broom"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + cardx:::.process_survfit_time(times = c(60, 180), type = "risk") +\dontshow{\}) # examplesIf} +} +\keyword{internal} diff --git a/man/proportion_ci.Rd b/man/proportion_ci.Rd index 888eee456..8094fc047 100644 --- a/man/proportion_ci.Rd +++ b/man/proportion_ci.Rd @@ -101,7 +101,7 @@ z_{\alpha/2} \sqrt{\frac{\hat{p}_j(1 - \hat{p}_j)}{n_j} + }} \examples{ -\dontshow{if (cards::is_pkg_installed("broom", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} x <- c( TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE diff --git a/tests/testthat/_snaps/ard_aod_wald_test.md b/tests/testthat/_snaps/ard_aod_wald_test.md new file mode 100644 index 000000000..6ebe17ca3 --- /dev/null +++ b/tests/testthat/_snaps/ard_aod_wald_test.md @@ -0,0 +1,15 @@ +# ard_aod_wald_test() works + + Code + glm_ard_aod_waldtest[, 1:6] + Message + {cards} data frame: 6 x 6 + Output + variable context stat_name stat_label stat fmt_fn + 1 (Intercept) aod_wald… df Degrees … 1 1 + 2 (Intercept) aod_wald… statistic Statistic 7126.713 1 + 3 (Intercept) aod_wald… p.value p-value 0 1 + 4 ARM aod_wald… df Degrees … 2 1 + 5 ARM aod_wald… statistic Statistic 1.046 1 + 6 ARM aod_wald… p.value p-value 0.593 1 + diff --git a/tests/testthat/_snaps/ard_car_vif.md b/tests/testthat/_snaps/ard_car_vif.md new file mode 100644 index 000000000..8d0a7a74b --- /dev/null +++ b/tests/testthat/_snaps/ard_car_vif.md @@ -0,0 +1,46 @@ +# ard_car_vif() works + + Code + as.data.frame(ard_car_vif(lm(AGE ~ ARM + SEX, data = cards::ADSL))) + Output + variable context stat_name stat_label stat fmt_fn warning error + 1 ARM car_vif GVIF GVIF 1.015675 1 NULL NULL + 2 ARM car_vif df df 2.000000 1 NULL NULL + 3 ARM car_vif aGVIF Adjusted GVIF 1.003896 1 NULL NULL + 4 SEX car_vif GVIF GVIF 1.015675 1 NULL NULL + 5 SEX car_vif df df 1.000000 1 NULL NULL + 6 SEX car_vif aGVIF Adjusted GVIF 1.007807 1 NULL NULL + +--- + + Code + as.data.frame(ard_car_vif(lm(AGE ~ BMIBL + EDUCLVL, data = cards::ADSL))) + Output + variable context stat_name stat_label stat fmt_fn warning error + 1 BMIBL car_vif VIF VIF 1.010522 1 NULL NULL + 2 EDUCLVL car_vif VIF VIF 1.010522 1 NULL NULL + +# ard_car_vif() appropriate errors are given for model with only 1 term + + Code + as.data.frame(ard_car_vif(lm(AGE ~ ARM, data = cards::ADSL))) + Output + variable context stat_name stat_label stat fmt_fn warning + 1 ARM car_vif VIF VIF NULL NULL NULL + 2 ARM car_vif GVIF GVIF NULL NULL NULL + 3 ARM car_vif aGVIF Adjusted GVIF NULL NULL NULL + 4 ARM car_vif df df NULL NULL NULL + error + 1 model contains fewer than 2 terms + 2 model contains fewer than 2 terms + 3 model contains fewer than 2 terms + 4 model contains fewer than 2 terms + +# ard_vif() issues friendly messaging for incorrect object passed in/can't get terms of model + + Code + ard_vif(cards::ADSL) + Condition + Error in `ard_vif()`: + ! could not find function "ard_vif" + diff --git a/tests/testthat/_snaps/ard_chisqtest.md b/tests/testthat/_snaps/ard_chisqtest.md deleted file mode 100644 index 8ac52ec30..000000000 --- a/tests/testthat/_snaps/ard_chisqtest.md +++ /dev/null @@ -1,17 +0,0 @@ -# shuffle_ard fills missing group levels if the group is meaningful - - Code - as.data.frame(cards::shuffle_ard(cards::bind_ard(ard_chisqtest(data = adsl_sub, - by = "ARM", variables = "AGEGR1"), ard_chisqtest(data = adsl_sub, by = "SEX", - variables = "AGEGR1")))) - Output - ARM SEX variable context stat_name stat - 1 Overall ARM AGEGR1 chisqtest statistic 5.079442e+00 - 2 Overall ARM AGEGR1 chisqtest p.value 7.888842e-02 - 3 Overall ARM AGEGR1 chisqtest parameter 2.000000e+00 - 4 Overall ARM AGEGR1 chisqtest B 2.000000e+03 - 5 Overall SEX AGEGR1 chisqtest statistic 1.039442e+00 - 6 Overall SEX AGEGR1 chisqtest p.value 5.946864e-01 - 7 Overall SEX AGEGR1 chisqtest parameter 2.000000e+00 - 8 Overall SEX AGEGR1 chisqtest B 2.000000e+03 - diff --git a/tests/testthat/_snaps/ard_cohens_d.md b/tests/testthat/_snaps/ard_effectsize_cohens_d.md similarity index 56% rename from tests/testthat/_snaps/ard_cohens_d.md rename to tests/testthat/_snaps/ard_effectsize_cohens_d.md index 11a601833..6cd20d5a2 100644 --- a/tests/testthat/_snaps/ard_cohens_d.md +++ b/tests/testthat/_snaps/ard_effectsize_cohens_d.md @@ -1,8 +1,8 @@ -# ard_cohens_d() works +# ard_effectsize_cohens_d() works Code - as.data.frame(dplyr::select(ard_cohens_d(cards::ADSL, by = ARM, variables = AGE), - c("variable", "stat_name", "error"))) + as.data.frame(dplyr::select(ard_effectsize_cohens_d(cards::ADSL, by = ARM, + variables = AGE), c("variable", "stat_name", "error"))) Output variable stat_name error 1 AGE estimate Grouping variable y must have exactly 2 levels. @@ -17,24 +17,25 @@ --- 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)) + as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select( + ard_effectsize_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.436653 - 2 ARM BMIBL cohens_d CI Confidence Level 0.95 - 3 ARM BMIBL cohens_d CI Lower Bound -0.740282 - 4 ARM HEIGHTBL cohens_d Effect Size Estimate -0.299056 - 5 ARM HEIGHTBL cohens_d CI Confidence Level 0.95 - 6 ARM HEIGHTBL cohens_d CI Lower Bound -0.600975 + group1 variable context stat_label stat + 1 ARM BMIBL effectsize_cohens_d Effect Size Estimate -0.436653 + 2 ARM BMIBL effectsize_cohens_d CI Confidence Level 0.95 + 3 ARM BMIBL effectsize_cohens_d CI Lower Bound -0.740282 + 4 ARM HEIGHTBL effectsize_cohens_d Effect Size Estimate -0.299056 + 5 ARM HEIGHTBL effectsize_cohens_d CI Confidence Level 0.95 + 6 ARM HEIGHTBL effectsize_cohens_d CI Lower Bound -0.600975 -# ard_paired_cohens_d() works +# ard_effectsize_paired_cohens_d() works Code - as.data.frame(dplyr::select(ard_paired_cohens_d(dplyr::mutate(ADSL_paired, ARM = ifelse( - dplyr::row_number() == 1L, "3rd ARM", ARM)), by = ARM, variable = AGE, id = USUBJID), - c("variable", "stat_name", "error"))) + as.data.frame(dplyr::select(ard_effectsize_paired_cohens_d(dplyr::mutate( + ADSL_paired, ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM)), by = ARM, + variable = AGE, id = USUBJID), c("variable", "stat_name", "error"))) Output variable stat_name error 1 AGE estimate The `by` argument must have two and only two levels. diff --git a/tests/testthat/_snaps/ard_hedges_g.md b/tests/testthat/_snaps/ard_effectsize_hedges_g.md similarity index 56% rename from tests/testthat/_snaps/ard_hedges_g.md rename to tests/testthat/_snaps/ard_effectsize_hedges_g.md index 33568dd9f..e06a4ae16 100644 --- a/tests/testthat/_snaps/ard_hedges_g.md +++ b/tests/testthat/_snaps/ard_effectsize_hedges_g.md @@ -1,8 +1,8 @@ -# ard_hedges_g() works +# ard_effectsize_hedges_g() works Code - as.data.frame(dplyr::select(ard_hedges_g(cards::ADSL, by = ARM, variable = AGE), - c("variable", "stat_name", "error"))) + as.data.frame(dplyr::select(ard_effectsize_hedges_g(cards::ADSL, by = ARM, + variable = AGE), c("variable", "stat_name", "error"))) Output variable stat_name error 1 AGE estimate Grouping variable y must have exactly 2 levels. @@ -17,24 +17,25 @@ --- 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)) + as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select( + ard_effectsize_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 + group1 variable context stat_label stat + 1 ARM BMIBL effectsize_hedges_g Effect Size Estimate -0.4347006 + 2 ARM BMIBL effectsize_hedges_g CI Confidence Level 0.95 + 3 ARM BMIBL effectsize_hedges_g CI Lower Bound -0.7369717 + 4 ARM HEIGHTBL effectsize_hedges_g Effect Size Estimate -0.2977188 + 5 ARM HEIGHTBL effectsize_hedges_g CI Confidence Level 0.95 + 6 ARM HEIGHTBL effectsize_hedges_g CI Lower Bound -0.5982873 -# ard_paired_hedges_g() works +# ard_effectsize_paired_hedges_g() works Code - as.data.frame(dplyr::select(ard_paired_hedges_g(dplyr::mutate(ADSL_paired, ARM = ifelse( - dplyr::row_number() == 1L, "3rd ARM", ARM)), by = ARM, variable = AGE, id = USUBJID), - c("variable", "stat_name", "error"))) + as.data.frame(dplyr::select(ard_effectsize_paired_hedges_g(dplyr::mutate( + ADSL_paired, ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM)), by = ARM, + variable = AGE, id = USUBJID), c("variable", "stat_name", "error"))) Output variable stat_name error 1 AGE estimate The `by` argument must have two and only two levels. diff --git a/tests/testthat/_snaps/ard_kruskaltest.md b/tests/testthat/_snaps/ard_kruskaltest.md deleted file mode 100644 index 29121c26b..000000000 --- a/tests/testthat/_snaps/ard_kruskaltest.md +++ /dev/null @@ -1,16 +0,0 @@ -# ard_kurskaltest() works - - Code - as.data.frame(ard_kruskaltest(cards::ADSL, by = "ARM", variables = "AGE")) - Output - group1 variable context stat_name stat_label - 1 ARM AGE kruskaltest statistic Kruskal-Wallis chi-squared Statistic - 2 ARM AGE kruskaltest p.value p-value - 3 ARM AGE kruskaltest parameter Degrees of Freedom - 4 ARM AGE kruskaltest method method - stat fmt_fn warning error - 1 1.63473 1 NULL NULL - 2 0.4415937 1 NULL NULL - 3 2 1 NULL NULL - 4 Kruskal-Wallis rank sum test NULL NULL NULL - diff --git a/tests/testthat/_snaps/ard_moodtest.md b/tests/testthat/_snaps/ard_moodtest.md deleted file mode 100644 index b6bb0e8c2..000000000 --- a/tests/testthat/_snaps/ard_moodtest.md +++ /dev/null @@ -1,16 +0,0 @@ -# ard_moodtest() works - - Code - as.data.frame(ard_moodtest(cards::ADSL, by = SEX, variable = AGE)) - Output - group1 variable context stat_name stat_label - 1 SEX AGE moodtest statistic Z-Statistic - 2 SEX AGE moodtest p.value p-value - 3 SEX AGE moodtest method method - 4 SEX AGE moodtest alternative Alternative Hypothesis - stat fmt_fn warning error - 1 0.1292194 1 NULL NULL - 2 0.8971841 1 NULL NULL - 3 Mood two-sample test of scale NULL NULL NULL - 4 two.sided NULL NULL NULL - diff --git a/tests/testthat/_snaps/ard_stats_aov.md b/tests/testthat/_snaps/ard_stats_aov.md new file mode 100644 index 000000000..3ae9ebce4 --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_aov.md @@ -0,0 +1,17 @@ +# ard_aov() works + + Code + as.data.frame(ard_stats_aov(AGE ~ ARM + SEX, data = cards::ADSL)) + Output + variable context stat_name stat_label stat warning error + 1 ARM stats_aov sumsq Sum of Squares 71.38574 NULL NULL + 2 ARM stats_aov df Degrees of Freedom 2 NULL NULL + 3 ARM stats_aov meansq Mean of Sum of Squares 35.69287 NULL NULL + 4 ARM stats_aov statistic Statistic 0.5235002 NULL NULL + 5 ARM stats_aov p.value p-value 0.5930912 NULL NULL + 6 SEX stats_aov sumsq Sum of Squares 87.40947 NULL NULL + 7 SEX stats_aov df Degrees of Freedom 1 NULL NULL + 8 SEX stats_aov meansq Mean of Sum of Squares 87.40947 NULL NULL + 9 SEX stats_aov statistic Statistic 1.282017 NULL NULL + 10 SEX stats_aov p.value p-value 0.2586091 NULL NULL + diff --git a/tests/testthat/_snaps/ard_stats_chisq_test.md b/tests/testthat/_snaps/ard_stats_chisq_test.md new file mode 100644 index 000000000..d7e819366 --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_chisq_test.md @@ -0,0 +1,17 @@ +# shuffle_ard fills missing group levels if the group is meaningful + + Code + as.data.frame(cards::shuffle_ard(cards::bind_ard(ard_stats_chisq_test(data = adsl_sub, + by = "ARM", variables = "AGEGR1"), ard_stats_chisq_test(data = adsl_sub, by = "SEX", + variables = "AGEGR1")))) + Output + ARM SEX variable context stat_name stat + 1 Overall ARM AGEGR1 stats_chisq_test statistic 5.079442e+00 + 2 Overall ARM AGEGR1 stats_chisq_test p.value 7.888842e-02 + 3 Overall ARM AGEGR1 stats_chisq_test parameter 2.000000e+00 + 4 Overall ARM AGEGR1 stats_chisq_test B 2.000000e+03 + 5 Overall SEX AGEGR1 stats_chisq_test statistic 1.039442e+00 + 6 Overall SEX AGEGR1 stats_chisq_test p.value 5.946864e-01 + 7 Overall SEX AGEGR1 stats_chisq_test parameter 2.000000e+00 + 8 Overall SEX AGEGR1 stats_chisq_test B 2.000000e+03 + diff --git a/tests/testthat/_snaps/ard_stats_kruskal_test.md b/tests/testthat/_snaps/ard_stats_kruskal_test.md new file mode 100644 index 000000000..21fb6637d --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_kruskal_test.md @@ -0,0 +1,21 @@ +# ard_stats_kruskal_test() works + + Code + as.data.frame(ard_stats_kruskal_test(cards::ADSL, by = "ARM", variables = "AGE")) + Output + group1 variable context stat_name + 1 ARM AGE stats_kruskal_test statistic + 2 ARM AGE stats_kruskal_test p.value + 3 ARM AGE stats_kruskal_test parameter + 4 ARM AGE stats_kruskal_test method + stat_label stat fmt_fn + 1 Kruskal-Wallis chi-squared Statistic 1.63473 1 + 2 p-value 0.4415937 1 + 3 Degrees of Freedom 2 1 + 4 method Kruskal-Wallis rank sum test NULL + warning error + 1 NULL NULL + 2 NULL NULL + 3 NULL NULL + 4 NULL NULL + diff --git a/tests/testthat/_snaps/ard_stats_mood_test.md b/tests/testthat/_snaps/ard_stats_mood_test.md new file mode 100644 index 000000000..7dfdbc023 --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_mood_test.md @@ -0,0 +1,16 @@ +# ard_stats_mood_test() works + + Code + as.data.frame(ard_stats_mood_test(cards::ADSL, by = SEX, variable = AGE)) + Output + group1 variable context stat_name stat_label + 1 SEX AGE stats_mood_test statistic Z-Statistic + 2 SEX AGE stats_mood_test p.value p-value + 3 SEX AGE stats_mood_test method method + 4 SEX AGE stats_mood_test alternative Alternative Hypothesis + stat fmt_fn warning error + 1 0.1292194 1 NULL NULL + 2 0.8971841 1 NULL NULL + 3 Mood two-sample test of scale NULL NULL NULL + 4 two.sided NULL NULL NULL + diff --git a/tests/testthat/_snaps/ard_stats_oneway_test.md b/tests/testthat/_snaps/ard_stats_oneway_test.md new file mode 100644 index 000000000..6a597b9d2 --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_oneway_test.md @@ -0,0 +1,13 @@ +# ard_stats_oneway_test() works + + Code + head(dplyr::select(ard_stats_oneway_test(AGEGR1 ~ ARM, data = cards::ADSL), c( + "stat_name", "stat", "warning")), 3) + Message + {cards} data frame: 3 x 3 + Output + stat_name stat warning + 1 num.df 2 argument… + 2 den.df NA argument… + 3 statistic NA argument… + diff --git a/tests/testthat/_snaps/ard_stats_t_test.md b/tests/testthat/_snaps/ard_stats_t_test.md new file mode 100644 index 000000000..0b378d374 --- /dev/null +++ b/tests/testthat/_snaps/ard_stats_t_test.md @@ -0,0 +1,75 @@ +# ard_stats_t_test() works + + Code + as.data.frame(ard_stats_t_test(cards::ADSL, by = ARM, variable = AGE, + var.equal = TRUE)) + Output + group1 variable context stat_name stat_label stat fmt_fn + 1 ARM AGE stats_t_test estimate Mean Difference NULL NULL + 2 ARM AGE stats_t_test estimate1 Group 1 Mean NULL NULL + 3 ARM AGE stats_t_test estimate2 Group 2 Mean NULL NULL + 4 ARM AGE stats_t_test statistic t Statistic NULL NULL + 5 ARM AGE stats_t_test p.value p-value NULL NULL + 6 ARM AGE stats_t_test parameter Degrees of Freedom NULL NULL + 7 ARM AGE stats_t_test conf.low CI Lower Bound NULL NULL + 8 ARM AGE stats_t_test conf.high CI Upper Bound NULL NULL + 9 ARM AGE stats_t_test method method NULL NULL + 10 ARM AGE stats_t_test alternative alternative NULL NULL + 11 ARM AGE stats_t_test mu H0 Mean 0 1 + 12 ARM AGE stats_t_test paired Paired t-test FALSE NULL + 13 ARM AGE stats_t_test var.equal Equal Variances TRUE NULL + 14 ARM AGE stats_t_test conf.level CI Confidence Level 0.95 1 + warning error + 1 NULL grouping factor must have exactly 2 levels + 2 NULL grouping factor must have exactly 2 levels + 3 NULL grouping factor must have exactly 2 levels + 4 NULL grouping factor must have exactly 2 levels + 5 NULL grouping factor must have exactly 2 levels + 6 NULL grouping factor must have exactly 2 levels + 7 NULL grouping factor must have exactly 2 levels + 8 NULL grouping factor must have exactly 2 levels + 9 NULL grouping factor must have exactly 2 levels + 10 NULL grouping factor must have exactly 2 levels + 11 NULL grouping factor must have exactly 2 levels + 12 NULL grouping factor must have exactly 2 levels + 13 NULL grouping factor must have exactly 2 levels + 14 NULL grouping factor must have exactly 2 levels + +# ard_stats_paired_t_test() works + + Code + as.data.frame(ard_stats_paired_t_test(dplyr::mutate(ADSL_paired, ARM = ifelse( + dplyr::row_number() == 1L, "3rd ARM", ARM)), by = ARM, variable = AGE, id = USUBJID, + var.equal = TRUE)) + Output + group1 variable context stat_name stat_label stat fmt_fn + 1 ARM AGE stats_t_test estimate Mean Difference NULL NULL + 2 ARM AGE stats_t_test estimate1 Group 1 Mean NULL NULL + 3 ARM AGE stats_t_test estimate2 Group 2 Mean NULL NULL + 4 ARM AGE stats_t_test statistic t Statistic NULL NULL + 5 ARM AGE stats_t_test p.value p-value NULL NULL + 6 ARM AGE stats_t_test parameter Degrees of Freedom NULL NULL + 7 ARM AGE stats_t_test conf.low CI Lower Bound NULL NULL + 8 ARM AGE stats_t_test conf.high CI Upper Bound NULL NULL + 9 ARM AGE stats_t_test method method NULL NULL + 10 ARM AGE stats_t_test alternative alternative NULL NULL + 11 ARM AGE stats_t_test mu H0 Mean 0 1 + 12 ARM AGE stats_t_test paired Paired t-test TRUE NULL + 13 ARM AGE stats_t_test var.equal Equal Variances TRUE NULL + 14 ARM AGE stats_t_test conf.level CI Confidence Level 0.95 1 + warning error + 1 NULL The `by` argument must have two and only two levels. + 2 NULL The `by` argument must have two and only two levels. + 3 NULL The `by` argument must have two and only two levels. + 4 NULL The `by` argument must have two and only two levels. + 5 NULL The `by` argument must have two and only two levels. + 6 NULL The `by` argument must have two and only two levels. + 7 NULL The `by` argument must have two and only two levels. + 8 NULL The `by` argument must have two and only two levels. + 9 NULL The `by` argument must have two and only two levels. + 10 NULL The `by` argument must have two and only two levels. + 11 NULL The `by` argument must have two and only two levels. + 12 NULL The `by` argument must have two and only two levels. + 13 NULL The `by` argument must have two and only two levels. + 14 NULL The `by` argument must have two and only two levels. + diff --git a/tests/testthat/_snaps/ard_survey_svychisq.md b/tests/testthat/_snaps/ard_survey_svychisq.md new file mode 100644 index 000000000..0d0b49f4d --- /dev/null +++ b/tests/testthat/_snaps/ard_survey_svychisq.md @@ -0,0 +1,15 @@ +# ard_survey_svychisq() works + + Code + as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select( + ard_survey_svychisq(dclus2, variables = c(sch.wide, stype), by = comp.imp, + statistic = "adjWald"), c(1:3, 5:6)), variable), n = 3)) + Output + group1 variable context stat_label stat + 1 comp.imp sch.wide survey_svychisq Nominator Degrees of Freedom 1 + 2 comp.imp sch.wide survey_svychisq Denominator Degrees of Freedom 39 + 3 comp.imp sch.wide survey_svychisq Statistic 11.4203 + 4 comp.imp stype survey_svychisq Nominator Degrees of Freedom 2 + 5 comp.imp stype survey_svychisq Denominator Degrees of Freedom 38 + 6 comp.imp stype survey_svychisq Statistic 4.480236 + diff --git a/tests/testthat/_snaps/ard_survey_svycontinuous.md b/tests/testthat/_snaps/ard_survey_svycontinuous.md new file mode 100644 index 000000000..7dbd96603 --- /dev/null +++ b/tests/testthat/_snaps/ard_survey_svycontinuous.md @@ -0,0 +1,55 @@ +# unstratified ard_survey_svycontinuous() works + + Code + ard_uni_svy_cont + Message + {cards} data frame: 10 x 8 + Output + variable context stat_name stat_label stat fmt_fn + 1 api00 survey_s… mean Mean 644.169 1 + 2 api00 survey_s… median Median 652 1 + 3 api00 survey_s… min Minimum 411 1 + 4 api00 survey_s… max Maximum 905 1 + 5 api00 survey_s… sum Sum 3989985 1 + 6 api00 survey_s… var Variance 11182.82 1 + 7 api00 survey_s… sd Standard… 105.749 1 + 8 api00 survey_s… mean.std.error SE(Mean) 23.542 1 + 9 api00 survey_s… deff Design E… 9.346 1 + 10 api00 survey_s… p75 75% Perc… 719 1 + Message + i 2 more variables: warning, error + +# ard_survey_svycontinuous(fmt_fn) + + Code + ard_survey_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", + "median", "min", "max"), fmt_fn = list(api00 = list(mean = 2, median = "xx.xx", + min = as.character))) + Message + {cards} data frame: 4 x 8 + Output + variable context stat_name stat_label stat fmt_fn + 1 api00 survey_s… mean Mean 644.169 2 + 2 api00 survey_s… median Median 652 xx.xx + 3 api00 survey_s… min Minimum 411 + 4 api00 survey_s… max Maximum 905 1 + Message + i 2 more variables: warning, error + +# ard_survey_svycontinuous(stat_label) + + Code + ard_survey_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", + "median", "min", "max"), stat_label = list(api00 = list(mean = "MeAn", + median = "MEDian", min = "MINimum"))) + Message + {cards} data frame: 4 x 8 + Output + variable context stat_name stat_label stat fmt_fn + 1 api00 survey_s… mean MeAn 644.169 1 + 2 api00 survey_s… median MEDian 652 1 + 3 api00 survey_s… min MINimum 411 1 + 4 api00 survey_s… max Maximum 905 1 + Message + i 2 more variables: warning, error + diff --git a/tests/testthat/_snaps/ard_survey_svyranktest.md b/tests/testthat/_snaps/ard_survey_svyranktest.md new file mode 100644 index 000000000..85ba37bb8 --- /dev/null +++ b/tests/testthat/_snaps/ard_survey_svyranktest.md @@ -0,0 +1,52 @@ +# ard_survey_svyranktest() works + + Code + dplyr::select(as.data.frame(svyranktest[[1]]), stat_label, stat) + Output + stat_label stat + 1 Median of the Difference -0.1060602 + 2 Statistic -1.718689 + 3 p-value 0.09426084 + 4 Degrees of Freedom 36 + 5 method Design-based KruskalWallis test + 6 Alternative Hypothesis two.sided + +--- + + Code + dplyr::select(as.data.frame(svyranktest[[2]]), stat_label, stat) + Output + stat_label stat + 1 Median of the Difference -0.3791163 + 2 Statistic -1.583859 + 3 p-value 0.1219723 + 4 Degrees of Freedom 36 + 5 method Design-based vanderWaerden test + 6 Alternative Hypothesis two.sided + +--- + + Code + dplyr::select(as.data.frame(svyranktest[[3]]), stat_label, stat) + Output + stat_label stat + 1 Median of the Difference -0.1240709 + 2 Statistic -0.9139828 + 3 p-value 0.3668071 + 4 Degrees of Freedom 36 + 5 method Design-based median test + 6 Alternative Hypothesis two.sided + +--- + + Code + dplyr::select(as.data.frame(svyranktest[[4]]), stat_label, stat) + Output + stat_label stat + 1 Median of the Difference -0.1060602 + 2 Statistic -1.718689 + 3 p-value 0.09426084 + 4 Degrees of Freedom 36 + 5 method Design-based KruskalWallis test + 6 Alternative Hypothesis two.sided + diff --git a/tests/testthat/_snaps/ard_survival_survfit.md b/tests/testthat/_snaps/ard_survival_survfit.md new file mode 100644 index 000000000..6697507dd --- /dev/null +++ b/tests/testthat/_snaps/ard_survival_survfit.md @@ -0,0 +1,262 @@ +# ard_survival_survfit() works with times provided + + Code + print(dplyr::mutate(ard_survival_survfit(survival::survfit(survival::Surv(AVAL, + CNSR) ~ TRTA, cards::ADTTE), times = c(60, 180)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 18 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.893 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.966 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.825 + 4 TRTA Placebo time 180 estimate Survival… 0.651 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.783 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.541 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.694 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.849 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.568 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.262 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.749 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.092 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.732 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.878 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.61 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.381 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.743 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.195 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_survival_survfit() works with different type + + Code + print(dplyr::mutate(ard_survival_survfit(survival::survfit(survival::Surv(AVAL, + CNSR) ~ TRTA, cards::ADTTE), times = c(60, 180), type = "risk"), stat = lapply( + stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 18 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.107 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.175 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.034 + 4 TRTA Placebo time 180 estimate Survival… 0.349 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.459 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.217 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.306 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.432 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.151 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.738 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.908 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.251 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.268 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.39 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.122 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.619 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.805 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.257 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_survival_survfit() works with probs provided + + Code + print(dplyr::mutate(ard_survival_survfit(survival::survfit(survival::Surv(AVAL, + CNSR) ~ TRTA, cards::ADTTE), probs = c(0.25, 0.75)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 18 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo prob 0.25 estimate Survival… 142 + 2 TRTA Placebo prob 0.25 conf.high CI Upper… 181 + 3 TRTA Placebo prob 0.25 conf.low CI Lower… 70 + 4 TRTA Placebo prob 0.75 estimate Survival… 184 + 5 TRTA Placebo prob 0.75 conf.high CI Upper… 191 + 6 TRTA Placebo prob 0.75 conf.low CI Lower… 183 + 7 TRTA Xanomeli… prob 0.25 estimate Survival… 44 + 8 TRTA Xanomeli… prob 0.25 conf.high CI Upper… 180 + 9 TRTA Xanomeli… prob 0.25 conf.low CI Lower… 22 + 10 TRTA Xanomeli… prob 0.75 estimate Survival… 188 + 11 TRTA Xanomeli… prob 0.75 conf.high CI Upper… NA + 12 TRTA Xanomeli… prob 0.75 conf.low CI Lower… 167 + 13 TRTA Xanomeli… prob 0.25 estimate Survival… 49 + 14 TRTA Xanomeli… prob 0.25 conf.high CI Upper… 180 + 15 TRTA Xanomeli… prob 0.25 conf.low CI Lower… 37 + 16 TRTA Xanomeli… prob 0.75 estimate Survival… 184 + 17 TRTA Xanomeli… prob 0.75 conf.high CI Upper… NA + 18 TRTA Xanomeli… prob 0.75 conf.low CI Lower… 180 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_survival_survfit() works with unstratified model + + Code + print(dplyr::mutate(ard_survival_survfit(survival::survfit(survival::Surv(time, + status) ~ 1, data = survival::lung), times = c(60, 180)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 6 x 9 + Output + variable variable_level context stat_name stat_label stat + 1 time 60 survival estimate Survival… 0.925 + 2 time 60 survival conf.high CI Upper… 0.96 + 3 time 60 survival conf.low CI Lower… 0.892 + 4 time 180 survival estimate Survival… 0.722 + 5 time 180 survival conf.high CI Upper… 0.783 + 6 time 180 survival conf.low CI Lower… 0.666 + Message + i 3 more variables: fmt_fn, warning, error + +--- + + Code + print(dplyr::mutate(ard_survival_survfit(survival::survfit(survival::Surv(time, + status) ~ 1, data = survival::lung), probs = c(0.5, 0.75)), stat = lapply( + stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 6 x 9 + Output + variable variable_level context stat_name stat_label stat + 1 prob 0.5 survival… estimate Survival… 310 + 2 prob 0.5 survival… conf.high CI Upper… 363 + 3 prob 0.5 survival… conf.low CI Lower… 285 + 4 prob 0.75 survival… estimate Survival… 550 + 5 prob 0.75 survival… conf.high CI Upper… 654 + 6 prob 0.75 survival… conf.low CI Lower… 460 + Message + i 3 more variables: fmt_fn, warning, error + +# ard_survival_survfit() works with multiple stratification variables + + Code + print(head(dplyr::select(dplyr::mutate(ard_survival_survfit(survival::survfit( + survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung), times = c( + 60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5( + x, 3), x))), "group1", "group1_level", "group2", "group2_level"), 20), n = Inf) + Message + {cards} data frame: 20 x 4 + Output + group1 group1_level group2 group2_level + 1 sex 1 ph.ecog 0 + 2 sex 1 ph.ecog 0 + 3 sex 1 ph.ecog 0 + 4 sex 1 ph.ecog 0 + 5 sex 1 ph.ecog 0 + 6 sex 1 ph.ecog 0 + 7 sex 1 ph.ecog 1 + 8 sex 1 ph.ecog 1 + 9 sex 1 ph.ecog 1 + 10 sex 1 ph.ecog 1 + 11 sex 1 ph.ecog 1 + 12 sex 1 ph.ecog 1 + 13 sex 1 ph.ecog 2 + 14 sex 1 ph.ecog 2 + 15 sex 1 ph.ecog 2 + 16 sex 1 ph.ecog 2 + 17 sex 1 ph.ecog 2 + 18 sex 1 ph.ecog 2 + 19 sex 1 ph.ecog 3 + 20 sex 1 ph.ecog 3 + +--- + + Code + print(head(dplyr::select(dplyr::mutate(ard_survival_survfit(survival::survfit( + survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung), probs = c( + 0.5, 0.75)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5( + x, 3), x))), "group1", "group1_level", "group2", "group2_level"), 20), n = Inf) + Message + {cards} data frame: 20 x 4 + Output + group1 group1_level group2 group2_level + 1 sex 1 ph.ecog 0 + 2 sex 1 ph.ecog 0 + 3 sex 1 ph.ecog 0 + 4 sex 1 ph.ecog 0 + 5 sex 1 ph.ecog 0 + 6 sex 1 ph.ecog 0 + 7 sex 1 ph.ecog 1 + 8 sex 1 ph.ecog 1 + 9 sex 1 ph.ecog 1 + 10 sex 1 ph.ecog 1 + 11 sex 1 ph.ecog 1 + 12 sex 1 ph.ecog 1 + 13 sex 1 ph.ecog 2 + 14 sex 1 ph.ecog 2 + 15 sex 1 ph.ecog 2 + 16 sex 1 ph.ecog 2 + 17 sex 1 ph.ecog 2 + 18 sex 1 ph.ecog 2 + 19 sex 1 ph.ecog 3 + 20 sex 1 ph.ecog 3 + +# ard_survival_survfit() works with competing risks + + Code + print(dplyr::mutate(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% + ard_survival_survfit(times = c(60, 180)), stat = lapply(stat, function(x) + ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + Multi-state model detected. Showing probabilities into state 'death from cancer'. + {cards} data frame: 18 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.054 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.14 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.021 + 4 TRTA Placebo time 180 estimate Survival… 0.226 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.361 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.142 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.137 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.311 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.06 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.51 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.892 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.292 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.162 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.33 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.08 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.244 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.516 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.115 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_survival_survfit() errors are properly handled + + Code + ard_survival_survfit("not_survfit") + Condition + Error in `ard_survival_survfit()`: + ! The `x` argument must be class , not a string. + +--- + + Code + ard_survival_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, + cards::ADTTE), times = 100, type = "notatype") + Condition + Error in `ard_survival_survfit()`: + ! `type` must be one of "survival", "risk", or "cumhaz", not "notatype". + +--- + + Code + ard_survival_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, + cards::ADTTE), times = 100, probs = c(0.25, 0.75)) + Condition + Error in `ard_survival_survfit()`: + ! One and only one of `times` and `probs` must be specified. + +# ard_survival_survfit() errors with stratified Cox model + + Code + ard_survival_survfit(survfit(coxph(Surv(time, status) ~ age + strata(sex), + survival::lung))) + Condition + Error in `ard_survival_survfit()`: + ! Argument `x` cannot be class . + diff --git a/tests/testthat/_snaps/ard_svychisq.md b/tests/testthat/_snaps/ard_svychisq.md deleted file mode 100644 index 46f7f46df..000000000 --- a/tests/testthat/_snaps/ard_svychisq.md +++ /dev/null @@ -1,15 +0,0 @@ -# ard_svychisq() works - - Code - as.data.frame(dplyr::slice_head(dplyr::group_by(dplyr::select(ard_svychisq( - dclus2, variables = c(sch.wide, stype), by = comp.imp, statistic = "adjWald"), - c(1:3, 5:6)), variable), n = 3)) - Output - group1 variable context stat_label stat - 1 comp.imp sch.wide svychisq Nominator Degrees of Freedom 1 - 2 comp.imp sch.wide svychisq Denominator Degrees of Freedom 39 - 3 comp.imp sch.wide svychisq Statistic 11.4203 - 4 comp.imp stype svychisq Nominator Degrees of Freedom 2 - 5 comp.imp stype svychisq Denominator Degrees of Freedom 38 - 6 comp.imp stype svychisq Statistic 4.480236 - diff --git a/tests/testthat/_snaps/ard_svycontinuous.md b/tests/testthat/_snaps/ard_svycontinuous.md deleted file mode 100644 index 28d83bb09..000000000 --- a/tests/testthat/_snaps/ard_svycontinuous.md +++ /dev/null @@ -1,54 +0,0 @@ -# unstratified ard_svycontinuous() works - - Code - ard_uni_svy_cont - Message - {cards} data frame: 10 x 8 - Output - variable context stat_name stat_label stat fmt_fn - 1 api00 continuo… mean Mean 644.169 1 - 2 api00 continuo… median Median 652 1 - 3 api00 continuo… min Minimum 411 1 - 4 api00 continuo… max Maximum 905 1 - 5 api00 continuo… sum Sum 3989985 1 - 6 api00 continuo… var Variance 11182.82 1 - 7 api00 continuo… sd Standard… 105.749 1 - 8 api00 continuo… mean.std.error SE(Mean) 23.542 1 - 9 api00 continuo… deff Design E… 9.346 1 - 10 api00 continuo… p75 75% Perc… 719 1 - Message - i 2 more variables: warning, error - -# ard_svycontinuous(fmt_fn) - - Code - ard_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", "median", - "min", "max"), fmt_fn = list(api00 = list(mean = 2, median = "xx.xx", min = as.character))) - Message - {cards} data frame: 4 x 8 - Output - variable context stat_name stat_label stat fmt_fn - 1 api00 continuo… mean Mean 644.169 2 - 2 api00 continuo… median Median 652 xx.xx - 3 api00 continuo… min Minimum 411 - 4 api00 continuo… max Maximum 905 1 - Message - i 2 more variables: warning, error - -# ard_svycontinuous(stat_label) - - Code - ard_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", "median", - "min", "max"), stat_label = list(api00 = list(mean = "MeAn", median = "MEDian", - min = "MINimum"))) - Message - {cards} data frame: 4 x 8 - Output - variable context stat_name stat_label stat fmt_fn - 1 api00 continuo… mean MeAn 644.169 1 - 2 api00 continuo… median MEDian 652 1 - 3 api00 continuo… min MINimum 411 1 - 4 api00 continuo… max Maximum 905 1 - Message - i 2 more variables: warning, error - diff --git a/tests/testthat/_snaps/ard_ttest.md b/tests/testthat/_snaps/ard_ttest.md deleted file mode 100644 index 9fc30da10..000000000 --- a/tests/testthat/_snaps/ard_ttest.md +++ /dev/null @@ -1,73 +0,0 @@ -# ard_ttest() works - - Code - as.data.frame(ard_ttest(cards::ADSL, by = ARM, variable = AGE, var.equal = TRUE)) - Output - group1 variable context stat_name stat_label stat fmt_fn warning - 1 ARM AGE ttest estimate Mean Difference NULL NULL NULL - 2 ARM AGE ttest estimate1 Group 1 Mean NULL NULL NULL - 3 ARM AGE ttest estimate2 Group 2 Mean NULL NULL NULL - 4 ARM AGE ttest statistic t Statistic NULL NULL NULL - 5 ARM AGE ttest p.value p-value NULL NULL NULL - 6 ARM AGE ttest parameter Degrees of Freedom NULL NULL NULL - 7 ARM AGE ttest conf.low CI Lower Bound NULL NULL NULL - 8 ARM AGE ttest conf.high CI Upper Bound NULL NULL NULL - 9 ARM AGE ttest method method NULL NULL NULL - 10 ARM AGE ttest alternative alternative NULL NULL NULL - 11 ARM AGE ttest mu H0 Mean 0 1 NULL - 12 ARM AGE ttest paired Paired t-test FALSE NULL NULL - 13 ARM AGE ttest var.equal Equal Variances TRUE NULL NULL - 14 ARM AGE ttest conf.level CI Confidence Level 0.95 1 NULL - error - 1 grouping factor must have exactly 2 levels - 2 grouping factor must have exactly 2 levels - 3 grouping factor must have exactly 2 levels - 4 grouping factor must have exactly 2 levels - 5 grouping factor must have exactly 2 levels - 6 grouping factor must have exactly 2 levels - 7 grouping factor must have exactly 2 levels - 8 grouping factor must have exactly 2 levels - 9 grouping factor must have exactly 2 levels - 10 grouping factor must have exactly 2 levels - 11 grouping factor must have exactly 2 levels - 12 grouping factor must have exactly 2 levels - 13 grouping factor must have exactly 2 levels - 14 grouping factor must have exactly 2 levels - -# ard_paired_ttest() works - - Code - as.data.frame(ard_paired_ttest(dplyr::mutate(ADSL_paired, ARM = ifelse(dplyr::row_number() == - 1L, "3rd ARM", ARM)), by = ARM, variable = AGE, id = USUBJID, var.equal = TRUE)) - Output - group1 variable context stat_name stat_label stat fmt_fn warning - 1 ARM AGE ttest estimate Mean Difference NULL NULL NULL - 2 ARM AGE ttest estimate1 Group 1 Mean NULL NULL NULL - 3 ARM AGE ttest estimate2 Group 2 Mean NULL NULL NULL - 4 ARM AGE ttest statistic t Statistic NULL NULL NULL - 5 ARM AGE ttest p.value p-value NULL NULL NULL - 6 ARM AGE ttest parameter Degrees of Freedom NULL NULL NULL - 7 ARM AGE ttest conf.low CI Lower Bound NULL NULL NULL - 8 ARM AGE ttest conf.high CI Upper Bound NULL NULL NULL - 9 ARM AGE ttest method method NULL NULL NULL - 10 ARM AGE ttest alternative alternative NULL NULL NULL - 11 ARM AGE ttest mu H0 Mean 0 1 NULL - 12 ARM AGE ttest paired Paired t-test TRUE NULL NULL - 13 ARM AGE ttest var.equal Equal Variances TRUE NULL NULL - 14 ARM AGE ttest conf.level CI Confidence Level 0.95 1 NULL - error - 1 The `by` argument must have two and only two levels. - 2 The `by` argument must have two and only two levels. - 3 The `by` argument must have two and only two levels. - 4 The `by` argument must have two and only two levels. - 5 The `by` argument must have two and only two levels. - 6 The `by` argument must have two and only two levels. - 7 The `by` argument must have two and only two levels. - 8 The `by` argument must have two and only two levels. - 9 The `by` argument must have two and only two levels. - 10 The `by` argument must have two and only two levels. - 11 The `by` argument must have two and only two levels. - 12 The `by` argument must have two and only two levels. - 13 The `by` argument must have two and only two levels. - 14 The `by` argument must have two and only two levels. - diff --git a/tests/testthat/_snaps/ard_vif.md b/tests/testthat/_snaps/ard_vif.md deleted file mode 100644 index 2fef8dd36..000000000 --- a/tests/testthat/_snaps/ard_vif.md +++ /dev/null @@ -1,47 +0,0 @@ -# ard_vif() works - - Code - as.data.frame(ard_vif(lm(AGE ~ ARM + SEX, data = cards::ADSL))) - Output - variable context stat_name stat_label stat fmt_fn warning error - 1 ARM vif GVIF GVIF 1.015675 1 NULL NULL - 2 ARM vif df df 2.000000 1 NULL NULL - 3 ARM vif aGVIF Adjusted GVIF 1.003896 1 NULL NULL - 4 SEX vif GVIF GVIF 1.015675 1 NULL NULL - 5 SEX vif df df 1.000000 1 NULL NULL - 6 SEX vif aGVIF Adjusted GVIF 1.007807 1 NULL NULL - ---- - - Code - as.data.frame(ard_vif(lm(AGE ~ BMIBL + EDUCLVL, data = cards::ADSL))) - Output - variable context stat_name stat_label stat fmt_fn warning error - 1 BMIBL vif VIF VIF 1.010522 1 NULL NULL - 2 EDUCLVL vif VIF VIF 1.010522 1 NULL NULL - -# ard_vif() appropriate errors are given for model with only 1 term - - Code - as.data.frame(ard_vif(lm(AGE ~ ARM, data = cards::ADSL))) - Output - variable context stat_name stat_label stat fmt_fn warning - 1 ARM vif VIF VIF NULL NULL NULL - 2 ARM vif GVIF GVIF NULL NULL NULL - 3 ARM vif aGVIF Adjusted GVIF NULL NULL NULL - 4 ARM vif df df NULL NULL NULL - error - 1 model contains fewer than 2 terms - 2 model contains fewer than 2 terms - 3 model contains fewer than 2 terms - 4 model contains fewer than 2 terms - -# ard_vif() issues friendly messaging for incorrect object passed in/can't get terms of model - - Code - ard_vif(cards::ADSL) - Condition - Error in `ard_vif()`: - ! There was an error running `car::vif()`. See below. - x no applicable method for 'vcov' applied to an object of class "c('tbl_df', 'tbl', 'data.frame')" - diff --git a/tests/testthat/test-ard_aod_wald_test.R b/tests/testthat/test-ard_aod_wald_test.R new file mode 100644 index 000000000..3576c62bc --- /dev/null +++ b/tests/testthat/test-ard_aod_wald_test.R @@ -0,0 +1,20 @@ +skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "aod", reference_pkg = "cardx"))) + +test_that("ard_aod_wald_test() works", { + # works for a generic case + expect_error( + glm_ard_aod_waldtest <- + suppressWarnings(lm(AGE ~ ARM, data = cards::ADSL)) |> + ard_aod_wald_test(), + NA + ) + expect_equal(nrow(glm_ard_aod_waldtest), 6L) + expect_snapshot(glm_ard_aod_waldtest[, 1:6]) + + # error returned when a regression model isn't passed + + expect_error( + ard_aod_wald_test(cards::ADSL) |> + dplyr::select(c(context, error)) + ) +}) diff --git a/tests/testthat/test-ard_car_anova.R b/tests/testthat/test-ard_car_anova.R index b7d642750..5468f15fb 100644 --- a/tests/testthat/test-ard_car_anova.R +++ b/tests/testthat/test-ard_car_anova.R @@ -1,4 +1,6 @@ -skip_if_not(cards::is_pkg_installed(c("broom.helpers", "car"), reference_pkg = "cardx")) +skip_if_not( + do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("broom.helpers", "car"), reference_pkg = "cardx")) +) test_that("ard_car_anova() works", { # works for a generic case diff --git a/tests/testthat/test-ard_vif.R b/tests/testthat/test-ard_car_vif.R similarity index 69% rename from tests/testthat/test-ard_vif.R rename to tests/testthat/test-ard_car_vif.R index b0201d7b8..390fdb77f 100644 --- a/tests/testthat/test-ard_vif.R +++ b/tests/testthat/test-ard_car_vif.R @@ -1,26 +1,28 @@ -test_that("ard_vif() works", { +skip_if_not(is_pkg_installed("car", reference_pkg = "cardx")) + +test_that("ard_car_vif() works", { expect_snapshot( lm(AGE ~ ARM + SEX, data = cards::ADSL) |> - ard_vif() |> + ard_car_vif() |> as.data.frame() ) expect_snapshot( lm(AGE ~ BMIBL + EDUCLVL, data = cards::ADSL) |> - ard_vif() |> + ard_car_vif() |> as.data.frame() ) }) -test_that("ard_vif() appropriate errors are given for model with only 1 term", { +test_that("ard_car_vif() appropriate errors are given for model with only 1 term", { expect_snapshot( lm(AGE ~ ARM, data = cards::ADSL) |> - ard_vif() |> + ard_car_vif() |> as.data.frame() ) expect_equal( lm(AGE ~ ARM, data = cards::ADSL) |> - ard_vif() |> + ard_car_vif() |> dplyr::select(error) |> unlist() |> unique(), diff --git a/tests/testthat/test-ard_cohens_d.R b/tests/testthat/test-ard_effectsize_cohens_d.R similarity index 78% rename from tests/testthat/test-ard_cohens_d.R rename to tests/testthat/test-ard_effectsize_cohens_d.R index a8c20caaa..fe5c771bf 100644 --- a/tests/testthat/test-ard_cohens_d.R +++ b/tests/testthat/test-ard_effectsize_cohens_d.R @@ -1,6 +1,6 @@ -skip_if_not(cards::is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("effectsize", "parameters"), reference_pkg = "cardx")) -test_that("ard_cohens_d() works", { +test_that("ard_effectsize_cohens_d() works", { # there were some discrepancies in the 7th decimal place on one system withr::local_options(list(digits = 6)) @@ -8,7 +8,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, variables = AGE, pooled_sd = FALSE), + ard_effectsize_cohens_d(by = ARM, variables = AGE, pooled_sd = FALSE), NA ) @@ -28,7 +28,7 @@ test_that("ard_cohens_d() works", { # errors are properly handled expect_snapshot( cards::ADSL |> - ard_cohens_d(by = ARM, variables = AGE) |> + ard_effectsize_cohens_d(by = ARM, variables = AGE) |> dplyr::select(c("variable", "stat_name", "error")) |> as.data.frame() ) @@ -37,7 +37,7 @@ test_that("ard_cohens_d() works", { expect_snapshot( cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_cohens_d(by = ARM, variables = c(BMIBL, HEIGHTBL)) |> + ard_effectsize_cohens_d(by = ARM, variables = c(BMIBL, HEIGHTBL)) |> dplyr::select(c(1:3, 5:6)) |> dplyr::group_by(variable) |> dplyr::slice_head(n = 3) |> @@ -45,7 +45,7 @@ test_that("ard_cohens_d() works", { ) }) -test_that("ard_paired_cohens_d() works", { +test_that("ard_effectsize_paired_cohens_d() works", { ADSL_paired <- cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> @@ -54,14 +54,14 @@ test_that("ard_paired_cohens_d() works", { dplyr::filter(dplyr::n() > 1) expect_error( - ard_paired_cohens_d <- + ard_effectsize_paired_cohens_d <- ADSL_paired |> - ard_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID), + ard_effectsize_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID), NA ) expect_equal( - ard_paired_cohens_d |> + ard_effectsize_paired_cohens_d |> cards::get_ard_statistics(stat_name %in% c("estimate", "conf.low", "conf.high")), with( data = @@ -88,7 +88,7 @@ test_that("ard_paired_cohens_d() works", { dplyr::mutate( ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM) ) |> - ard_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID) |> + ard_effectsize_paired_cohens_d(by = ARM, variable = AGE, id = USUBJID) |> dplyr::select(c("variable", "stat_name", "error")) |> as.data.frame() ) diff --git a/tests/testthat/test-ard_hedges_g.R b/tests/testthat/test-ard_effectsize_hedges_g.R similarity index 81% rename from tests/testthat/test-ard_hedges_g.R rename to tests/testthat/test-ard_effectsize_hedges_g.R index b85164704..47f84ed93 100644 --- a/tests/testthat/test-ard_hedges_g.R +++ b/tests/testthat/test-ard_effectsize_hedges_g.R @@ -1,13 +1,13 @@ -skip_if_not(cards::is_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("effectsize", "parameters", "withr"), reference_pkg = "cardx")) -test_that("ard_hedges_g() works", { +test_that("ard_effectsize_hedges_g() works", { withr::local_namespace("effectsize") expect_error( ard_hedges_g <- cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_hedges_g(by = ARM, variable = AGE), + ard_effectsize_hedges_g(by = ARM, variable = AGE), NA ) @@ -26,7 +26,7 @@ test_that("ard_hedges_g() works", { # errors are properly handled expect_snapshot( cards::ADSL |> - ard_hedges_g(by = ARM, variable = AGE) |> + ard_effectsize_hedges_g(by = ARM, variable = AGE) |> dplyr::select(c("variable", "stat_name", "error")) |> as.data.frame() ) @@ -35,7 +35,7 @@ test_that("ard_hedges_g() works", { expect_snapshot( cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_hedges_g(by = ARM, variables = c(BMIBL, HEIGHTBL)) |> + ard_effectsize_hedges_g(by = ARM, variables = c(BMIBL, HEIGHTBL)) |> dplyr::select(c(1:3, 5:6)) |> dplyr::group_by(variable) |> dplyr::slice_head(n = 3) |> @@ -43,7 +43,7 @@ test_that("ard_hedges_g() works", { ) }) -test_that("ard_paired_hedges_g() works", { +test_that("ard_effectsize_paired_hedges_g() works", { withr::local_namespace("effectsize") ADSL_paired <- @@ -56,7 +56,7 @@ test_that("ard_paired_hedges_g() works", { expect_error( ard_paired_hedges_g <- ADSL_paired |> - ard_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID), + ard_effectsize_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID), NA ) @@ -88,7 +88,7 @@ test_that("ard_paired_hedges_g() works", { dplyr::mutate( ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM) ) |> - ard_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID) |> + ard_effectsize_paired_hedges_g(by = ARM, variable = AGE, id = USUBJID) |> dplyr::select(c("variable", "stat_name", "error")) |> as.data.frame() ) diff --git a/tests/testthat/test-ard_proportion_ci.R b/tests/testthat/test-ard_proportion_ci.R index 58201779d..6f7ceb9b7 100644 --- a/tests/testthat/test-ard_proportion_ci.R +++ b/tests/testthat/test-ard_proportion_ci.R @@ -1,4 +1,4 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) test_that("ard_proportion_ci() works", { # testing the easy methods together diff --git a/tests/testthat/test-ard_regression.R b/tests/testthat/test-ard_regression.R index 3aa62f7c4..6fec0806e 100644 --- a/tests/testthat/test-ard_regression.R +++ b/tests/testthat/test-ard_regression.R @@ -1,4 +1,4 @@ -skip_if_not(cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")) +skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))) test_that("ard_regression() works", { expect_snapshot( diff --git a/tests/testthat/test-ard_regression_basic.R b/tests/testthat/test-ard_regression_basic.R index a97f89f9d..93932b563 100644 --- a/tests/testthat/test-ard_regression_basic.R +++ b/tests/testthat/test-ard_regression_basic.R @@ -1,4 +1,4 @@ -skip_if_not(cards::is_pkg_installed("broom.helpers", reference_pkg = "cardx")) +skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom.helpers", reference_pkg = "cardx"))) test_that("ard_regression_basic() works", { expect_error( diff --git a/tests/testthat/test-ard_smd.R b/tests/testthat/test-ard_smd_smd.R similarity index 73% rename from tests/testthat/test-ard_smd.R rename to tests/testthat/test-ard_smd_smd.R index df268141e..02a2d4523 100644 --- a/tests/testthat/test-ard_smd.R +++ b/tests/testthat/test-ard_smd_smd.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("smd", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("smd", reference_pkg = "cardx")) -test_that("ard_smd() works", { +test_that("ard_smd_smd() works", { expect_error( ard_smd <- mtcars |> - ard_smd(by = vs, variables = am, std.error = TRUE), + ard_smd_smd(by = vs, variables = am, std.error = TRUE), NA ) @@ -22,22 +22,23 @@ test_that("ard_smd() works", { dplyr::bind_rows( ard_smd, mtcars |> - ard_smd(by = vs, variables = gear, std.error = TRUE) + ard_smd_smd(by = vs, variables = gear, std.error = TRUE) ), mtcars |> - ard_smd(by = vs, variables = c(am, gear), std.error = TRUE) + ard_smd_smd(by = vs, variables = c(am, gear), std.error = TRUE) ) }) test_that("ard_smd() works with survey data", { - skip_if_not(cards::is_pkg_installed("survey", reference_pkg = "cardx")) + skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) + data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_smd <- dclus1 |> - ard_smd(by = both, variable = api00, std.error = TRUE), + ard_smd_smd(by = both, variable = api00, std.error = TRUE), NA ) @@ -55,7 +56,7 @@ test_that("ard_proptest() error messaging", { # mis-specify the gref argument expect_error( bad_gref <- - ard_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE, gref = 0) |> + ard_smd_smd(cards::ADSL, by = ARM, variables = AGE, std.error = TRUE, gref = 0) |> as.data.frame(), NA ) diff --git a/tests/testthat/test-ard_stats_anova.R b/tests/testthat/test-ard_stats_anova.R new file mode 100644 index 000000000..ec0197853 --- /dev/null +++ b/tests/testthat/test-ard_stats_anova.R @@ -0,0 +1,142 @@ +skip_if_not(is_pkg_installed(c("broom", "withr", "lme4", "survival", "geepack"), reference_pkg = "cardx")) + +test_that("ard_stats_anova.anova() works", { + expect_equal( + anova( + lm(mpg ~ am, mtcars), + lm(mpg ~ am + hp, mtcars) + ) |> + ard_stats_anova() |> + dplyr::select(variable, stat_name, stat) |> + dplyr::filter(!stat_name %in% "method"), + anova( + lm(mpg ~ am, mtcars), + lm(mpg ~ am + hp, mtcars) + ) |> + broom::tidy() |> + dplyr::mutate( + across(everything(), as.list), + variable = paste0("model_", dplyr::row_number()) + ) |> + tidyr::pivot_longer( + cols = -variable, + names_to = "stat_name", + values_to = "stat" + ) |> + dplyr::filter(!is.na(stat)), + ignore_attr = TRUE + ) +}) + +test_that("ard_stats_anova.data.frame() works", { + expect_equal( + anova( + lm(mpg ~ am, mtcars), + lm(mpg ~ am + hp, mtcars) + ) |> + ard_stats_anova(), + ard_stats_anova( + x = mtcars, + formulas = list(mpg ~ am, mpg ~ am + hp), + fn = "lm" + ) + ) + + # function works with a non-standard evaluation argument + expect_error( + ard_anova_geeglm <- + ard_stats_anova( + x = mtcars, + formulas = list(mpg ~ hp, mpg ~ hp + vs), + fn = "geeglm", + fn.args = list(id = cyl), + package = "geepack" + ), + NA + ) + expect_equal( + ard_anova_geeglm |> + dplyr::filter(stat_name == "p.value") |> + dplyr::pull(stat) |> + unlist(), + suppressWarnings( + anova( + geepack::geeglm(mpg ~ hp, data = mtcars, id = cyl), + geepack::geeglm(mpg ~ hp + vs, data = mtcars, id = cyl) + ) |> + broom::tidy() |> + dplyr::pull(p.value) + ) + ) + + # function works with a non-base R package + expect_error( + ard_anova_glmer <- + ard_stats_anova( + x = mtcars, + formulas = list(am ~ 1 + (1 | vs), am ~ mpg + (1 | vs)), + fn = "glmer", + fn.args = list(family = binomial), + package = "lme4" + ), + NA + ) + expect_equal( + ard_anova_glmer |> + dplyr::filter(stat_name == "p.value") |> + dplyr::pull(stat) |> + unlist(), + suppressMessages( + anova( + lme4::glmer(am ~ 1 + (1 | vs), data = mtcars, family = binomial), + lme4::glmer(am ~ mpg + (1 | vs), data = mtcars, family = binomial) + ) + ) |> + broom::tidy() |> + dplyr::pull(p.value) |> + keep(~ !is.na(.)) + ) + + # adding a testing with more complex env handling + args_fun <- function(args) { + ard_stats_anova( + x = mtcars, + formulas = list(am ~ 1 + (1 | vs), am ~ mpg + (1 | vs)), + fn = "glmer", + fn.args = {{ args }}, + package = "lme4" + ) + } + ard_anova_glmer2 <- args_fun(list(family = binomial)) + expect_equal( + ard_anova_glmer2, + ard_anova_glmer + ) + + # adding a testing with more complex env handling with NSE + args_fun <- function(args) { + ard_stats_anova( + x = mtcars, + formulas = list(mpg ~ hp, mpg ~ hp + vs), + fn = "geeglm", + fn.args = {{ args }}, + package = "geepack" + ) + } + ard_anova_geeglm2 <- args_fun(list(id = cyl)) + expect_equal( + ard_anova_geeglm2, + ard_anova_geeglm + ) +}) + +test_that("ard_stats_anova.data.frame() error messaging", { + expect_error( + ard_stats_anova( + x = mtcars, + formulas = list(mpg ~ am, mpg ~ am + hp), + fn = "base::lm" + ), + "cannot be namespaced" + ) +}) diff --git a/tests/testthat/test-ard_stats_aov.R b/tests/testthat/test-ard_stats_aov.R new file mode 100644 index 000000000..01de036ce --- /dev/null +++ b/tests/testthat/test-ard_stats_aov.R @@ -0,0 +1,29 @@ +skip_if_not(is_pkg_installed("broom.helpers", reference_pkg = "cardx")) + +test_that("ard_aov() works", { + expect_error( + ard_aov <- + ard_stats_aov(AGE ~ ARM, data = cards::ADSL), + NA + ) + + expect_equal( + ard_aov |> + cards::get_ard_statistics(stat_name %in% c("sumsq", "statistic")), + aov( + AGE ~ ARM, + data = cards::ADSL + ) |> + broom::tidy() |> + dplyr::slice_head() |> + dplyr::select(sumsq, statistic) |> + unclass(), + ignore_attr = TRUE + ) + + # see if it can handle multiple variables + expect_snapshot( + ard_stats_aov(AGE ~ ARM + SEX, data = cards::ADSL) |> + as.data.frame() + ) +}) diff --git a/tests/testthat/test-ard_chisqtest.R b/tests/testthat/test-ard_stats_chisq_test.R similarity index 72% rename from tests/testthat/test-ard_chisqtest.R rename to tests/testthat/test-ard_stats_chisq_test.R index 67d594564..0e99d39aa 100644 --- a/tests/testthat/test-ard_chisqtest.R +++ b/tests/testthat/test-ard_stats_chisq_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_chisqtest() works", { +test_that("ard_stats_chisq_test() works", { expect_error( ard_chisqtest <- cards::ADSL |> - ard_chisqtest(by = ARM, variables = AGEGR1), + ard_stats_chisq_test(by = ARM, variables = AGEGR1), NA ) @@ -23,10 +23,10 @@ test_that("ard_chisqtest() works", { dplyr::bind_rows( ard_chisqtest, cards::ADSL |> - ard_chisqtest(by = ARM, variables = BMIBLGR1) + ard_stats_chisq_test(by = ARM, variables = BMIBLGR1) ), cards::ADSL |> - ard_chisqtest(by = ARM, variables = c(AGEGR1, BMIBLGR1)) + ard_stats_chisq_test(by = ARM, variables = c(AGEGR1, BMIBLGR1)) ) }) @@ -35,12 +35,12 @@ test_that("shuffle_ard fills missing group levels if the group is meaningful", { expect_snapshot( cards::bind_ard( - ard_chisqtest( + ard_stats_chisq_test( data = adsl_sub, by = "ARM", variables = "AGEGR1" ), - ard_chisqtest( + ard_stats_chisq_test( data = adsl_sub, by = "SEX", variables = "AGEGR1" diff --git a/tests/testthat/test-ard_fishertest.R b/tests/testthat/test-ard_stats_fisher_test.R similarity index 63% rename from tests/testthat/test-ard_fishertest.R rename to tests/testthat/test-ard_stats_fisher_test.R index faf4ca8f2..eb7d2033c 100644 --- a/tests/testthat/test-ard_fishertest.R +++ b/tests/testthat/test-ard_stats_fisher_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_fishertest() works", { +test_that("ard_stats_fisher_test() works", { expect_error( ard_fishertest <- cards::ADSL[1:20, ] |> - ard_fishertest(by = ARM, variables = AGEGR1), + ard_stats_fisher_test(by = ARM, variables = AGEGR1), NA ) @@ -23,9 +23,9 @@ test_that("ard_fishertest() works", { dplyr::bind_rows( ard_fishertest, cards::ADSL[1:20, ] |> - ard_fishertest(by = ARM, variables = BMIBLGR1) + ard_stats_fisher_test(by = ARM, variables = BMIBLGR1) ), cards::ADSL[1:20, ] |> - ard_fishertest(by = ARM, variables = c(AGEGR1, BMIBLGR1)) + ard_stats_fisher_test(by = ARM, variables = c(AGEGR1, BMIBLGR1)) ) }) diff --git a/tests/testthat/test-ard_kruskaltest.R b/tests/testthat/test-ard_stats_kruskal_test.R similarity index 63% rename from tests/testthat/test-ard_kruskaltest.R rename to tests/testthat/test-ard_stats_kruskal_test.R index 8afc7f3eb..fb4e96bdb 100644 --- a/tests/testthat/test-ard_kruskaltest.R +++ b/tests/testthat/test-ard_stats_kruskal_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_kurskaltest() works", { +test_that("ard_stats_kruskal_test() works", { expect_error( ard_kruskaltest <- cards::ADSL |> - ard_kruskaltest(by = ARM, variables = AGE), + ard_stats_kruskal_test(by = ARM, variables = AGE), NA ) @@ -21,7 +21,7 @@ test_that("ard_kurskaltest() works", { # errors are properly handled expect_snapshot( cards::ADSL |> - ard_kruskaltest(by = "ARM", variables = "AGE") |> + ard_stats_kruskal_test(by = "ARM", variables = "AGE") |> as.data.frame() ) @@ -30,9 +30,9 @@ test_that("ard_kurskaltest() works", { dplyr::bind_rows( ard_kruskaltest, cards::ADSL |> - ard_kruskaltest(by = ARM, variable = BMIBL) + ard_stats_kruskal_test(by = ARM, variable = BMIBL) ), cards::ADSL |> - ard_kruskaltest(by = ARM, variable = c(AGE, BMIBL)) + ard_stats_kruskal_test(by = ARM, variable = c(AGE, BMIBL)) ) }) diff --git a/tests/testthat/test-ard_mcnemartest.R b/tests/testthat/test-ard_stats_mcnemar_test.R similarity index 66% rename from tests/testthat/test-ard_mcnemartest.R rename to tests/testthat/test-ard_stats_mcnemar_test.R index ae6f7efb1..5b54f50fa 100644 --- a/tests/testthat/test-ard_mcnemartest.R +++ b/tests/testthat/test-ard_stats_mcnemar_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_mcnemartest() works", { +test_that("ard_stats_mcnemar_test() works", { expect_error( ard_mcnemartest <- cards::ADSL |> - ard_mcnemartest(by = SEX, variables = EFFFL), + ard_stats_mcnemar_test(by = SEX, variables = EFFFL), NA ) @@ -20,7 +20,7 @@ test_that("ard_mcnemartest() works", { # errors are properly handled expect_equal( cards::ADSL |> - ard_mcnemartest(by = ARM, variables = AGE, correct = FALSE) |> + ard_stats_mcnemar_test(by = ARM, variables = AGE, correct = FALSE) |> dplyr::pull(error) |> getElement(1L), "'x' and 'y' must have the same number of levels (minimum 2)" @@ -33,10 +33,10 @@ test_that("ard_mcnemartest() works", { expect_equal( cards::ADSL |> dplyr::rename(`Planned Tx` = TRT01P, `Age Group` = AGEGR1) |> - ard_mcnemartest(by = `Planned Tx`, variables = `Age Group`) |> + ard_stats_mcnemar_test(by = `Planned Tx`, variables = `Age Group`) |> cards::get_ard_statistics(), cards::ADSL |> - ard_mcnemartest(by = TRT01P, variables = AGEGR1) |> + ard_stats_mcnemar_test(by = TRT01P, variables = AGEGR1) |> cards::get_ard_statistics() ) @@ -45,9 +45,9 @@ test_that("ard_mcnemartest() works", { dplyr::bind_rows( ard_mcnemartest, cards::ADSL |> - ard_mcnemartest(by = SEX, variables = COMP16FL) + ard_stats_mcnemar_test(by = SEX, variables = COMP16FL) ), cards::ADSL |> - ard_mcnemartest(by = SEX, variables = c(EFFFL, COMP16FL)) + ard_stats_mcnemar_test(by = SEX, variables = c(EFFFL, COMP16FL)) ) }) diff --git a/tests/testthat/test-ard_moodtest.R b/tests/testthat/test-ard_stats_mood_test.R similarity index 62% rename from tests/testthat/test-ard_moodtest.R rename to tests/testthat/test-ard_stats_mood_test.R index 895c1692c..292399b4c 100644 --- a/tests/testthat/test-ard_moodtest.R +++ b/tests/testthat/test-ard_stats_mood_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_moodtest() works", { +test_that("ard_stats_mood_test() works", { expect_error( ard_moodtest <- cards::ADSL |> - ard_moodtest(by = SEX, variable = AGE), + ard_stats_mood_test(by = SEX, variable = AGE), NA ) @@ -21,7 +21,7 @@ test_that("ard_moodtest() works", { # errors are properly handled expect_snapshot( cards::ADSL |> - ard_moodtest(by = SEX, variable = AGE) |> + ard_stats_mood_test(by = SEX, variable = AGE) |> as.data.frame() ) @@ -29,9 +29,9 @@ test_that("ard_moodtest() works", { dplyr::bind_rows( ard_moodtest, cards::ADSL |> - ard_moodtest(by = SEX, variable = BMIBL) + ard_stats_mood_test(by = SEX, variable = BMIBL) ), cards::ADSL |> - ard_moodtest(by = SEX, variable = c(AGE, BMIBL)) + ard_stats_mood_test(by = SEX, variable = c(AGE, BMIBL)) ) }) diff --git a/tests/testthat/test-ard_stats_oneway_test.R b/tests/testthat/test-ard_stats_oneway_test.R new file mode 100644 index 000000000..55edb7a07 --- /dev/null +++ b/tests/testthat/test-ard_stats_oneway_test.R @@ -0,0 +1,29 @@ +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) + +test_that("ard_stats_oneway_test() works", { + expect_error( + ard_onewaytest <- ard_stats_oneway_test(AGE ~ ARM, data = cards::ADSL), + NA + ) + + expect_equal( + ard_onewaytest |> + cards::get_ard_statistics(stat_name %in% c("num.df", "statistic", "method")), + oneway.test( + AGE ~ ARM, + data = cards::ADSL + ) |> + broom::tidy() |> + dplyr::select(num.df, statistic, method) |> + unclass(), + ignore_attr = TRUE + ) + + # warnings are properly handled - "variable" should be continuous, not character + # THE WARNING HERE IS VERY LONG, SO NOT CONVERTING TO data.frame TO KEEP THE CHECK EASY ON THE EYES + expect_snapshot( + ard_stats_oneway_test(AGEGR1 ~ ARM, data = cards::ADSL) |> + dplyr::select(c("stat_name", "stat", "warning")) |> + head(3) + ) +}) diff --git a/tests/testthat/test-ard_proptest.R b/tests/testthat/test-ard_stats_prop_test.R similarity index 81% rename from tests/testthat/test-ard_proptest.R rename to tests/testthat/test-ard_stats_prop_test.R index 10f7e798f..51b74adf6 100644 --- a/tests/testthat/test-ard_proptest.R +++ b/tests/testthat/test-ard_stats_prop_test.R @@ -1,10 +1,10 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_proptest() works", { +test_that("ard_stats_prop_test() works", { expect_error( ard_proptest <- mtcars |> - ard_proptest(by = vs, variables = am, conf.level = 0.90), + ard_stats_prop_test(by = vs, variables = am, conf.level = 0.90), NA ) @@ -31,19 +31,19 @@ test_that("ard_proptest() works", { dplyr::bind_rows( ard_proptest, mtcars |> - ard_proptest(by = vs, variables = gear, conf.level = 0.90) + ard_stats_prop_test(by = vs, variables = gear, conf.level = 0.90) ), mtcars |> - ard_proptest(by = vs, variables = c(am, gear), conf.level = 0.90) + ard_stats_prop_test(by = vs, variables = c(am, gear), conf.level = 0.90) ) }) -test_that("ard_proptest() error messaging", { +test_that("ard_stats_prop_test() error messaging", { # the AGE column is not binary and we should get an error captured expect_error( non_binary <- cards::ADSL |> - ard_proptest(by = ARM, variables = AGE) |> + ard_stats_prop_test(by = ARM, variables = AGE) |> as.data.frame(), NA ) @@ -66,7 +66,7 @@ test_that("ard_proptest() error messaging", { expect_error( too_many_levels <- mtcars |> - ard_proptest(by = cyl, variables = vs) |> + ard_stats_prop_test(by = cyl, variables = vs) |> as.data.frame(), NA ) diff --git a/tests/testthat/test-ard_ttest.R b/tests/testthat/test-ard_stats_t_test.R similarity index 78% rename from tests/testthat/test-ard_ttest.R rename to tests/testthat/test-ard_stats_t_test.R index 7d500e50e..15bb29a2d 100644 --- a/tests/testthat/test-ard_ttest.R +++ b/tests/testthat/test-ard_stats_t_test.R @@ -1,9 +1,9 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_ttest() works", { +test_that("ard_stats_t_test() works", { # One Sample t-test works expect_error( - ard_single <- ard_ttest(cards::ADSL, variable = AGE, var.equal = TRUE), + ard_single <- ard_stats_t_test(cards::ADSL, variable = AGE, var.equal = TRUE), NA ) @@ -25,7 +25,7 @@ test_that("ard_ttest() works", { ard_ttest <- cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_ttest(by = ARM, variable = AGE, var.equal = TRUE), + ard_stats_t_test(by = ARM, variable = AGE, var.equal = TRUE), NA ) @@ -46,7 +46,7 @@ test_that("ard_ttest() works", { # errors are properly handled expect_snapshot( cards::ADSL |> - ard_ttest(by = ARM, variable = AGE, var.equal = TRUE) |> + ard_stats_t_test(by = ARM, variable = AGE, var.equal = TRUE) |> as.data.frame() ) @@ -56,15 +56,15 @@ test_that("ard_ttest() works", { ard_ttest, cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_ttest(by = ARM, variable = BMIBL, var.equal = TRUE) + ard_stats_t_test(by = ARM, variable = BMIBL, var.equal = TRUE) ), cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_ttest(by = ARM, variable = c(AGE, BMIBL), var.equal = TRUE) + ard_stats_t_test(by = ARM, variable = c(AGE, BMIBL), var.equal = TRUE) ) }) -test_that("ard_paired_ttest() works", { +test_that("ard_stats_paired_t_test() works", { ADSL_paired <- cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> @@ -73,7 +73,7 @@ test_that("ard_paired_ttest() works", { expect_error( ard_paired_ttest <- ADSL_paired |> - ard_paired_ttest(by = ARM, variable = AGE, id = USUBJID, var.equal = TRUE), + ard_stats_paired_t_test(by = ARM, variable = AGE, id = USUBJID, var.equal = TRUE), NA ) @@ -107,7 +107,7 @@ test_that("ard_paired_ttest() works", { dplyr::mutate( ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM) ) |> - ard_paired_ttest(by = ARM, variable = AGE, id = USUBJID, var.equal = TRUE) |> + ard_stats_paired_t_test(by = ARM, variable = AGE, id = USUBJID, var.equal = TRUE) |> as.data.frame() ) }) diff --git a/tests/testthat/test-ard_wilcoxtest.R b/tests/testthat/test-ard_stats_wilcox_test.R similarity index 81% rename from tests/testthat/test-ard_wilcoxtest.R rename to tests/testthat/test-ard_stats_wilcox_test.R index 0b25261d3..a8fc09e1d 100644 --- a/tests/testthat/test-ard_wilcoxtest.R +++ b/tests/testthat/test-ard_stats_wilcox_test.R @@ -1,9 +1,9 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) -test_that("ard_wilcoxtest() works", { +test_that("ard_stats_wilcox_test() works", { # One Sample Wilcox works expect_error( - ard_single <- ard_wilcoxtest(cards::ADSL, variable = AGE), + ard_single <- ard_stats_wilcox_test(cards::ADSL, variable = AGE), NA ) @@ -24,7 +24,7 @@ test_that("ard_wilcoxtest() works", { ard_wilcoxtest <- cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_wilcoxtest(by = ARM, variable = AGE, correct = FALSE, conf.int = TRUE), + ard_stats_wilcox_test(by = ARM, variable = AGE, correct = FALSE, conf.int = TRUE), NA ) @@ -46,7 +46,7 @@ test_that("ard_wilcoxtest() works", { # errors are properly handled expect_equal( cards::ADSL |> - ard_wilcoxtest(by = ARM, variable = AGE, correct = FALSE) |> + ard_stats_wilcox_test(by = ARM, variable = AGE, correct = FALSE) |> dplyr::pull(error) |> getElement(1L), "grouping factor must have exactly 2 levels" @@ -58,15 +58,15 @@ test_that("ard_wilcoxtest() works", { ard_wilcoxtest, cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_wilcoxtest(by = ARM, variable = BMIBL, correct = FALSE, conf.int = TRUE) + ard_stats_wilcox_test(by = ARM, variable = BMIBL, correct = FALSE, conf.int = TRUE) ), cards::ADSL |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> - ard_wilcoxtest(by = ARM, variable = c(AGE, BMIBL), correct = FALSE, conf.int = TRUE) + ard_stats_wilcox_test(by = ARM, variable = c(AGE, BMIBL), correct = FALSE, conf.int = TRUE) ) }) -test_that("ard_paired_wilcoxtest() works", { +test_that("ard_stats_paired_wilcox_test() works", { ADSL_paired <- cards::ADSL[c("ARM", "AGE")] |> dplyr::filter(ARM %in% c("Placebo", "Xanomeline High Dose")) |> @@ -75,7 +75,7 @@ test_that("ard_paired_wilcoxtest() works", { expect_error( ard_paired_wilcoxtest <- ADSL_paired |> - ard_paired_wilcoxtest( + ard_stats_paired_wilcox_test( by = ARM, variable = AGE, id = USUBJID, correct = FALSE, conf.int = TRUE ), @@ -113,7 +113,7 @@ test_that("ard_paired_wilcoxtest() works", { dplyr::mutate( ARM = ifelse(dplyr::row_number() == 1L, "3rd ARM", ARM) ) |> - ard_paired_wilcoxtest( + ard_stats_paired_wilcox_test( by = ARM, variable = AGE, id = USUBJID, correct = FALSE, conf.int = TRUE ) |> diff --git a/tests/testthat/test-ard_svychisq.R b/tests/testthat/test-ard_survey_svychisq.R similarity index 75% rename from tests/testthat/test-ard_svychisq.R rename to tests/testthat/test-ard_survey_svychisq.R index be6f155cb..894fbbd8b 100644 --- a/tests/testthat/test-ard_svychisq.R +++ b/tests/testthat/test-ard_survey_svychisq.R @@ -1,12 +1,12 @@ -skip_if_not(cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) -test_that("ard_svychisq() works", { +test_that("ard_survey_svychisq() works", { data(api, package = "survey") dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) expect_error( ard_svychisq <- - ard_svychisq( + ard_survey_svychisq( dclus2, variables = sch.wide, by = comp.imp, @@ -26,7 +26,7 @@ test_that("ard_svychisq() works", { # test that the function works with multiple variables expect_snapshot( - ard_svychisq( + ard_survey_svychisq( dclus2, variables = c(sch.wide, stype), by = comp.imp, @@ -43,9 +43,9 @@ test_that("ard_svychisq() works", { dplyr::bind_rows( ard_svychisq, dclus2 |> - ard_svychisq(by = comp.imp, variables = stype) + ard_survey_svychisq(by = comp.imp, variables = stype) ), dclus2 |> - ard_svychisq(by = comp.imp, variables = c(sch.wide, stype)) + ard_survey_svychisq(by = comp.imp, variables = c(sch.wide, stype)) ) }) diff --git a/tests/testthat/test-ard_svycontinuous.R b/tests/testthat/test-ard_survey_svycontinuous.R similarity index 92% rename from tests/testthat/test-ard_svycontinuous.R rename to tests/testthat/test-ard_survey_svycontinuous.R index c7ceb4268..85e737ce7 100644 --- a/tests/testthat/test-ard_svycontinuous.R +++ b/tests/testthat/test-ard_survey_svycontinuous.R @@ -1,12 +1,12 @@ -skip_if_not(cards::is_pkg_installed("survey", reference_pkg = "cardx")) +skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) -test_that("unstratified ard_svycontinuous() works", { +test_that("unstratified ard_survey_svycontinuous() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_uni_svy_cont <- - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, statistic = ~ c( @@ -71,13 +71,13 @@ test_that("unstratified ard_svycontinuous() works", { }) -test_that("stratified ard_svycontinuous() works", { +test_that("stratified ard_survey_svycontinuous() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_svy_cont <- - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, by = both, variables = api00, @@ -238,13 +238,13 @@ test_that("stratified ard_svycontinuous() works", { ) }) -test_that("ard_svycontinuous() NA handling", { +test_that("ard_survey_svycontinuous() NA handling", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1 |> dplyr::mutate(api00 = NA_real_), fpc = ~fpc) expect_error( ard_uni_NA_svy_cont <- - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, statistic = ~ c( @@ -263,7 +263,7 @@ test_that("ard_svycontinuous() NA handling", { expect_error( ard_NA_svy_cont <- - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, by = both, @@ -282,7 +282,7 @@ test_that("ard_svycontinuous() NA handling", { ) }) -test_that("ard_svycontinuous() error handling", { +test_that("ard_survey_svycontinuous() error handling", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1[1:20, ], fpc = ~fpc) @@ -290,7 +290,7 @@ test_that("ard_svycontinuous() error handling", { # and these "results" may vary across systems (all are nonsense), so just check # that code runs without error expect_error( - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = sname, statistic = ~ c( @@ -302,7 +302,7 @@ test_that("ard_svycontinuous() error handling", { ) expect_error( - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = sname, by = both, @@ -315,12 +315,12 @@ test_that("ard_svycontinuous() error handling", { ) }) -test_that("ard_svycontinuous(fmt_fn)", { +test_that("ard_survey_svycontinuous(fmt_fn)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -329,12 +329,12 @@ test_that("ard_svycontinuous(fmt_fn)", { ) }) -test_that("ard_svycontinuous(stat_label)", { +test_that("ard_survey_svycontinuous(stat_label)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -343,7 +343,7 @@ test_that("ard_svycontinuous(stat_label)", { ) }) -test_that("ard_svycontinuous(by) unobserved levels/combinations", { +test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { data(api, package = "survey") dclus1 <- survey::svydesign( id = ~dnum, weights = ~pw, @@ -359,7 +359,7 @@ test_that("ard_svycontinuous(by) unobserved levels/combinations", { # The 'Neither' level is never observed, but included in the table expect_setequal( levels(dclus1$variables$both), - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, by = both, @@ -373,7 +373,7 @@ test_that("ard_svycontinuous(by) unobserved levels/combinations", { # stype="E" is not observed with awards="No", but it should still appear in table with(dclus1$variables, table(stype, awards)) expect_equal( - ard_svycontinuous( + ard_survey_svycontinuous( dclus1, variables = api00, by = c(stype, awards), diff --git a/tests/testthat/test-ard_survey_svyranktest.R b/tests/testthat/test-ard_survey_svyranktest.R new file mode 100644 index 000000000..610beb4ae --- /dev/null +++ b/tests/testthat/test-ard_survey_svyranktest.R @@ -0,0 +1,41 @@ +skip_if_not(is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) + +test_that("ard_survey_svyranktest() works", { + data(api, package = "survey") + dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) + svyranktest <- lapply( + c("wilcoxon", "vanderWaerden", "median", "KruskalWallis"), + function(x) { + ard_survey_svyranktest( + dclus2, + variable = enroll, + by = comp.imp, + test = x + ) + } + ) + + expect_snapshot(svyranktest[[1]] |> as.data.frame() |> dplyr::select(stat_label, stat)) + expect_snapshot(svyranktest[[2]] |> as.data.frame() |> dplyr::select(stat_label, stat)) + expect_snapshot(svyranktest[[3]] |> as.data.frame() |> dplyr::select(stat_label, stat)) + expect_snapshot(svyranktest[[4]] |> as.data.frame() |> dplyr::select(stat_label, stat)) +}) + +test_that("exact values match for ard_svyranktest works", { + data(api, package = "survey") + dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) + svywilcox <- ard_survey_svyranktest( + dclus2, + variable = enroll, + by = comp.imp, + test = "wilcoxon" + ) + expect_equal( + cards::get_ard_statistics( + svywilcox, + stat_name %in% c("estimate", "p.value") + ), + survey::svyranktest(enroll ~ comp.imp, dclus2, test = "wilcoxon")[c("estimate", "p.value")], + ignore_attr = TRUE + ) +}) diff --git a/tests/testthat/test-ard_svyttest.R b/tests/testthat/test-ard_survey_svyttest.R similarity index 83% rename from tests/testthat/test-ard_svyttest.R rename to tests/testthat/test-ard_survey_svyttest.R index bb36853a7..c1d04eb34 100644 --- a/tests/testthat/test-ard_svyttest.R +++ b/tests/testthat/test-ard_survey_svyttest.R @@ -1,12 +1,12 @@ -skip_if_not(cards::is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("survey", "broom"), reference_pkg = "cardx")) -test_that("ard_svyttest() works", { +test_that("ard_survey_svyttest() works", { data(api, package = "survey") dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) expect_error( ard_svyttest <- - ard_svyttest( + ard_survey_svyttest( dclus2, variable = enroll, by = comp.imp, @@ -39,14 +39,14 @@ test_that("ard_svyttest() works", { expect_equal( dplyr::bind_rows( ard_svyttest, - ard_svyttest( + ard_survey_svyttest( dclus2, variable = mobility, by = comp.imp, conf.level = 0.9 ) ), - ard_svyttest( + ard_survey_svyttest( dclus2, variable = c(enroll, mobility), by = comp.imp, @@ -55,13 +55,13 @@ test_that("ard_svyttest() works", { ) }) -test_that("ard_svyttest() messaging", { +test_that("ard_survey_svyttest() messaging", { data(api, package = "survey") dclus2 <- survey::svydesign(id = ~ dnum + snum, fpc = ~ fpc1 + fpc2, data = apiclus2) expect_error( ard_svyttest <- - ard_svyttest( + ard_survey_svyttest( dclus2, variable = enroll, by = stype diff --git a/tests/testthat/test-ard_survival_survdiff.R b/tests/testthat/test-ard_survival_survdiff.R new file mode 100644 index 000000000..1ae555b10 --- /dev/null +++ b/tests/testthat/test-ard_survival_survdiff.R @@ -0,0 +1,62 @@ +skip_if_not(is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")) + +test_that("ard_survival_survdiff() works", { + # Log-rank test ---- + expect_error( + ard_survival_survdiff <- + ard_survival_survdiff(survival::Surv(AVAL, CNSR) ~ TRTA, data = cards::ADTTE), + NA + ) + + expect_equal( + ard_survival_survdiff |> + dplyr::slice(-nrow(ard_survival_survdiff)) |> + cards::get_ard_statistics(), + survival::survdiff(survival::Surv(AVAL, CNSR) ~ TRTA, data = cards::ADTTE) |> + broom::glance() |> + as.list() + ) + expect_equal( + ard_survival_survdiff$stat[ard_survival_survdiff$stat_name %in% "method"], + list("Log-rank test") + ) + + # Tarone-Ware test ---- + expect_error( + ard_survival_survdiff <- + ard_survival_survdiff(survival::Surv(AVAL, CNSR) ~ TRTA, data = cards::ADTTE, rho = 1.5), + NA + ) + + expect_equal( + ard_survival_survdiff |> + dplyr::slice(-nrow(ard_survival_survdiff)) |> + cards::get_ard_statistics(), + survival::survdiff(survival::Surv(AVAL, CNSR) ~ TRTA, data = cards::ADTTE, rho = 1.5) |> + broom::glance() |> + as.list() + ) + expect_equal( + ard_survival_survdiff$stat[ard_survival_survdiff$stat_name %in% "method"], + list("Tarone-Ware test") + ) +}) + +test_that("ard_survival_survdiff() error messaging", { + expect_error( + ard_survival_survdiff(survival::Surv(AVAL, CNSR) ~ 1, data = cards::ADTTE), + "There was an error" + ) + + expect_error( + ard_survival_survdiff <- + ard_survival_survdiff(survival::Surv(AVAL, CNSR) ~ not_a_variable, data = cards::ADTTE), + NA + ) + expect_true( + ard_survival_survdiff |> nrow() == 4L + ) + expect_true( + ard_survival_survdiff$error |> unique() |> grepl(pattern = "*'not_a_variable'*", x = _) + ) +}) diff --git a/tests/testthat/test-ard_survival_survfit.R b/tests/testthat/test-ard_survival_survfit.R new file mode 100644 index 000000000..d12d4ac32 --- /dev/null +++ b/tests/testthat/test-ard_survival_survfit.R @@ -0,0 +1,143 @@ +skip_if_not(is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")) + +test_that("ard_survival_survfit() works with times provided", { + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() works with different type", { + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = c(60, 180), type = "risk") |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() works with probs provided", { + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(probs = c(0.25, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() works with unstratified model", { + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ 1, data = survival::lung) |> + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) + + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ 1, data = survival::lung) |> + ard_survival_survfit(probs = c(0.5, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() works with multiple stratification variables", { + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + dplyr::select("group1", "group1_level", "group2", "group2_level") |> + head(20) |> + print(n = Inf) + ) + + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> + ard_survival_survfit(probs = c(0.5, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + dplyr::select("group1", "group1_level", "group2", "group2_level") |> + head(20) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() works with competing risks", { + set.seed(1) + ADTTE_MS <- cards::ADTTE %>% + dplyr::mutate( + CNSR = dplyr::case_when( + CNSR == 0 ~ "censor", + runif(dplyr::n()) < 0.5 ~ "death from cancer", + TRUE ~ "death other causes" + ) %>% factor() + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survival_survfit() errors are properly handled", { + expect_snapshot( + ard_survival_survfit("not_survfit"), + error = TRUE + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = 100, type = "notatype"), + error = TRUE + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survival_survfit(times = 100, probs = c(0.25, 0.75)), + error = TRUE + ) +}) + +test_that("ard_survival_survfit() works with non-syntactic names", { + expect_equal( + survival::survfit(survival::Surv(time, status) ~ factor(sex) + `ph.ecog`, data = survival::lung) |> + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ), + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> + ard_survival_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) + ) +}) + +test_that("ard_survival_survfit() errors with stratified Cox model", { + withr::local_namespace("survival") + expect_snapshot( + error = TRUE, + coxph(Surv(time, status) ~ age + strata(sex), survival::lung) |> + survfit() |> + ard_survival_survfit() + ) +}) diff --git a/tests/testthat/test-proportion_ci.R b/tests/testthat/test-proportion_ci.R index 8e0b1a326..0129a5b94 100644 --- a/tests/testthat/test-proportion_ci.R +++ b/tests/testthat/test-proportion_ci.R @@ -1,4 +1,4 @@ -skip_if_not(cards::is_pkg_installed("broom", reference_pkg = "cardx")) +skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) test_that("check the proportion_ci_*() functions work", { # setting vectors to test