Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

added checking #48

Merged
merged 1 commit into from
Nov 5, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ export(ard_ttest)
export(ard_wilcoxtest)
export(as_nested_list)
export(bind_ard)
export(check_list_elements)
export(compute_formula_selector)
export(contains)
export(continuous_variable_summary_fns)
Expand Down
7 changes: 7 additions & 0 deletions R/ard_continuous.R
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,13 @@ ard_continuous <- function(data,
data <- dplyr::ungroup(data)
process_selectors(data, variables = {{variables}}, by = {{by}}, strata = {{strata}})
process_formula_selectors(data = data[variables], statistics = statistics)
check_list_elements(
statistics = function(x) is.list(x) && rlang::is_named(x) && every(x, is.function),
error_msg =
list(statistics =
c("Error in the argument {.arg {arg_name}} for variable {.val {variable}}.",
"i" = "Value must be a named list of functions."))
)

# return empty tibble if no variables selected -------------------------------
if (rlang::is_empty(variables)) return(dplyr::tibble())
Expand Down
39 changes: 38 additions & 1 deletion R/process_selectors.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,19 +12,31 @@
#' function processes these inputs and returns a named list. If an name is
#' repeated, the last entry is kept.
#'
#' - `compute_formula_selector()`:
#' - `compute_formula_selector()`: used in `process_formula_selectors()` to
#' evaluate a single argument.
#'
#' - `check_list_elements()`: accepts named arguments where the name is a list
#' that exists in the env, and the argument value is a predicate function
#' used to the values of the list.
#'
#' @param data a data frame
#' @param ... named arguments where the value of the argument is processed with tidyselect.
#' - `process_selectors()`: the values are tidyselect-compatible selectors
#' - `process_formula_selectors()`: the values are named lists, list of formulas
#' a combination of both, or a single formula. Users may pass `~value` as a
#' shortcut for `everything() ~ value`.
#' - `check_list_elements()`: named arguments where the name matches an existing
#' list in the `env` environment, and the value is a predicate function
#' to test each element of the list, e.g. each element must be a string or
#' a function.
#' @param env env to save the results to. Default is the calling environment.
#' @param x a named list, list of formulas, or a single formula that will be
#' converted to a named list.
#' @param arg_name a string with the argument named being processed. Used
#' in error messaging.
#' @param error_msg a named list where the list elements are strings that will
#' be used in error messaging when mis-specified arguments are passed. Elements
#' `"{arg_name}"` and `"{variable}"` are available using glue syntax for messaging.
#'
#' @name process_selectors
#'
Expand Down Expand Up @@ -132,3 +144,28 @@ compute_formula_selector <- function(data, x, arg_name = '', env = rlang::caller
}


#' @name process_selectors
#' @export
check_list_elements <- function(..., error_msg = list(), env = rlang::caller_env()) {
dots <- rlang::dots_list(...)

imap(
dots,
function(predicate_fn, arg_name) {
imap(
get(arg_name, envir = env),
function(lst_element, variable) {
if (!isTRUE(predicate_fn(lst_element))) {
msg <-
error_msg[[arg_name]] %||%
"The value for argument {.arg {arg_name}} and variable {.val {variable}} is not the expected type."
cli::cli_abort(message = msg)
}
}
)
}
)

invisible()
}

1 change: 1 addition & 0 deletions inst/WORDLIST
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ env
esult
ets
funder
mis
nalysis
nonmiss
quosures
Expand Down
17 changes: 16 additions & 1 deletion man/process_selectors.Rd

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

9 changes: 9 additions & 0 deletions tests/testthat/_snaps/ard_continuous.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
# ard_continuous() messaging

Code
ard_continuous(mtcars, variables = "mpg", statistics = ~ list(mean = "this is a string"))
Condition
Error:
! Error in the argument `statistics` for variable "mpg".
i Value must be a named list of functions.

12 changes: 11 additions & 1 deletion tests/testthat/test-ard_continuous.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
test_that("multiplication works", {
test_that("ard_continuous() works", {
expect_error(
ard_test <-
ard_continuous(mtcars, variables = c(mpg, hp), by = c(am, vs)),
Expand Down Expand Up @@ -26,3 +26,13 @@ test_that("multiplication works", {
dplyr::tibble()
)
})

test_that("ard_continuous() messaging", {
# proper error message when statistics argument mis-specified
expect_snapshot(
ard_continuous(mtcars, variables = "mpg", statistics = ~list(mean = "this is a string")),
error = TRUE
)

})

Loading