diff --git a/NEWS.md b/NEWS.md index 0b551a1..b260bf5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,12 @@ # tidyselect (development version) +* `num_range()` now recycles its arguments using tidyverse rules (#355). + In addition, it gains a `cross` argument that allows you to take the + cartesian product of these arguments instead. + * `eval_select(allow_empty = FALSE)` gains a new argument to yield a better error message in case of empty selection (@olivroy, #327) - + * `eval_select()` and `eval_relocate()` gain a new `error_arg` argument that can be specified to throw a better error message when `allow_empty = FALSE`. * `eval_select()` and `eval_relocate()` throw a classed error message when `allow_empty = FALSE` (@olivroy, #347). @@ -45,17 +49,17 @@ * `any_of()` generates a more informative error if you supply too many arguments (#241). - - * `all_of()` (like `any_of()`) returns an integer vector to make it easier - to combine in functions (#270, #294). It also fails when it can't find + + * `all_of()` (like `any_of()`) returns an integer vector to make it easier + to combine in functions (#270, #294). It also fails when it can't find variables even when `strict = FALSE`. - + * `matches()` recognises and correctly uses stringr pattern objects (`stringr::regex()`, `stringr::fixed()`, etc) (#238). It also now works with named vectors (#250). - + * `num_range()` gains a `suffix` argument (#229). - + * `where()` is now exported, like all other select helpers (#201), and gives more informative errors (#236). @@ -65,11 +69,11 @@ * `eval_select()` always returns a named vector, even when renaming is not permitted (#220). -* `eval_select()` and `eval_relocate()` gain new `allow_empty` argument which +* `eval_select()` and `eval_relocate()` gain new `allow_empty` argument which makes it possible to forbid empty selections with `allow_empty = FALSE` (#252). * `eval_select(allow_rename = FALSE)` no longer fails with empty - selections (#221, @eutwt) or with predicate functions (#225). It now properly + selections (#221, @eutwt) or with predicate functions (#225). It now properly fails with partial renaming (#305). * `peek_var()` error now generates hyperlink to docs with recent RStudio (#289). @@ -77,15 +81,15 @@ * `vars_pull()` generates more informative error messages (#234, #258, #318) and gains `error_call` and `error_arg` arguments. -* Errors produced by tidyselect should now be more informative. Evaluation - errors are now chained, with the child error call is set to the `error_call` - argument of `eval_select()` and `eval_rename()`. We've also improved - backtraces of base errors, and done better at propagating the root +* Errors produced by tidyselect should now be more informative. Evaluation + errors are now chained, with the child error call is set to the `error_call` + argument of `eval_select()` and `eval_rename()`. We've also improved + backtraces of base errors, and done better at propagating the root `error_call` to vctrs input checkers. * `tidyselect_verbosity` is no longer used; deprecation messaging is now controlled by `lifecycle_verbosity` like all other packages (#317). - + # tidyselect 1.1.2 * Fix for CRAN checks. diff --git a/R/helpers-pattern.R b/R/helpers-pattern.R index 3f494f7..8ce0c26 100644 --- a/R/helpers-pattern.R +++ b/R/helpers-pattern.R @@ -174,14 +174,32 @@ matches <- function(match, #' @param range A sequence of integers, like `1:5`. #' @param width Optionally, the "width" of the numeric range. For example, #' a range of 2 gives "01", a range of three "001", etc. +#' @inheritParams rlang::args_dots_empty +#' @param cross Whether to take the cartesian product of `prefix`, `range`, and `suffix`. +#' If `FALSE`, the default, these arguments are recycled using [tidyverse rules][vctrs::vector_recycling_rules]. #' @export num_range <- function(prefix, range, suffix = "", width = NULL, + ..., + cross = FALSE, vars = NULL) { + check_dots_empty() + check_bool(cross) + check_number_whole(width, allow_null = TRUE) + vars <- vars %||% peek_vars(fn = "num_range") + if (cross) { + args <- vctrs::vec_expand_grid(prefix = prefix, range = range, suffix = suffix, .error_call = current_env()) + } else { + args <- vctrs::vec_recycle_common(prefix = prefix, range = range, suffix = suffix) + } + prefix <- args$prefix + range <- args$range + suffix <- args$suffix + if (!is_null(width)) { range <- sprintf(paste0("%0", width, "d"), range) } diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R new file mode 100644 index 0000000..ef8c5a1 --- /dev/null +++ b/R/import-standalone-types-check.R @@ -0,0 +1,554 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-types-check.R +# Generated by: usethis::use_standalone("r-lib/rlang", "types-check") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-types-check.R +# last-updated: 2023-03-13 +# license: https://unlicense.org +# dependencies: standalone-obj-type.R +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2024-08-15: +# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) +# +# 2023-03-13: +# - Improved error messages of number checkers (@teunbrand) +# - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). +# - Added `check_data_frame()` (@mgirlich). +# +# 2023-03-07: +# - Added dependency on rlang (>= 1.1.0). +# +# 2023-02-15: +# - Added `check_logical()`. +# +# - `check_bool()`, `check_number_whole()`, and +# `check_number_decimal()` are now implemented in C. +# +# - For efficiency, `check_number_whole()` and +# `check_number_decimal()` now take a `NULL` default for `min` and +# `max`. This makes it possible to bypass unnecessary type-checking +# and comparisons in the default case of no bounds checks. +# +# 2022-10-07: +# - `check_number_whole()` and `_decimal()` no longer treat +# non-numeric types such as factors or dates as numbers. Numeric +# types are detected with `is.numeric()`. +# +# 2022-10-04: +# - Added `check_name()` that forbids the empty string. +# `check_string()` allows the empty string by default. +# +# 2022-09-28: +# - Removed `what` arguments. +# - Added `allow_na` and `allow_null` arguments. +# - Added `allow_decimal` and `allow_infinite` arguments. +# - Improved errors with absent arguments. +# +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Added changelog. +# +# nocov start + +# Scalars ----------------------------------------------------------------- + +.standalone_types_check_dot_call <- .Call + +check_bool <- function(x, + ..., + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { + return(invisible(NULL)) + } + + stop_input_type( + x, + c("`TRUE`", "`FALSE`"), + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_string <- function(x, + ..., + allow_empty = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = allow_empty, + allow_na = allow_na, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a single string", + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.rlang_check_is_string <- function(x, + allow_empty, + allow_na, + allow_null) { + if (is_string(x)) { + if (allow_empty || !is_string(x, "")) { + return(TRUE) + } + } + + if (allow_null && is_null(x)) { + return(TRUE) + } + + if (allow_na && (identical(x, NA) || identical(x, na_chr))) { + return(TRUE) + } + + FALSE +} + +check_name <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = FALSE, + allow_na = FALSE, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a valid name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +IS_NUMBER_true <- 0 +IS_NUMBER_false <- 1 +IS_NUMBER_oob <- 2 + +check_number_decimal <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = TRUE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = TRUE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_number_whole <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = FALSE, + allow_na = FALSE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = FALSE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = FALSE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.stop_not_number <- function(x, + ..., + exit_code, + allow_decimal, + min, + max, + allow_na, + allow_null, + arg, + call) { + if (allow_decimal) { + what <- "a number" + } else { + what <- "a whole number" + } + + if (exit_code == IS_NUMBER_oob) { + min <- min %||% -Inf + max <- max %||% Inf + + if (min > -Inf && max < Inf) { + what <- sprintf("%s between %s and %s", what, min, max) + } else if (x < min) { + what <- sprintf("%s larger than or equal to %s", what, min) + } else if (x > max) { + what <- sprintf("%s smaller than or equal to %s", what, max) + } else { + abort("Unexpected state in OOB check", .internal = TRUE) + } + } + + stop_input_type( + x, + what, + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_symbol <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a symbol", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_arg <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an argument name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_call <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_call(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a defused call", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_environment <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_environment(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an environment", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_function <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_function(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_closure <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_closure(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an R function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_formula <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_formula(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a formula", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + + +# Vectors ----------------------------------------------------------------- + +# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE` + +check_character <- function(x, + ..., + allow_na = TRUE, + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + + if (!missing(x)) { + if (is_character(x)) { + if (!allow_na && any(is.na(x))) { + abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } + + return(invisible(NULL)) + } + + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a character vector", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_logical <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is_logical(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a logical vector", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_data_frame <- function(x, + ..., + allow_null = FALSE, + arg = caller_arg(x), + call = caller_env()) { + if (!missing(x)) { + if (is.data.frame(x)) { + return(invisible(NULL)) + } + if (allow_null && is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a data frame", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +# nocov end diff --git a/man/faq-selection-context.Rd b/man/faq-selection-context.Rd index c2ede30..61f545e 100644 --- a/man/faq-selection-context.Rd +++ b/man/faq-selection-context.Rd @@ -35,7 +35,7 @@ argument name). Alternatively, you may be deliberately trying to reduce duplication in your code by extracting out a selection into a variable: \if{html}{\out{
}}\preformatted{my_vars <- c(name, species, ends_with("color")) -#> Error: objet 'name' introuvable +#> Error: object 'name' not found }\if{html}{\out{
}} To make this work you’ll need to do two things: diff --git a/man/starts_with.Rd b/man/starts_with.Rd index bd8f56b..1dab344 100644 --- a/man/starts_with.Rd +++ b/man/starts_with.Rd @@ -16,7 +16,15 @@ contains(match, ignore.case = TRUE, vars = NULL) matches(match, ignore.case = TRUE, perl = FALSE, vars = NULL) -num_range(prefix, range, suffix = "", width = NULL, vars = NULL) +num_range( + prefix, + range, + suffix = "", + width = NULL, + ..., + cross = FALSE, + vars = NULL +) } \arguments{ \item{match}{A character vector. If length > 1, the union of the @@ -41,6 +49,11 @@ established by functions like \code{select()} or \code{pivot_longer()}).} \item{width}{Optionally, the "width" of the numeric range. For example, a range of 2 gives "01", a range of three "001", etc.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{cross}{Whether to take the cartesian product of \code{prefix}, \code{range}, and \code{suffix}. +If \code{FALSE}, the default, these arguments are recycled using \link[vctrs:theory-faq-recycling]{tidyverse rules}.} } \description{ These \link[=language]{selection helpers} match variables according diff --git a/tests/testthat/_snaps/helpers-pattern.md b/tests/testthat/_snaps/helpers-pattern.md index 925c8bf..dab5b18 100644 --- a/tests/testthat/_snaps/helpers-pattern.md +++ b/tests/testthat/_snaps/helpers-pattern.md @@ -1,3 +1,23 @@ +# num_range recycles with tidyverse rules (#355) + + Code + select_loc(vars, num_range(c("x", "y"), 1:3)) + Condition + Error in `select_loc()`: + i In argument: `num_range(c("x", "y"), 1:3)`. + Caused by error in `num_range()`: + ! Can't recycle `prefix` (size 2) to match `range` (size 3). + +--- + + Code + select_loc(vars, num_range(c("x", "y"), 1:2, c("_foo", "_bar", "_baz"))) + Condition + Error in `select_loc()`: + i In argument: `num_range(c("x", "y"), 1:2, c("_foo", "_bar", "_baz"))`. + Caused by error in `num_range()`: + ! Can't recycle `prefix` (size 2) to match `suffix` (size 3). + # matches() complains about bad stringr pattern usage Code diff --git a/tests/testthat/test-helpers-pattern.R b/tests/testthat/test-helpers-pattern.R index fcdbfab..71a1373 100644 --- a/tests/testthat/test-helpers-pattern.R +++ b/tests/testthat/test-helpers-pattern.R @@ -68,6 +68,49 @@ test_that("num_range can use a suffix (#229)", { expect_named(select_loc(vars, num_range("x", 1:2, "_y")), c("x1_y", "x2_y")) }) +test_that("num_range recycles with tidyverse rules (#355)", { + vars <- set_names(c("x1", "y1", "y2", "x2", "x3")) + expect_snapshot( + error = TRUE, + select_loc(vars, num_range(c("x", "y"), 1:3)), + ) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:2)), + c("x1", "y2") + ) + + vars <- set_names(c("x1_foo", "y1_bar", "y1_foo", "x2_bar", "x3_bar", "y2_bar")) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:2, "_foo")), + "x1_foo" + ) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:2, c("_foo", "_bar"))), + c("x1_foo", "y2_bar") + ) + expect_snapshot( + error = TRUE, + select_loc(vars, num_range(c("x", "y"), 1:2, c("_foo", "_bar", "_baz"))), + ) +}) + +test_that("num_range crosses ranges with prefixes and suffixes if requested (#355)", { + vars <- set_names(c("x1", "y1", "y2", "x2", "x3")) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:3, cross = TRUE)), + c("x1", "x2", "x3", "y1", "y2") + ) + + vars <- set_names(c("x1_foo", "y1_bar", "y1_foo", "x2_bar", "x3_bar", "y2_bar")) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:3, "_foo", cross = TRUE)), + c("x1_foo", "y1_foo") + ) + expect_named( + select_loc(vars, num_range(c("x", "y"), 1:3, c("_foo", "_bar"), cross = TRUE)), + c("x1_foo", "x2_bar", "x3_bar", "y1_foo", "y1_bar", "y2_bar") + ) +}) test_that("matchers accept length > 1 vectors (#50)", { expect_identical( diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 235396a..96ee13a 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -1,4 +1,3 @@ - test_that("one_of gives useful errors", { expect_snapshot(error = TRUE, cnd_class = TRUE, { one_of(1L, .vars = c("x", "y"))