From 5db859dbd4633fcb59e1f232d534ab6409833b0c Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Mon, 27 May 2024 08:48:31 -0700 Subject: [PATCH 1/2] construct model updates --- NEWS.md | 13 +++-- R/ard_emmeans_mean_difference.R | 2 +- R/ard_stats_anova.R | 2 +- R/construction_helpers.R | 53 ++++++++++++------ README.Rmd | 2 +- README.md | 2 +- man/ard_emmeans_mean_difference.Rd | 2 +- man/ard_stats_anova.Rd | 2 +- man/construction_helpers.Rd | 18 +++--- tests/testthat/_snaps/construction_helpers.md | 19 ++++++- tests/testthat/test-construction_helpers.R | 56 +++++++++++++++++-- 11 files changed, 127 insertions(+), 44 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0c4e4384d..9f2f6a508 100644 --- a/NEWS.md +++ b/NEWS.md @@ -24,10 +24,10 @@ ard_moodtest() -> ard_stats_mood_test() - `ard_stats_mcnemar_test_long()` for McNemar's test from long data using `stats::mcnemar.test()`. - `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_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) - `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_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34) - `ard_smd_smd()` for calculating standardized mean differences using `smd::smd()`. (#4) - `ard_survival_survfit()` for survival analyses using `survival::survfit()`. (#43) - `ard_continuous.survey.design()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) @@ -35,10 +35,11 @@ ard_moodtest() -> ard_stats_mood_test() - `ard_survey_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72) - `ard_survey_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70) - `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71) - - `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) - - `ard_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34) - - `ard_stats_wilcox_test_onesample()` for calculating one-sample results. + - `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113) + - `ard_stats_prop_test()` for tests of proportions using `stats::prop.test()`. (#64) - `ard_stats_t_test_onesample()` for calculating one-sample results. + - `ard_stats_wilcox_test_onesample()` for calculating one-sample results. + - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) * 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) @@ -46,7 +47,7 @@ ard_moodtest() -> ard_stats_mood_test() * 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) -* Added `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113) +* Added model construction helpers, `construct_model()`, `reformulate2()`, `bt()`, and `bt_strip()`. # cardx 0.1.0 diff --git a/R/ard_emmeans_mean_difference.R b/R/ard_emmeans_mean_difference.R index 86af2a44b..ac6fdff7a 100644 --- a/R/ard_emmeans_mean_difference.R +++ b/R/ard_emmeans_mean_difference.R @@ -70,7 +70,7 @@ ard_emmeans_mean_difference <- function(data, formula, method, # construct primary model ---------------------------------------------------- mod <- construct_model( - x = data, formula = formula, method = method, + data = data, formula = formula, method = method, method.args = {{ method.args }}, package = package, env = caller_env() ) diff --git a/R/ard_stats_anova.R b/R/ard_stats_anova.R index 1019d7757..fed73f8bd 100644 --- a/R/ard_stats_anova.R +++ b/R/ard_stats_anova.R @@ -122,7 +122,7 @@ ard_stats_anova.data.frame <- function(x, lapply( formulas, function(formula) { - construct_model(x = x, formula = formula, method = method, method.args = {{ method.args }}, package = package) + construct_model(data = x, formula = formula, method = method, method.args = {{ method.args }}, package = package) } ) diff --git a/R/construction_helpers.R b/R/construction_helpers.R index 7b49f1298..f8c041245 100644 --- a/R/construction_helpers.R +++ b/R/construction_helpers.R @@ -13,14 +13,15 @@ #' #' - `bt_strip()`: Removes backticks from a string if it begins and ends with a backtick. #' -#' @param x +#' @param data #' - `construct_model.data.frame()` (`data.frame`) a data frame #' - `construct_model.survey.design()` (`survey.design`) a survey design object -#' - `bt()`/`bt_strip()` (`character`) character vector, typically of variable names +#' @param x (`character`)\cr +#' character vector, typically of variable names #' @param formula (`formula`)\cr #' a formula #' @param method (`string`)\cr -#' string naming the function to be called, e.g. `"glm"`. +#' string of function 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 method.args (named `list`)\cr @@ -47,7 +48,7 @@ #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("withr", "lme4", "broom.helpers", "broom.mixed"), reference_pkg = "cardx")) #' construct_model( -#' x = mtcars, +#' data = mtcars, #' formula = am ~ mpg + (1 | vs), #' method = "glmer", #' method.args = list(family = binomial), @@ -56,7 +57,7 @@ #' broom.mixed::tidy() #' #' construct_model( -#' x = mtcars |> dplyr::rename(`M P G` = mpg), +#' data = mtcars |> dplyr::rename(`M P G` = mpg), #' formula = reformulate2(c("M P G", "cyl"), response = "hp"), #' method = "lm" #' ) |> @@ -66,13 +67,13 @@ NULL #' @rdname construction_helpers #' @export -construct_model <- function(x, ...) { +construct_model <- function(data, ...) { UseMethod("construct_model") } #' @rdname construction_helpers #' @export -construct_model.data.frame <- function(x, formula, method, method.args = list(), package = "base", env = caller_env(), ...) { +construct_model.data.frame <- function(data, formula, method, method.args = list(), package = "base", env = caller_env(), ...) { set_cli_abort_call() # check pkg installations ---------------------------------------------------- check_dots_empty() @@ -82,8 +83,8 @@ construct_model.data.frame <- function(x, formula, method, method.args = list(), check_class(formula, cls = "formula") check_not_missing(method) - check_string(method) - check_not_namespaced(method) + check_string_or_function(method) + if (is_string(method)) check_not_namespaced(method) # convert method.args to list of expressions (to account for NSE inputs) ----- method.args <- .as_list_of_exprs({{ method.args }}) @@ -91,14 +92,14 @@ construct_model.data.frame <- function(x, formula, method, method.args = list(), # build model ---------------------------------------------------------------- withr::with_namespace( package = package, - call2(.fn = method, formula = formula, data = x, !!!method.args) |> + call2(.fn = method, formula = formula, data = data, !!!method.args) |> eval_tidy(env = env) ) } #' @rdname construction_helpers #' @export -construct_model.survey.design <- function(x, formula, method, method.args = list(), package = "survey", env = caller_env(), ...) { +construct_model.survey.design <- function(data, formula, method, method.args = list(), package = "survey", env = caller_env(), ...) { set_cli_abort_call() # check pkg installations ---------------------------------------------------- check_dots_empty() @@ -108,7 +109,7 @@ construct_model.survey.design <- function(x, formula, method, method.args = list check_class(formula, cls = "formula") check_not_missing(method) - check_string(method) + check_string_or_function(method) check_not_namespaced(method) # convert method.args to list of expressions (to account for NSE inputs) ----- @@ -117,7 +118,7 @@ construct_model.survey.design <- function(x, formula, method, method.args = list # build model ---------------------------------------------------------------- withr::with_namespace( package = package, - call2(.fn = method, formula = formula, design = x, !!!method.args) |> + call2(.fn = method, formula = formula, design = data, !!!method.args) |> eval_tidy(env = env) ) } @@ -176,11 +177,29 @@ check_not_namespaced <- function(x, check_string(x, arg_name = arg_name, call = call, class = "check_not_namespaced") if (str_detect(x, "::")) { - c("Argument {.arg {arg_name}} cannot be namespaced.", - i = "Put the package name in the {.arg package} argument." - ) |> - cli::cli_abort(call = call, class = class) + cli::cli_abort( + "Argument {.arg {arg_name}} cannot be namespaced when passed as a {.cls string}.", + call = call, + class = class + ) + } + + invisible(x) +} + + +check_string_or_function <- function(x, + arg_name = rlang::caller_arg(x), + class = "check_string_or_function", + call = get_cli_abort_call()) { + if (!is.function(x) && !is_string(x)) { + cli::cli_abort( + c("Argument {.arg {arg_name}} must be a {.cls string} or {.cls function}."), + call = call, + class = class + ) } invisible(x) + } diff --git a/README.Rmd b/README.Rmd index 0007ba337..9d8745150 100644 --- a/README.Rmd +++ b/README.Rmd @@ -74,7 +74,7 @@ To accomplish this we include model construction helpers. ```{r} construct_model( - x = cards::ADSL, + data = cards::ADSL, formula = reformulate2("ARM", response = "AGE"), method = "lm" ) |> diff --git a/README.md b/README.md index fda5d4cff..1e212974c 100644 --- a/README.md +++ b/README.md @@ -95,7 +95,7 @@ this we include model construction helpers. ``` r construct_model( - x = cards::ADSL, + data = cards::ADSL, formula = reformulate2("ARM", response = "AGE"), method = "lm" ) |> diff --git a/man/ard_emmeans_mean_difference.Rd b/man/ard_emmeans_mean_difference.Rd index f34b88338..53b21f7aa 100644 --- a/man/ard_emmeans_mean_difference.Rd +++ b/man/ard_emmeans_mean_difference.Rd @@ -23,7 +23,7 @@ a data frame or survey design object} a formula} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function 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.} diff --git a/man/ard_stats_anova.Rd b/man/ard_stats_anova.Rd index 4c029a93e..a47e57526 100644 --- a/man/ard_stats_anova.Rd +++ b/man/ard_stats_anova.Rd @@ -37,7 +37,7 @@ description.} a list of formulas} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function 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.} diff --git a/man/construction_helpers.Rd b/man/construction_helpers.Rd index 60a98ec9b..1841ead6b 100644 --- a/man/construction_helpers.Rd +++ b/man/construction_helpers.Rd @@ -10,10 +10,10 @@ \alias{bt_strip} \title{Construction Helpers} \usage{ -construct_model(x, ...) +construct_model(data, ...) \method{construct_model}{data.frame}( - x, + data, formula, method, method.args = list(), @@ -23,7 +23,7 @@ construct_model(x, ...) ) \method{construct_model}{survey.design}( - x, + data, formula, method, method.args = list(), @@ -46,10 +46,9 @@ bt(x, pattern = "[ \\n\\r]") bt_strip(x) } \arguments{ -\item{x}{\itemize{ +\item{data}{\itemize{ \item \code{construct_model.data.frame()} (\code{data.frame}) a data frame \item \code{construct_model.survey.design()} (\code{survey.design}) a survey design object -\item \code{bt()}/\code{bt_strip()} (\code{character}) character vector, typically of variable names }} \item{...}{These dots are for future extensions and must be empty.} @@ -58,7 +57,7 @@ bt_strip(x) a formula} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function 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.} @@ -89,6 +88,9 @@ their own environments.} \item{pattern_term, pattern_response}{passed to \code{bt(pattern)} for arguments \code{stats::reformulate(termlabels, response)}.} +\item{x}{(\code{character})\cr +character vector, typically of variable names} + \item{pattern}{(\code{string})\cr regular expression string. If the regex matches, backticks are added to the string. When \code{NULL}, backticks are not added.} @@ -113,7 +115,7 @@ names that contain a space are wrapped in backticks. \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("withr", "lme4", "broom.helpers", "broom.mixed"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} construct_model( - x = mtcars, + data = mtcars, formula = am ~ mpg + (1 | vs), method = "glmer", method.args = list(family = binomial), @@ -122,7 +124,7 @@ construct_model( broom.mixed::tidy() construct_model( - x = mtcars |> dplyr::rename(`M P G` = mpg), + data = mtcars |> dplyr::rename(`M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm" ) |> diff --git a/tests/testthat/_snaps/construction_helpers.md b/tests/testthat/_snaps/construction_helpers.md index d904c5939..5f6e77afd 100644 --- a/tests/testthat/_snaps/construction_helpers.md +++ b/tests/testthat/_snaps/construction_helpers.md @@ -1,7 +1,7 @@ # construct_model() works Code - dplyr::filter(as.data.frame(ard_regression(construct_model(x = dplyr::rename( + dplyr::filter(as.data.frame(ard_regression(construct_model(data = dplyr::rename( mtcars, `M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm"))), stat_name %in% c("term", "estimate", "p.value")) Output @@ -13,3 +13,20 @@ 5 cyl regression estimate Coefficient 23.97863 1 6 cyl regression p.value p-value 0.002814958 1 +# construct_model() messaging + + Code + construct_model(data = mtcars, method = "survival::coxph", formula = survival::Surv( + mpg, am) ~ cyl) + Condition + Error in `construct_model()`: + ! Argument `method` cannot be namespaced when passed as a . + +--- + + Code + construct_model(data = mtcars, method = letters, formula = am ~ cyl) + Condition + Error in `construct_model()`: + ! Argument `method` must be a or . + diff --git a/tests/testthat/test-construction_helpers.R b/tests/testthat/test-construction_helpers.R index 8efbdb0bf..158e333ce 100644 --- a/tests/testthat/test-construction_helpers.R +++ b/tests/testthat/test-construction_helpers.R @@ -1,9 +1,9 @@ -skip_if_not(is_pkg_installed(c("broom.helpers", "withr", "survey"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("broom.helpers", "withr", "survey", "survival"), reference_pkg = "cardx")) test_that("construct_model() works", { expect_snapshot( construct_model( - x = mtcars |> dplyr::rename(`M P G` = mpg), + data = mtcars |> dplyr::rename(`M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm" ) |> @@ -30,8 +30,8 @@ test_that("construct_model() works", { "cannot be namespaced" ) - expect_equal( - { + # styler: off + expect_equal({ outside_fun <- function() { method.args <- list() @@ -44,10 +44,34 @@ test_that("construct_model() works", { coef() } - outside_fun() - }, + outside_fun()}, lm(mpg ~ cyl, mtcars) |> coef() ) + # styler: on + + # test function works when passing a function in `method=` + expect_equal( + construct_model( + data = mtcars, + method = lm, + formula = mpg ~ cyl + am + ) |> + ard_regression(), + lm(mpg ~ cyl + am, mtcars) |> + ard_regression() + ) + + # test function works when passing a namespaced function in `method=` + expect_equal( + construct_model( + data = mtcars, + method = survival::coxph, + formula = survival::Surv(mpg, am) ~ cyl + ) |> + ard_regression(), + survival::coxph(survival::Surv(mpg, am) ~ cyl, mtcars) |> + ard_regression() + ) # now the survey method ------- # styler: off @@ -68,3 +92,23 @@ test_that("construct_model() works", { ) # styler: on }) + +test_that("construct_model() messaging", { + expect_snapshot( + error = TRUE, + construct_model( + data = mtcars, + method = "survival::coxph", + formula = survival::Surv(mpg, am) ~ cyl + ) + ) + + expect_snapshot( + error = TRUE, + construct_model( + data = mtcars, + method = letters, + formula = am ~ cyl + ) + ) +}) From da4e5473497a3b4bdfe872a80bc7ea8a61188a7d Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Mon, 27 May 2024 08:55:14 -0700 Subject: [PATCH 2/2] Update construction_helpers.R --- R/construction_helpers.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/construction_helpers.R b/R/construction_helpers.R index f8c041245..2a6fa48e3 100644 --- a/R/construction_helpers.R +++ b/R/construction_helpers.R @@ -201,5 +201,4 @@ check_string_or_function <- function(x, } invisible(x) - }