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

Extend unnecessary_lambda_linter to look for "inner comparisons" #2300

Merged
merged 18 commits into from
Nov 21, 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 NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@
* `library_call_linter()` is extended
+ to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
+ to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico).
* `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.

### New linters

Expand Down
80 changes: 78 additions & 2 deletions R/unnecessary_lambda_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,27 @@
#' the anonymous function _can_ be avoided, doing so is not always more
#' readable.
#'
#' @param allow_comparison Logical, default `FALSE`. If `TRUE`, lambdas like
#' `function(x) foo(x) == 2`, where `foo` can be extracted to the "mapping"
#' function and `==` vectorized instead of called repeatedly, are linted.
#'
#' @examples
#' # will produce lints
#' lint(
#' text = "lapply(list(1:3, 2:4), function(xi) sum(xi))",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) xi == 2)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(xi) > 0)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' # okay
#' lint(
#' text = "lapply(list(1:3, 2:4), sum)",
Expand All @@ -31,10 +45,30 @@
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) xi == 2)",
#' linters = unnecessary_lambda_linter(allow_comparison = TRUE)
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(xi) > 0)",
#' linters = unnecessary_lambda_linter(allow_comparison = TRUE)
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(abs(xi)) > 10)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, sum) > 0",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' @evalRd rd_tags("unnecessary_lambda_linter")
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
unnecessary_lambda_linter <- function() {
unnecessary_lambda_linter <- function(allow_comparison = FALSE) {
# include any base function like those where FUN is an argument
# and ... follows positionally directly afterwards (with ...
# being passed on to FUN). That excludes functions like
Expand All @@ -55,6 +89,27 @@ unnecessary_lambda_linter <- function() {
purrr_mappers
))

# OP-PLUS: condition for complex literal, e.g. 0+2i.
# NB: this includes 0+3 and TRUE+FALSE, which are also fine.
inner_comparison_xpath <- glue("
//SYMBOL_FUNCTION_CALL[text() = 'sapply' or text() = 'vapply']
/parent::expr
/parent::expr
/expr[FUNCTION]
/expr[
({ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) })
and expr[
expr/SYMBOL_FUNCTION_CALL
and expr/SYMBOL
]
and expr[
NUM_CONST
or STR_CONST
or (OP-PLUS and count(expr/NUM_CONST) = 2)
]
]
")

# outline:
# 1. match one of the identified mappers
# 2. match an anonymous function that can be "symbol-ized"
Expand Down Expand Up @@ -131,6 +186,27 @@ unnecessary_lambda_linter <- function() {
type = "warning"
)

inner_comparison_lints <- NULL
if (!allow_comparison) {
inner_comparison_expr <- xml_find_all(xml, inner_comparison_xpath)

mapper <- xp_call_name(xml_find_first(inner_comparison_expr, "parent::expr/parent::expr"))
if (length(mapper) > 0L) fun_value <- if (mapper == "sapply") "" else ", FUN.VALUE = <intermediate>"

inner_comparison_lints <- xml_nodes_to_lints(
inner_comparison_expr,
source_expression = source_expression,
lint_message = sprintf(
paste(
"Compare to a constant after calling %1$s() to get the full benefits of vectorization.",
"Prefer %1$s(x, foo%2$s) == 2 over %1$s(x, function(xi) foo(xi) == 2, logical(1L))."
AshesITR marked this conversation as resolved.
Show resolved Hide resolved
),
mapper, fun_value
),
type = "warning"
)
}

purrr_fun_expr <- xml_find_all(xml, purrr_fun_xpath)

purrr_call_fun <- xml_text(xml_find_first(purrr_fun_expr, fun_xpath))
Expand All @@ -146,6 +222,6 @@ unnecessary_lambda_linter <- function() {
type = "warning"
)

c(default_fun_lints, purrr_fun_lints)
c(default_fun_lints, inner_comparison_lints, purrr_fun_lints)
})
}
2 changes: 1 addition & 1 deletion inst/lintr/linters.csv
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ trailing_whitespace_linter,style default configurable
undesirable_function_linter,style efficiency configurable robustness best_practices
undesirable_operator_linter,style efficiency configurable robustness best_practices
unnecessary_concatenation_linter,style readability efficiency configurable
unnecessary_lambda_linter,best_practices efficiency readability
unnecessary_lambda_linter,best_practices efficiency readability configurable
unnecessary_nested_if_linter,readability best_practices
unnecessary_placeholder_linter,readability best_practices
unneeded_concatenation_linter,style readability efficiency configurable deprecated
Expand Down
1 change: 1 addition & 0 deletions man/configurable_linters.Rd

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

4 changes: 2 additions & 2 deletions man/linters.Rd

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

39 changes: 37 additions & 2 deletions man/unnecessary_lambda_linter.Rd

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

50 changes: 50 additions & 0 deletions tests/testthat/test-unnecessary_lambda_linter.R
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,20 @@ test_that("unnecessary_lambda_linter skips allowed usages", {
expect_lint("lapply(l, function(x = 1) 'a' %in% names(x))", NULL, linter)
})

test_that("unnecessary_lambda_linter skips allowed inner comparisons", {
linter <- unnecessary_lambda_linter()

# lapply returns a list, so not the same, though as.list is probably
# a better choice
expect_lint("lapply(x, function(xi) foo(xi) == 2)", NULL, linter)

# this _may_ return a matrix, though outer is probably a better choice if so
expect_lint("sapply(x, function(xi) foo(xi) == y)", NULL, linter)

# only lint "plain" calls that can be replaced by eliminating the lambda
expect_lint("sapply(x, function(xi) sum(abs(xi)) == 0)", NULL, linter)
})

test_that("unnecessary_lambda_linter blocks simple disallowed usage", {
linter <- unnecessary_lambda_linter()

Expand Down Expand Up @@ -109,6 +123,42 @@ test_that("unnecessary_lambda_linter blocks simple disallowed usage", {
)
})

test_that("unnecessary_lambda_linter blocks simple disallowed usages", {
linter <- unnecessary_lambda_linter()
linter_allow <- unnecessary_lambda_linter(allow_comparison = TRUE)
lint_msg <- rex::rex("Compare to a constant after calling sapply() to get", anything, "sapply(x, foo)")

expect_lint("sapply(x, function(xi) foo(xi) == 2)", lint_msg, linter)
expect_lint("sapply(x, function(xi) foo(xi) == 'a')", lint_msg, linter)
expect_lint("sapply(x, function(xi) foo(xi) == 1 + 2i)", lint_msg, linter)

expect_lint("sapply(x, function(xi) foo(xi) == 2)", NULL, linter_allow)
expect_lint("sapply(x, function(xi) foo(xi) == 'a')", NULL, linter_allow)
expect_lint("sapply(x, function(xi) foo(xi) == 1 + 2i)", NULL, linter_allow)

# vapply counts as well
# NB: we ignore the FUN.VALUE argument, for now
expect_lint(
"vapply(x, function(xi) foo(xi) == 2, logical(1L))",
rex::rex("Compare to a constant after calling vapply()", anything, "vapply(x, foo, FUN.VALUE = <intermediate>)"),
linter
)
})

test_that("unnecessary_lambda_linter blocks other comparators as well", {
linter <- unnecessary_lambda_linter()
linter_allow <- unnecessary_lambda_linter(allow_comparison = TRUE)
lint_msg <- rex::rex("Compare to a constant after calling sapply() to get")

expect_lint("sapply(x, function(xi) foo(xi) >= 2)", lint_msg, linter)
expect_lint("sapply(x, function(xi) foo(xi) != 'a')", lint_msg, linter)
expect_lint("sapply(x, function(xi) foo(xi) < 1 + 2i)", lint_msg, linter)

expect_lint("sapply(x, function(xi) foo(xi) >= 2)", NULL, linter_allow)
expect_lint("sapply(x, function(xi) foo(xi) != 'a')", NULL, linter_allow)
expect_lint("sapply(x, function(xi) foo(xi) < 1 + 2i)", NULL, linter_allow)
})

test_that("unnecessary_lambda_linter doesn't apply to keyword args", {
expect_lint("lapply(x, function(xi) data.frame(nm = xi))", NULL, unnecessary_lambda_linter())
expect_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", NULL, unnecessary_lambda_linter())
Expand Down
Loading