Nothing
#' Prevent `ifelse()` from being used to produce `TRUE`/`FALSE` or `1`/`0`
#'
#' Expressions like `ifelse(x, TRUE, FALSE)` and `ifelse(x, FALSE, TRUE)` are
#' redundant; just `x` or `!x` suffice in R code where logical vectors are a
#' core data structure. `ifelse(x, 1, 0)` is also `as.numeric(x)`, but even
#' this should be needed only rarely.
#'
#' @evalRd rd_tags("redundant_ifelse_linter")
#' @param allow10 Logical, default `FALSE`. If `TRUE`, usage like
#' `ifelse(x, 1, 0)` is allowed, i.e., only usage like
#' `ifelse(x, TRUE, FALSE)` is linted.
#'
#' @examples
#' # will produce lints
#' lint(
#' text = "ifelse(x >= 2.5, TRUE, FALSE)",
#' linters = redundant_ifelse_linter()
#' )
#'
#' lint(
#' text = "ifelse(x < 2.5, 1L, 0L)",
#' linters = redundant_ifelse_linter()
#' )
#'
#' # okay
#' lint(
#' text = "x >= 2.5",
#' linters = redundant_ifelse_linter()
#' )
#'
#' # Note that this is just to show the strict equivalent of the example above;
#' # converting to integer is often unnecessary and the logical vector itself
#' # should suffice.
#' lint(
#' text = "as.integer(x < 2.5)",
#' linters = redundant_ifelse_linter()
#' )
#'
#' lint(
#' text = "ifelse(x < 2.5, 1L, 0L)",
#' linters = redundant_ifelse_linter(allow10 = TRUE)
#' )
#'
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
redundant_ifelse_linter <- function(allow10 = FALSE) {
tf_xpath <- glue("
//SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]
/parent::expr
/parent::expr[
expr[position() <= 4 and NUM_CONST[text() = 'TRUE']]
and expr[position() <= 4 and NUM_CONST[text() = 'FALSE']]
and (
count(expr) = 4
or expr[5]/NUM_CONST[text() = 'NA']
)
]
")
num_xpath <- glue("
//SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]
/parent::expr
/parent::expr[
expr[position() <= 4 and NUM_CONST[text() = '1' or text() = '1L']]
and expr[position() <= 4 and NUM_CONST[text() = '0' or text() = '0L']]
and (
count(expr) = 4
or expr[5]/NUM_CONST[text() = 'NA' or text() = 'NA_integer_' or text() = 'NA_real_']
)
]
")
Linter(function(source_expression) {
if (!is_lint_level(source_expression, "expression")) {
return(list())
}
xml <- source_expression$xml_parsed_content
lints <- list()
tf_expr <- xml_find_all(xml, tf_xpath)
matched_call <- xp_call_name(tf_expr)
# [1] call; [2] logical condition
first_arg <- xml_find_chr(tf_expr, "string(expr[3]/NUM_CONST)")
second_arg <- xml_find_chr(tf_expr, "string(expr[4]/NUM_CONST)")
tf_message <- sprintf(
"Just use the logical condition (or its negation) directly instead of calling %s(x, %s, %s)",
matched_call, first_arg, second_arg
)
lints <- c(lints, xml_nodes_to_lints(tf_expr, source_expression, tf_message, type = "warning"))
if (!allow10) {
num_expr <- xml_find_all(xml, num_xpath)
matched_call <- xp_call_name(num_expr)
# [1] call; [2] logical condition
first_arg <- xml_find_chr(num_expr, "string(expr[3]/NUM_CONST)")
second_arg <- xml_find_chr(num_expr, "string(expr[4]/NUM_CONST)")
is_numeric_01 <- first_arg %in% c("0", "1") | second_arg %in% c("0", "1")
coercion_function <- ifelse(is_numeric_01, "as.numeric", "as.integer")
is_negated <- first_arg %in% c("0", "0L")
replacement_argument <- ifelse(is_negated, "!x", "x")
lint_message <- paste(
sprintf(
"Prefer %s(%s) to %s(x, %s, %s) if really needed.",
coercion_function, replacement_argument, matched_call, first_arg, second_arg
)
)
lints <- c(lints, xml_nodes_to_lints(num_expr, source_expression, lint_message, type = "warning"))
}
return(lints)
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.