Skip to content

Commit

Permalink
add arg ifnotfound in select_nse()
Browse files Browse the repository at this point in the history
  • Loading branch information
@etiennebacher
etiennebacher committed Dec 1, 2024
1 parent bd0be81 commit f2a56af
Show file tree
Hide file tree
Showing 2 changed files with 93 additions and 60 deletions.
3 changes: 2 additions & 1 deletion R/data_rename.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,8 @@ data_rename <- function(data,
ignore_case = NULL,
regex = NULL,
allow_rename = TRUE,
verbose = verbose
verbose = verbose,
ifnotfound = "error"
)

# Forbid partially named "select",
Expand Down
150 changes: 91 additions & 59 deletions R/select_nse.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@

.select_nse <- function(select, data, exclude, ignore_case, regex = FALSE,
remove_group_var = FALSE, allow_rename = FALSE,
verbose = FALSE) {
verbose = FALSE, ifnotfound = "warn") {
.check_data(data)
columns <- colnames(data)

Expand Down Expand Up @@ -38,14 +38,16 @@
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
excluded <- .eval_expr(
expr_exclude,
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)

selected_has_mix_idx <- any(selected < 0L) && any(selected > 0L)
Expand Down Expand Up @@ -113,7 +115,7 @@
# * cyl:gear -> function (`:`) so find which function it is, then get the
# position for each variable, then evaluate the function with the positions

.eval_expr <- function(x, data, ignore_case, regex, verbose) {
.eval_expr <- function(x, data, ignore_case, regex, verbose, ifnotfound) {
if (is.null(x)) {
return(NULL)
}
Expand All @@ -123,9 +125,18 @@
out <- switch(type,
integer = x,
double = as.integer(x),
character = .select_char(data, x, ignore_case, regex = regex, verbose),
symbol = .select_symbol(data, x, ignore_case, regex = regex, verbose),
language = .eval_call(data, x, ignore_case, regex = regex, verbose),
character = .select_char(
data, x, ignore_case,
regex = regex, verbose, ifnotfound
),
symbol = .select_symbol(
data, x, ignore_case,
regex = regex, verbose, ifnotfound
),
language = .eval_call(
data, x, ignore_case,
regex = regex, verbose, ifnotfound
),
insight::format_error(paste0(
"Expressions of type <", typeof(x),
"> cannot be evaluated for use when subsetting."
Expand All @@ -143,7 +154,7 @@
# - character that should be regex-ed on variable names
# - special word "all" to return all vars

.select_char <- function(data, x, ignore_case, regex, verbose) {
.select_char <- function(data, x, ignore_case, regex, verbose, ifnotfound) {
# use colnames because names() doesn't work for matrices
columns <- colnames(data)
if (isTRUE(regex)) {
Expand All @@ -160,7 +171,7 @@
colon_vars <- unlist(strsplit(x, ":", fixed = TRUE))
colon_match <- match(colon_vars, columns)
if (anyNA(colon_match)) {
.warn_not_found(colon_vars, columns, colon_match, verbose)
.action_if_not_found(colon_vars, columns, colon_match, verbose, ifnotfound)
matches <- NA
} else {
start_pos <- match(colon_vars[1], columns)
Expand All @@ -180,26 +191,33 @@
# find columns, case sensitive
matches <- match(x, columns)
if (anyNA(matches)) {
.warn_not_found(x, columns, matches, verbose)
.action_if_not_found(x, columns, matches, verbose, ifnotfound)
}
matches[!is.na(matches)]
}
}

# small helper, to avoid duplicated code
.warn_not_found <- function(x, columns, matches, verbose = TRUE) {
if (verbose) {
insight::format_warning(
paste0(
"Following variable(s) were not found: ",
toString(x[is.na(matches)])
),
.misspelled_string(
columns,
x[is.na(matches)],
default_message = "Possibly misspelled?"
)
)
.action_if_not_found <- function(
x,
columns,
matches,
verbose = TRUE,
ifnotfound) {

Check warning on line 206 in R/select_nse.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/select_nse.R,line=206,col=5,[function_argument_linter] Arguments without defaults should come before arguments with defaults.

Check warning on line 206 in R/select_nse.R

View workflow job for this annotation

GitHub Actions / lint / lint 

file=R/select_nse.R,line=206,col=5,[function_argument_linter] Arguments without defaults should come before arguments with defaults.
msg <- paste0(
"Following variable(s) were not found: ",
toString(x[is.na(matches)])
)
msg2 <- .misspelled_string(
columns,
x[is.na(matches)],
default_message = "Possibly misspelled?"
)
if (ifnotfound == "error") {
insight::format_error(msg, msg2)
}
if (ifnotfound == "warn" && verbose) {
insight::format_warning(msg, msg2)
}
}

Expand All @@ -217,7 +235,7 @@
# value but it errors because the function doesn't exist then it means that
# it is a select helper that we grab from the error message.

.select_symbol <- function(data, x, ignore_case, regex, verbose) {
.select_symbol <- function(data, x, ignore_case, regex, verbose, ifnotfound) {
try_eval <- try(eval(x), silent = TRUE)
x_dep <- insight::safe_deparse(x)
is_select_helper <- FALSE
Expand Down Expand Up @@ -300,54 +318,59 @@

# Dispatch expressions to various select helpers according to the function call.

.eval_call <- function(data, x, ignore_case, regex, verbose) {
.eval_call <- function(data, x, ignore_case, regex, verbose, ifnotfound) {
type <- insight::safe_deparse(x[[1]])
switch(type,
`:` = .select_seq(x, data, ignore_case, regex, verbose),
`-` = .select_minus(x, data, ignore_case, regex, verbose),
`c` = .select_c(x, data, ignore_case, regex, verbose), # nolint
`(` = .select_bracket(x, data, ignore_case, regex, verbose),
`[` = .select_square_bracket(x, data, ignore_case, regex, verbose),
`$` = .select_dollar(x, data, ignore_case, regex, verbose),
`~` = .select_tilde(x, data, ignore_case, regex, verbose),
list = .select_list(x, data, ignore_case, regex, verbose),
names = .select_names(x, data, ignore_case, regex, verbose),
`:` = .select_seq(x, data, ignore_case, regex, verbose, ifnotfound),
`-` = .select_minus(x, data, ignore_case, regex, verbose, ifnotfound),
`c` = .select_c(x, data, ignore_case, regex, verbose, ifnotfound), # nolint
`(` = .select_bracket(x, data, ignore_case, regex, verbose, ifnotfound),
`[` = .select_square_bracket(
x, data, ignore_case, regex, verbose, ifnotfound
),
`$` = .select_dollar(x, data, ignore_case, regex, verbose, ifnotfound),
`~` = .select_tilde(x, data, ignore_case, regex, verbose, ifnotfound),
list = .select_list(x, data, ignore_case, regex, verbose, ifnotfound),
names = .select_names(x, data, ignore_case, regex, verbose, ifnotfound),
starts_with = ,
ends_with = ,
matches = ,
contains = ,
regex = .select_helper(x, data, ignore_case, regex, verbose),
.select_context(x, data, ignore_case, regex, verbose)
regex = .select_helper(x, data, ignore_case, regex, verbose, ifnotfound),
.select_context(x, data, ignore_case, regex, verbose, ifnotfound)
)
}

# e.g 1:3, or gear:cyl
.select_seq <- function(expr, data, ignore_case, regex, verbose) {
.select_seq <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
x <- .eval_expr(
expr[[2]],
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
y <- .eval_expr(
expr[[3]],
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
x:y
}

# e.g -cyl
.select_minus <- function(expr, data, ignore_case, regex, verbose) {
.select_minus <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
x <- .eval_expr(
expr[[2]],
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
if (length(x) == 0L) {
seq_along(data)
Expand All @@ -357,7 +380,7 @@
}

# e.g c("gear", "cyl")
.select_c <- function(expr, data, ignore_case, regex, verbose) {
.select_c <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
lst_expr <- as.list(expr)
lst_expr[[1]] <- NULL
unlist(lapply(
Expand All @@ -366,40 +389,44 @@
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
), use.names = FALSE)
}

# e.g -(gear:cyl)
.select_bracket <- function(expr, data, ignore_case, regex, verbose) {
.select_bracket <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
.eval_expr(
expr[[2]],
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
}

# e.g myvector[3]
.select_square_bracket <- function(expr, data, ignore_case, regex, verbose) {
.select_square_bracket <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
first_obj <- .eval_expr(
expr[[2]],
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
.eval_expr(
first_obj[eval(expr[[3]])],
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
}

.select_names <- function(expr, data, ignore_case, regex, verbose) {
.select_names <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
first_obj <- .dynEval(expr, inherits = FALSE, minframe = 0L)
.eval_expr(
first_obj,
Expand All @@ -411,7 +438,7 @@
}

# e.g starts_with("Sep")
.select_helper <- function(expr, data, ignore_case, regex, verbose) {
.select_helper <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
lst_expr <- as.list(expr)

# need this if condition to distinguish between starts_with("Sep") (that we
Expand All @@ -435,7 +462,7 @@
}

# e.g args$select (happens when we use grouped_data (see center.grouped_df()))
.select_dollar <- function(expr, data, ignore_case, regex, verbose) {
.select_dollar <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
first_obj <- .dynGet(expr[[2]], ifnotfound = NULL, inherits = FALSE, minframe = 0L)
if (is.null(first_obj)) {
first_obj <- .dynEval(expr[[2]], inherits = FALSE, minframe = 0L)
Expand All @@ -445,38 +472,41 @@
data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
}

# e.g ~ gear + cyl
.select_tilde <- function(expr, data, ignore_case, regex, verbose) {
.select_tilde <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
vars <- all.vars(expr)
unlist(lapply(
vars,
.eval_expr,
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
), use.names = FALSE)
}

# e.g list(gear = 4, cyl = 5)
.select_list <- function(expr, data, ignore_case, regex, verbose) {
.select_list <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
vars <- names(.dynEval(expr, inherits = FALSE, minframe = 0L))
unlist(lapply(
vars,
.eval_expr,
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
), use.names = FALSE)
}

# e.g is.numeric()
.select_context <- function(expr, data, ignore_case, regex, verbose) {
.select_context <- function(expr, data, ignore_case, regex, verbose, ifnotfound) {
x_dep <- insight::safe_deparse(expr)
if (endsWith(x_dep, "()")) {
new_expr <- gsub("\\(\\)$", "", x_dep)
Expand All @@ -486,7 +516,8 @@
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
} else {
out <- .dynEval(expr, inherits = FALSE, minframe = 0L)
Expand All @@ -495,7 +526,8 @@
data = data,
ignore_case = ignore_case,
regex = regex,
verbose = verbose
verbose = verbose,
ifnotfound = ifnotfound
)
}
}
Expand Down

0 comments on commit f2a56af

Please sign in to comment.