From 3973772b377ede8ae51912f2c888b2071bb5285b Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Wed, 22 May 2024 14:04:52 -0700 Subject: [PATCH 1/3] Making `ard_survey_svycontinuous()` a S3 method (#150) **What changes are proposed in this pull request?** Converted `ard_survey_svycontinuous()` to a S3 method `ard_continuous.survey.design()`. -------------------------------------------------------------------------------- Pre-review Checklist (if item does not apply, mark is as complete) - [x] **All** GitHub Action workflows pass with a :white_check_mark: - [x] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()` - [x] If a bug was fixed, a unit test was added. - [x] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`. - [x] If a new `ard_*()` function was added, `set_cli_abort_call()` has been set. - [x] 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"))` - [x] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` Reviewer Checklist (if item does not apply, mark is as complete) - [ ] If a bug was fixed, a unit test was added. - [ ] 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 "`# 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". --- DESCRIPTION | 6 +-- NAMESPACE | 13 +++++- NEWS.md | 3 +- R/ard_attributes.survey.design.R | 37 +++++++++++++++ ...nuous.R => ard_continuous.survey.design.R} | 15 +++--- R/reexports.R | 21 +++++++++ _pkgdown.yml | 3 +- man/ard_attributes.Rd | 46 +++++++++++++++++++ ...ous.Rd => ard_continuous.survey.design.Rd} | 15 +++--- man/reexports.Rd | 7 +++ ...ous.md => ard_continuous.survey.design.md} | 17 ++++--- .../test-ard_attributes.survey.design.R | 17 +++++++ ....R => test-ard_continuous.survey.design.R} | 34 +++++++------- 13 files changed, 190 insertions(+), 44 deletions(-) create mode 100644 R/ard_attributes.survey.design.R rename R/{ard_survey_svycontinuous.R => ard_continuous.survey.design.R} (95%) create mode 100644 man/ard_attributes.Rd rename man/{ard_survey_svycontinuous.Rd => ard_continuous.survey.design.Rd} (88%) rename tests/testthat/_snaps/{ard_survey_svycontinuous.md => ard_continuous.survey.design.md} (77%) create mode 100644 tests/testthat/test-ard_attributes.survey.design.R rename tests/testthat/{test-ard_survey_svycontinuous.R => test-ard_continuous.survey.design.R} (93%) diff --git a/DESCRIPTION b/DESCRIPTION index f2e66a110..d94ccaa3f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues Depends: R (>= 4.1) Imports: - cards (>= 0.1.0.9014), + cards (>= 0.1.0.9026), cli (>= 3.6.1), dplyr (>= 1.1.2), glue (>= 1.6.2), @@ -33,13 +33,13 @@ Suggests: effectsize (>= 0.6.0), emmeans (>= 1.7.3), geepack (>= 1.3.2), - ggsurvfit (>= 1.0.0), + ggsurvfit (>= 1.1.0), lme4 (>= 1.1-31), parameters (>= 0.20.2), smd (>= 0.6.6), spelling, survey (>= 4.1), - survival (>= 3.2-11), + survival (>= 3.6-4), testthat (>= 3.2.0), withr (>= 2.5.0) Remotes: diff --git a/NAMESPACE b/NAMESPACE index d1e1abdba..43f5d3d5c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(ard_attributes,survey.design) +S3method(ard_continuous,survey.design) S3method(ard_regression,default) S3method(ard_stats_anova,anova) S3method(ard_stats_anova,data.frame) @@ -9,13 +11,18 @@ export("%>%") export(all_of) export(any_of) export(ard_aod_wald_test) +export(ard_attributes) export(ard_car_anova) export(ard_car_vif) +export(ard_categorical) +export(ard_continuous) +export(ard_dichotomous) export(ard_effectsize_cohens_d) export(ard_effectsize_hedges_g) export(ard_effectsize_paired_cohens_d) export(ard_effectsize_paired_hedges_g) export(ard_emmeans_mean_difference) +export(ard_missing) export(ard_proportion_ci) export(ard_regression) export(ard_regression_basic) @@ -35,7 +42,6 @@ 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) @@ -60,6 +66,11 @@ export(reformulate2) export(starts_with) export(where) import(rlang) +importFrom(cards,ard_attributes) +importFrom(cards,ard_categorical) +importFrom(cards,ard_continuous) +importFrom(cards,ard_dichotomous) +importFrom(cards,ard_missing) importFrom(dplyr,"%>%") importFrom(dplyr,across) importFrom(dplyr,all_of) diff --git a/NEWS.md b/NEWS.md index 2459929a0..4aa1adcc2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,7 +30,8 @@ ard_moodtest() -> ard_stats_mood_test() - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) - `ard_smd_smd()` for calculating standardized mean differences using `smd::smd()`. (#4) - `ard_survival_survfit()` for survival analyses using `survival::survfit()`. (#43) - - `ard_survey_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) + - `ard_continuous.survey.design()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) + - `ard_attributes.survey.design()` for summarizing labels and attributes from weighted/survey data using many functions from the {survey} package. - `ard_survey_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72) - `ard_survey_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70) - `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71) diff --git a/R/ard_attributes.survey.design.R b/R/ard_attributes.survey.design.R new file mode 100644 index 000000000..b3f069768 --- /dev/null +++ b/R/ard_attributes.survey.design.R @@ -0,0 +1,37 @@ +#' ARD Attributes +#' +#' @description +#' Add variable attributes to an ARD data frame. +#' - The `label` attribute will be added for all columns, and when no label +#' is specified and no label has been set for a column using the `label=` argument, +#' the column name will be placed in the label statistic. +#' - The `class` attribute will also be returned for all columns. +#' - Any other attribute returned by `attributes()` will also be added, e.g. factor levels. +#' +#' @rdname ard_attributes +#' @param data (`survey.design`)\cr +#' a design object often created with [`survey::svydesign()`]. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' variables to include +#' @param label (named `list`)\cr +#' named list of variable labels, e.g. `list(cyl = "No. Cylinders")`. +#' Default is `NULL` +#' @inheritParams rlang::args_dots_empty +#' +#' @return an ARD data frame of class 'card' +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx")) +#' data(api, package = "survey") +#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) +#' +#' ard_attributes( +#' data = dclus1, +#' variables = c(sname, dname), +#' label = list(sname = "School Name", dname = "District Name") +#' ) +ard_attributes.survey.design <- function(data, variables = everything(), label = NULL, ...) { + set_cli_abort_call() + + cards::ard_attributes(data = data[["variables"]], variables = {{ variables }}, label = label, ...) +} diff --git a/R/ard_survey_svycontinuous.R b/R/ard_continuous.survey.design.R similarity index 95% rename from R/ard_survey_svycontinuous.R rename to R/ard_continuous.survey.design.R index 16d51fd5d..77c5b2b84 100644 --- a/R/ard_survey_svycontinuous.R +++ b/R/ard_continuous.survey.design.R @@ -23,6 +23,7 @@ #' the list element is either a named list or a list of formulas defining the #' statistic labels, e.g. `everything() ~ list(mean = "Mean", sd = "SD")` or #' `everything() ~ list(mean ~ "Mean", sd ~ "SD")`. +#' @inheritParams rlang::args_dots_empty #' #' @section statistic argument: #' @@ -38,16 +39,18 @@ #' data(api, package = "survey") #' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) #' -#' ard_survey_svycontinuous( +#' ard_continuous( #' data = dclus1, #' variables = api00, #' by = stype #' ) -ard_survey_svycontinuous <- function(data, variables, by = NULL, - statistic = everything() ~ c("median", "p25", "p75"), - fmt_fn = NULL, - stat_label = NULL) { +ard_continuous.survey.design <- function(data, variables, by = NULL, + statistic = everything() ~ c("median", "p25", "p75"), + fmt_fn = NULL, + stat_label = NULL, + ...) { set_cli_abort_call() + check_dots_empty() # check installed packages --------------------------------------------------- check_pkg_installed(pkg = "survey", reference_pkg = "cardx") @@ -68,7 +71,7 @@ ard_survey_svycontinuous <- function(data, variables, by = NULL, ) cards::fill_formula_selectors( data$variables[variables], - statistic = formals(ard_survey_svycontinuous)[["statistic"]] |> eval() + statistic = formals(asNamespace("cardx")[["ard_continuous.survey.design"]])[["statistic"]] |> eval() ) cards::check_list_elements( x = statistic, diff --git a/R/reexports.R b/R/reexports.R index a7ae12e44..adc647104 100644 --- a/R/reexports.R +++ b/R/reexports.R @@ -1,3 +1,24 @@ +# cards ------------------------------------------------------------------------ +#' @importFrom cards ard_continuous +#' @export +cards::ard_continuous + +#' @importFrom cards ard_categorical +#' @export +cards::ard_categorical + +#' @importFrom cards ard_dichotomous +#' @export +cards::ard_dichotomous + +#' @importFrom cards ard_missing +#' @export +cards::ard_missing + +#' @importFrom cards ard_attributes +#' @export +cards::ard_attributes + # dplyr ------------------------------------------------------------------------ #' @export #' @importFrom dplyr %>% diff --git a/_pkgdown.yml b/_pkgdown.yml index a1acfa498..2e5965d2d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -60,8 +60,9 @@ reference: - subtitle: "{survey} package" - contents: + - ard_continuous.survey.design + - ard_attributes.survey.design - ard_survey_svychisq - - ard_survey_svycontinuous - ard_survey_svyranktest - ard_survey_svyttest diff --git a/man/ard_attributes.Rd b/man/ard_attributes.Rd new file mode 100644 index 000000000..6069aae4d --- /dev/null +++ b/man/ard_attributes.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_attributes.survey.design.R +\name{ard_attributes.survey.design} +\alias{ard_attributes.survey.design} +\title{ARD Attributes} +\usage{ +\method{ard_attributes}{survey.design}(data, variables = everything(), label = NULL, ...) +} +\arguments{ +\item{data}{(\code{survey.design})\cr +a design object often created with \code{\link[survey:svydesign]{survey::svydesign()}}.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +variables to include} + +\item{label}{(named \code{list})\cr +named list of variable labels, e.g. \code{list(cyl = "No. Cylinders")}. +Default is \code{NULL}} + +\item{...}{These dots are for future extensions and must be empty.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Add variable attributes to an ARD data frame. +\itemize{ +\item The \code{label} attribute will be added for all columns, and when no label +is specified and no label has been set for a column using the \verb{label=} argument, +the column name will be placed in the label statistic. +\item The \code{class} attribute will also be returned for all columns. +\item Any other attribute returned by \code{attributes()} will also be added, e.g. factor levels. +} +} +\examples{ +\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_attributes( + data = dclus1, + variables = c(sname, dname), + label = list(sname = "School Name", dname = "District Name") +) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_survey_svycontinuous.Rd b/man/ard_continuous.survey.design.Rd similarity index 88% rename from man/ard_survey_svycontinuous.Rd rename to man/ard_continuous.survey.design.Rd index 8e5df93d2..6ba18722a 100644 --- a/man/ard_survey_svycontinuous.Rd +++ b/man/ard_continuous.survey.design.Rd @@ -1,16 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_survey_svycontinuous.R -\name{ard_survey_svycontinuous} -\alias{ard_survey_svycontinuous} +% Please edit documentation in R/ard_continuous.survey.design.R +\name{ard_continuous.survey.design} +\alias{ard_continuous.survey.design} \title{ARD Continuous Survey Statistics} \usage{ -ard_survey_svycontinuous( +\method{ard_continuous}{survey.design}( data, variables, by = NULL, statistic = everything() ~ c("median", "p25", "p75"), fmt_fn = NULL, - stat_label = NULL + stat_label = NULL, + ... ) } \arguments{ @@ -40,6 +41,8 @@ a named list, a list of formulas, or a single formula where the list element is either a named list or a list of formulas defining the statistic labels, e.g. \code{everything() ~ list(mean = "Mean", sd = "SD")} or \code{everything() ~ list(mean ~ "Mean", sd ~ "SD")}.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ an ARD data frame of class 'card' @@ -60,7 +63,7 @@ where 'p##' is are the percentiles and \verb{##} is an integer between 0 and 100 data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) -ard_survey_svycontinuous( +ard_continuous( data = dclus1, variables = api00, by = stype diff --git a/man/reexports.Rd b/man/reexports.Rd index 12e1f5269..927068d41 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -3,6 +3,11 @@ \docType{import} \name{reexports} \alias{reexports} +\alias{ard_continuous} +\alias{ard_categorical} +\alias{ard_dichotomous} +\alias{ard_missing} +\alias{ard_attributes} \alias{\%>\%} \alias{starts_with} \alias{ends_with} @@ -22,6 +27,8 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ + \item{cards}{\code{\link[cards]{ard_attributes}}, \code{\link[cards]{ard_categorical}}, \code{\link[cards]{ard_continuous}}, \code{\link[cards]{ard_dichotomous}}, \code{\link[cards]{ard_missing}}} + \item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}, \code{\link[dplyr:reexports]{all_of}}, \code{\link[dplyr:reexports]{any_of}}, \code{\link[dplyr:reexports]{contains}}, \code{\link[dplyr:reexports]{ends_with}}, \code{\link[dplyr:reexports]{everything}}, \code{\link[dplyr:reexports]{last_col}}, \code{\link[dplyr:reexports]{matches}}, \code{\link[dplyr:reexports]{num_range}}, \code{\link[dplyr:reexports]{one_of}}, \code{\link[dplyr:reexports]{starts_with}}, \code{\link[dplyr:reexports]{where}}} }} diff --git a/tests/testthat/_snaps/ard_survey_svycontinuous.md b/tests/testthat/_snaps/ard_continuous.survey.design.md similarity index 77% rename from tests/testthat/_snaps/ard_survey_svycontinuous.md rename to tests/testthat/_snaps/ard_continuous.survey.design.md index 7dbd96603..348621925 100644 --- a/tests/testthat/_snaps/ard_survey_svycontinuous.md +++ b/tests/testthat/_snaps/ard_continuous.survey.design.md @@ -1,4 +1,4 @@ -# unstratified ard_survey_svycontinuous() works +# unstratified ard_continuous.survey.design() works Code ard_uni_svy_cont @@ -19,12 +19,11 @@ Message i 2 more variables: warning, error -# ard_survey_svycontinuous(fmt_fn) +# ard_continuous.survey.design(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))) + ard_continuous(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 @@ -36,12 +35,12 @@ Message i 2 more variables: warning, error -# ard_survey_svycontinuous(stat_label) +# ard_continuous.survey.design(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"))) + ard_continuous(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 diff --git a/tests/testthat/test-ard_attributes.survey.design.R b/tests/testthat/test-ard_attributes.survey.design.R new file mode 100644 index 000000000..e4f663eec --- /dev/null +++ b/tests/testthat/test-ard_attributes.survey.design.R @@ -0,0 +1,17 @@ +skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) + +test_that("ard_attributes.survey.design() works", { + data(api, package = "survey") + dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) + + expect_snapshot({ + attr(dclus1$variables$sname, "label") <- "School Name" + + ard_attributes( + dclus1, + variables = c(sname, dname), + label = list(dname = "District Name") + ) |> + as.data.frame() + }) +}) diff --git a/tests/testthat/test-ard_survey_svycontinuous.R b/tests/testthat/test-ard_continuous.survey.design.R similarity index 93% rename from tests/testthat/test-ard_survey_svycontinuous.R rename to tests/testthat/test-ard_continuous.survey.design.R index 85e737ce7..5b999d918 100644 --- a/tests/testthat/test-ard_survey_svycontinuous.R +++ b/tests/testthat/test-ard_continuous.survey.design.R @@ -1,12 +1,12 @@ skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) -test_that("unstratified ard_survey_svycontinuous() works", { +test_that("unstratified ard_continuous.survey.design() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_uni_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c( @@ -71,13 +71,13 @@ test_that("unstratified ard_survey_svycontinuous() works", { }) -test_that("stratified ard_survey_svycontinuous() works", { +test_that("stratified ard_continuous.survey.design() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, by = both, variables = api00, @@ -238,13 +238,13 @@ test_that("stratified ard_survey_svycontinuous() works", { ) }) -test_that("ard_survey_svycontinuous() NA handling", { +test_that("ard_continuous.survey.design() 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_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c( @@ -263,7 +263,7 @@ test_that("ard_survey_svycontinuous() NA handling", { expect_error( ard_NA_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = both, @@ -282,7 +282,7 @@ test_that("ard_survey_svycontinuous() NA handling", { ) }) -test_that("ard_survey_svycontinuous() error handling", { +test_that("ard_continuous.survey.design() 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_survey_svycontinuous() error handling", { # and these "results" may vary across systems (all are nonsense), so just check # that code runs without error expect_error( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = sname, statistic = ~ c( @@ -302,7 +302,7 @@ test_that("ard_survey_svycontinuous() error handling", { ) expect_error( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = sname, by = both, @@ -315,12 +315,12 @@ test_that("ard_survey_svycontinuous() error handling", { ) }) -test_that("ard_survey_svycontinuous(fmt_fn)", { +test_that("ard_continuous.survey.design(fmt_fn)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -329,12 +329,12 @@ test_that("ard_survey_svycontinuous(fmt_fn)", { ) }) -test_that("ard_survey_svycontinuous(stat_label)", { +test_that("ard_continuous.survey.design(stat_label)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -343,7 +343,7 @@ test_that("ard_survey_svycontinuous(stat_label)", { ) }) -test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { +test_that("ard_continuous.survey.design(by) unobserved levels/combinations", { data(api, package = "survey") dclus1 <- survey::svydesign( id = ~dnum, weights = ~pw, @@ -359,7 +359,7 @@ test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { # The 'Neither' level is never observed, but included in the table expect_setequal( levels(dclus1$variables$both), - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = both, @@ -373,7 +373,7 @@ test_that("ard_survey_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_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = c(stype, awards), From c99e8d78b9d7f648d8d7fbcf7a9a2dcca9c04b06 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Wed, 22 May 2024 21:05:46 +0000 Subject: [PATCH 2/3] [skip actions] Bump version to 0.1.0.9043 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d94ccaa3f..7143ed771 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cardx Title: Extra Analysis Results Data Utilities -Version: 0.1.0.9042 +Version: 0.1.0.9043 Authors@R: c( person("Daniel", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre")), person("Abinaya", "Yogasekaram", , "abinaya.yogasekaram@contractors.roche.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 4aa1adcc2..1b3f8e7ff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# cardx 0.1.0.9042 +# cardx 0.1.0.9043 ### Breaking Changes From e2e448c34dddc2c450cab52692eefc2a6565f6ce Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Thu, 23 May 2024 13:58:50 -0700 Subject: [PATCH 3/3] Adding one-sample CI functions (#156) **What changes are proposed in this pull request?** - `ard_stats_wilcox_test_onesample()` for calculating one-sample results. - `ard_stats_t_test_onesample()` for calculating one-sample results. -------------------------------------------------------------------------------- Pre-review Checklist (if item does not apply, mark is as complete) - [x] **All** GitHub Action workflows pass with a :white_check_mark: - [x] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()` - [x] If a bug was fixed, a unit test was added. - [x] If a new `ard_*()` function was added, it passes the ARD structural checks from `cards::check_ard_structure()`. - [x] If a new `ard_*()` function was added, `set_cli_abort_call()` has been set. - [x] 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"))` - [x] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` Reviewer Checklist (if item does not apply, mark is as complete) - [x] If a bug was fixed, a unit test was added. - [x] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: - [x] 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). - [x] **All** GitHub Action workflows pass with a :white_check_mark: - [x] Approve Pull Request - [x] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --- NAMESPACE | 2 + NEWS.md | 2 + R/ard_stats_t_test_onesample.R | 71 ++++++++++++++++++ R/ard_stats_wilcox_test_onesample.R | 72 +++++++++++++++++++ README.Rmd | 2 +- README.md | 2 +- _pkgdown.yml | 2 + man/ard_stats_t_test_onesample.Rd | 43 +++++++++++ man/ard_stats_wilcox_test_onesample.Rd | 43 +++++++++++ .../test-ard_stats_t_test_onesample.R | 50 +++++++++++++ .../test-ard_stats_wilcox_test_onesample.R | 52 ++++++++++++++ 11 files changed, 339 insertions(+), 2 deletions(-) create mode 100644 R/ard_stats_t_test_onesample.R create mode 100644 R/ard_stats_wilcox_test_onesample.R create mode 100644 man/ard_stats_t_test_onesample.Rd create mode 100644 man/ard_stats_wilcox_test_onesample.Rd create mode 100644 tests/testthat/test-ard_stats_t_test_onesample.R create mode 100644 tests/testthat/test-ard_stats_wilcox_test_onesample.R diff --git a/NAMESPACE b/NAMESPACE index 43f5d3d5c..f222cfdee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,7 +40,9 @@ export(ard_stats_paired_t_test) export(ard_stats_paired_wilcox_test) export(ard_stats_prop_test) export(ard_stats_t_test) +export(ard_stats_t_test_onesample) export(ard_stats_wilcox_test) +export(ard_stats_wilcox_test_onesample) export(ard_survey_svychisq) export(ard_survey_svyranktest) export(ard_survey_svyttest) diff --git a/NEWS.md b/NEWS.md index 1b3f8e7ff..7b8e77c93 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,6 +37,8 @@ ard_moodtest() -> ard_stats_mood_test() - `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71) - `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) - `ard_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34) + - `ard_stats_wilcox_test_onesample()` for calculating one-sample results. + - `ard_stats_t_test_onesample()` for calculating one-sample results. * Updated functions `ard_stats_t_test()`, `ard_stats_paired_t_test()`, `ard_stats_wilcox_test()`, `ard_stats_paired_wilcox_test()`, `ard_stats_chisq_test()`, `ard_stats_fisher_test()`, `ard_stats_kruskal_test()`, `ard_stats_mcnemar_test()`, and `ard_stats_mood_test()` to accept multiple variables at once. Independent tests are calculated for each variable. The `variable` argument is renamed to `variables`. (#77) diff --git a/R/ard_stats_t_test_onesample.R b/R/ard_stats_t_test_onesample.R new file mode 100644 index 000000000..9eb8a79c0 --- /dev/null +++ b/R/ard_stats_t_test_onesample.R @@ -0,0 +1,71 @@ +#' ARD one-sample t-test +#' +#' @description +#' Analysis results data for one-sample t-tests. +#' Result may be stratified by including the `by` argument. +#' +#' @param data (`data.frame`)\cr +#' a data frame. See below for details. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column names to be analyzed. Independent t-tests will be computed for +#' each variable. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' optional column name to stratify results by. +#' @inheritParams ard_stats_t_test +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' cards::ADSL |> +#' ard_stats_t_test_onesample(by = ARM, variables = AGE) +ard_stats_t_test_onesample <- function(data, variables, by = dplyr::group_vars(data), conf.level = 0.95, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed("broom", reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_data_frame(data) + data <- dplyr::ungroup(data) + cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}) + check_scalar_range(conf.level, range = c(0, 1)) + + # if no variables selected, return empty tibble ------------------------------ + if (is_empty(variables)) { + return(dplyr::tibble()) + } + + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = all_of(variables) ~ list(t_test_onesample = \(x) stats::t.test(x = x, conf.level = conf.level, ...) |> broom::tidy()) + ) |> + cards::bind_ard( + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = + all_of(variables) ~ + list(conf.level = \(x) { + formals(asNamespace("stats")[["t.test.default"]])["mu"] |> + utils::modifyList(list(conf.level = conf.level, ...)) + }) + ) + ) |> + dplyr::select(-"stat_label") |> + dplyr::left_join( + .df_ttest_stat_labels(by = NULL), + by = "stat_name" + ) |> + dplyr::mutate( + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name), + context = "ard_stats_t_test_onesample", + ) |> + cards::tidy_ard_row_order() |> + cards::tidy_ard_column_order() +} diff --git a/R/ard_stats_wilcox_test_onesample.R b/R/ard_stats_wilcox_test_onesample.R new file mode 100644 index 000000000..7741c2cab --- /dev/null +++ b/R/ard_stats_wilcox_test_onesample.R @@ -0,0 +1,72 @@ +#' ARD one-sample Wilcox Rank-sum +#' +#' @description +#' Analysis results data for one-sample Wilcox Rank-sum. +#' Result may be stratified by including the `by` argument. +#' +#' @param data (`data.frame`)\cr +#' a data frame. See below for details. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column names to be analyzed. Independent Wilcox Rank-sum tests will be computed for +#' each variable. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' optional column name to stratify results by. +#' @inheritParams ard_stats_wilcox_test +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' cards::ADSL |> +#' ard_stats_wilcox_test_onesample(by = ARM, variables = AGE) +ard_stats_wilcox_test_onesample <- function(data, variables, by = dplyr::group_vars(data), conf.level = 0.95, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed("broom", reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_data_frame(data) + data <- dplyr::ungroup(data) + cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}) + check_scalar_range(conf.level, range = c(0, 1)) + + # if no variables selected, return empty tibble ------------------------------ + if (is_empty(variables)) { + return(dplyr::tibble()) + } + + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = all_of(variables) ~ list(t_test_onesample = \(x) stats::wilcox.test(x = x, conf.level = conf.level, ...) |> broom::tidy()) + ) |> + cards::bind_ard( + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = + all_of(variables) ~ + list(conf.level = \(x) { + formals(asNamespace("stats")[["wilcox.test.default"]])[c("mu", "exact", "conf.int", "tol.root", "digits.rank")] |> + utils::modifyList(list(conf.level = conf.level, ...)) |> + compact() + }) + ) + ) |> + dplyr::select(-"stat_label") |> + dplyr::left_join( + .df_ttest_stat_labels(by = NULL), + by = "stat_name" + ) |> + dplyr::mutate( + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name), + context = "ard_stats_wilcox_test_onesample", + ) |> + cards::tidy_ard_row_order() |> + cards::tidy_ard_column_order() +} diff --git a/README.Rmd b/README.Rmd index 8c2a55acf..0007ba337 100644 --- a/README.Rmd +++ b/README.Rmd @@ -5,7 +5,7 @@ editor_options: wrap: 72 --- -# cardx cardx website +# cardx cardx website [![R-CMD-check](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml) [![Codecov test diff --git a/README.md b/README.md index 7c108b27a..fda5d4cff 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -# cardx cardx website +# cardx cardx website [![R-CMD-check](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml) [![Codecov test diff --git a/_pkgdown.yml b/_pkgdown.yml index 2e5965d2d..b40a3879f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -34,7 +34,9 @@ reference: - ard_stats_oneway_test - ard_stats_prop_test - ard_stats_t_test + - ard_stats_t_test_onesample - ard_stats_wilcox_test + - ard_stats_wilcox_test_onesample - subtitle: "{aod} package" - contents: diff --git a/man/ard_stats_t_test_onesample.Rd b/man/ard_stats_t_test_onesample.Rd new file mode 100644 index 000000000..26a53a373 --- /dev/null +++ b/man/ard_stats_t_test_onesample.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_t_test_onesample.R +\name{ard_stats_t_test_onesample} +\alias{ard_stats_t_test_onesample} +\title{ARD one-sample t-test} +\usage{ +ard_stats_t_test_onesample( + data, + variables, + by = dplyr::group_vars(data), + conf.level = 0.95, + ... +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +a data frame. See below for details.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be analyzed. Independent t-tests will be computed for +each variable.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +optional column name to stratify results by.} + +\item{conf.level}{(scalar \code{numeric})\cr +confidence level for confidence interval. Default is \code{0.95}.} + +\item{...}{arguments passed to \code{t.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for one-sample t-tests. +Result may be stratified by including the \code{by} argument. +} +\examples{ +\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_stats_t_test_onesample(by = ARM, variables = AGE) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_stats_wilcox_test_onesample.Rd b/man/ard_stats_wilcox_test_onesample.Rd new file mode 100644 index 000000000..b01882559 --- /dev/null +++ b/man/ard_stats_wilcox_test_onesample.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_wilcox_test_onesample.R +\name{ard_stats_wilcox_test_onesample} +\alias{ard_stats_wilcox_test_onesample} +\title{ARD one-sample Wilcox Rank-sum} +\usage{ +ard_stats_wilcox_test_onesample( + data, + variables, + by = dplyr::group_vars(data), + conf.level = 0.95, + ... +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +a data frame. See below for details.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be analyzed. Independent Wilcox Rank-sum tests will be computed for +each variable.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +optional column name to stratify results by.} + +\item{conf.level}{(scalar \code{numeric})\cr +confidence level for confidence interval. Default is \code{0.95}.} + +\item{...}{arguments passed to \code{wilcox.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for one-sample Wilcox Rank-sum. +Result may be stratified by including the \code{by} argument. +} +\examples{ +\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_stats_wilcox_test_onesample(by = ARM, variables = AGE) +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/test-ard_stats_t_test_onesample.R b/tests/testthat/test-ard_stats_t_test_onesample.R new file mode 100644 index 000000000..df62e11c2 --- /dev/null +++ b/tests/testthat/test-ard_stats_t_test_onesample.R @@ -0,0 +1,50 @@ +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) + +test_that("ard_stats_t_test_onesample() works", { + # first calculate an object to test against + expect_silent( + ard1 <- ard_stats_t_test_onesample( + cards::ADSL, + variables = AGE, + by = ARM, + conf.level = 0.9, + mu = 1 + ) + ) + + # first check arguments passed and returned correctly + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("mu", "conf.level")], + list(mu = 1, conf.level = 0.9) + ) + # check results are correct + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("estimate", "conf.low", "conf.high", "p.value")], + t.test( + cards::ADSL$AGE[cards::ADSL$ARM == "Placebo"], + conf.level = 0.9, + mu = 1 + ) |> + broom::tidy() |> + dplyr::select(c("estimate", "conf.low", "conf.high", "p.value")) |> + as.list() + ) + + # test the structure is good + expect_silent(cards::check_ard_structure(ard1)) + + # empty tibble returned with no variables + expect_equal( + ard_stats_t_test_onesample( + cards::ADSL, + variables = character(0) + ), + dplyr::tibble() + ) +}) diff --git a/tests/testthat/test-ard_stats_wilcox_test_onesample.R b/tests/testthat/test-ard_stats_wilcox_test_onesample.R new file mode 100644 index 000000000..3bd22c238 --- /dev/null +++ b/tests/testthat/test-ard_stats_wilcox_test_onesample.R @@ -0,0 +1,52 @@ +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) + +test_that("ard_stats_wilcox_test_onesample() works", { + # first calculate an object to test against + expect_silent( + ard1 <- ard_stats_wilcox_test_onesample( + cards::ADSL, + variables = AGE, + by = ARM, + conf.level = 0.9, + conf.int = TRUE, + mu = 1 + ) + ) + + # first check arguments passed and returned correctly + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("mu", "conf.level")], + list(mu = 1, conf.level = 0.9) + ) + # check results are correct + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("estimate", "conf.low", "conf.high", "p.value")], + wilcox.test( + cards::ADSL$AGE[cards::ADSL$ARM == "Placebo"], + conf.level = 0.9, + mu = 1, + conf.int = TRUE + ) |> + broom::tidy() |> + dplyr::select(c("estimate", "conf.low", "conf.high", "p.value")) |> + as.list() + ) + + # test the structure is good + expect_silent(cards::check_ard_structure(ard1)) + + # empty tibble returned with no variables + expect_equal( + ard_stats_wilcox_test_onesample( + cards::ADSL, + variables = character(0) + ), + dplyr::tibble() + ) +})