From b48eba663ff8c50045f602c2e5a8dd519af328c8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 19:37:31 +0000 Subject: [PATCH 01/10] New inner_comparison_linter --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS.md | 1 + R/inner_comparison_linter.R | 49 +++++++++++++++++++ inst/lintr/linters.csv | 1 + man/consistency_linters.Rd | 1 + man/efficiency_linters.Rd | 1 + man/inner_comparison_linter.Rd | 18 +++++++ man/linters.Rd | 5 +- tests/testthat/test-inner_comparison_linter.R | 32 ++++++++++++ 10 files changed, 108 insertions(+), 2 deletions(-) create mode 100644 R/inner_comparison_linter.R create mode 100644 man/inner_comparison_linter.Rd create mode 100644 tests/testthat/test-inner_comparison_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 7e0f6250d8..f58db186be 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -115,6 +115,7 @@ Collate: 'indentation_linter.R' 'infix_spaces_linter.R' 'inner_combine_linter.R' + 'inner_comparison_linter.R' 'is_lint_level.R' 'is_numeric_linter.R' 'keyword_quote_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 8be33824dd..611a6094cf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,6 +77,7 @@ export(implicit_integer_linter) export(indentation_linter) export(infix_spaces_linter) export(inner_combine_linter) +export(inner_comparison_linter) export(is_lint_level) export(is_numeric_linter) export(keyword_quote_linter) diff --git a/NEWS.md b/NEWS.md index 477b8e61ce..0b1bde36b2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,7 @@ * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico). * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup. * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico). +* `inner_comparison_linter()` for encouraging vectorized code instead of loops like `sapply(x, function(xi) xi == 2)` (part of #884, @MichaelChirico). ### Lint accuracy fixes: removing false positives diff --git a/R/inner_comparison_linter.R b/R/inner_comparison_linter.R new file mode 100644 index 0000000000..4187fd7b7f --- /dev/null +++ b/R/inner_comparison_linter.R @@ -0,0 +1,49 @@ +#' Require == to be used outside of sapply() when comparing to a constant +#' +#' `sapply(x, function(xi) foo(xi) == 2)` is the same as `sapply(x, foo) == 2`, +#' but misses the opportunity to vectorize the call to `==`. +#' +#' @examples +#' # will produce lints +#' lint( +#' text = "sapply(x, function(xi) xi == 2)", +#' linters = inner_comparison_linter() +#' ) +#' +#' lint( +#' text = "sapply(x, function(xi) sum(xi) > 0)", +#' linters = inner_comparison_linter() +#' ) +#' +#' # okay +#' lint( +#' text = "sapply(x, sum) > 0", +#' linters = inner_comparison_linter() +#' ) +#' +#' @evalRd rd_tags("inner_comparison_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +inner_comparison_linter <- make_linter_from_xpath( + # OP-PLUS: condition for complex literal, e.g. 0+2i. + # NB: this includes 0+3 and TRUE+FALSE, which are also fine. + xpath = " + //SYMBOL_FUNCTION_CALL[text() = 'sapply' or text() = 'vapply'] + /parent::expr + /parent::expr + /expr[FUNCTION] + /expr[ + (EQ or NE or GT or GE or LT or LE) + and expr[ + NUM_CONST + or STR_CONST + or (OP-PLUS and count(expr/NUM_CONST) = 2) + ] + ] + ", + lint_message = paste( + "Compare to a constant after calling sapply()/vapply()", + "to get the full benefits of vectorization.", + "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." + ) +) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 334f6167d2..78a6cf00a2 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -42,6 +42,7 @@ implicit_integer_linter,style consistency best_practices configurable indentation_linter,style readability default configurable infix_spaces_linter,style readability default configurable inner_combine_linter,efficiency consistency readability +inner_comparison_linter,efficiency consistency is_numeric_linter,readability best_practices consistency keyword_quote_linter,readability consistency style length_levels_linter,readability best_practices consistency diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 7d8a609c64..003801fc23 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -22,6 +22,7 @@ The following linters are tagged with 'consistency': \item{\code{\link{if_not_else_linter}}} \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{inner_combine_linter}}} +\item{\code{\link{inner_comparison_linter}}} \item{\code{\link{is_numeric_linter}}} \item{\code{\link{keyword_quote_linter}}} \item{\code{\link{length_levels_linter}}} diff --git a/man/efficiency_linters.Rd b/man/efficiency_linters.Rd index 146c0be543..5fb344e27d 100644 --- a/man/efficiency_linters.Rd +++ b/man/efficiency_linters.Rd @@ -18,6 +18,7 @@ The following linters are tagged with 'efficiency': \item{\code{\link{fixed_regex_linter}}} \item{\code{\link{ifelse_censor_linter}}} \item{\code{\link{inner_combine_linter}}} +\item{\code{\link{inner_comparison_linter}}} \item{\code{\link{length_test_linter}}} \item{\code{\link{lengths_linter}}} \item{\code{\link{literal_coercion_linter}}} diff --git a/man/inner_comparison_linter.Rd b/man/inner_comparison_linter.Rd new file mode 100644 index 0000000000..aceaa95c3a --- /dev/null +++ b/man/inner_comparison_linter.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/inner_comparison_linter.R +\name{inner_comparison_linter} +\alias{inner_comparison_linter} +\title{Require == to be used outside of sapply() when comparing to a constant} +\usage{ +inner_comparison_linter() +} +\description{ +\code{sapply(x, function(xi) foo(xi) == 2)} is the same as \code{sapply(x, foo) == 2}, +but harder to read and requires two passes over the vector. +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=consistency_linters]{consistency}, \link[=efficiency_linters]{efficiency} +} diff --git a/man/linters.Rd b/man/linters.Rd index 91d035bb03..2ae6dfe731 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,11 +20,11 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (56 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (8 linters)} \item{\link[=configurable_linters]{configurable} (34 linters)} -\item{\link[=consistency_linters]{consistency} (24 linters)} +\item{\link[=consistency_linters]{consistency} (25 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (8 linters)} -\item{\link[=efficiency_linters]{efficiency} (26 linters)} +\item{\link[=efficiency_linters]{efficiency} (27 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} @@ -77,6 +77,7 @@ The following linters exist: \item{\code{\link{indentation_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{infix_spaces_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{inner_combine_linter}} (tags: consistency, efficiency, readability)} +\item{\code{\link{inner_comparison_linter}} (tags: consistency, efficiency)} \item{\code{\link{is_numeric_linter}} (tags: best_practices, consistency, readability)} \item{\code{\link{keyword_quote_linter}} (tags: consistency, readability, style)} \item{\code{\link{length_levels_linter}} (tags: best_practices, consistency, readability)} diff --git a/tests/testthat/test-inner_comparison_linter.R b/tests/testthat/test-inner_comparison_linter.R new file mode 100644 index 0000000000..61cdfc989c --- /dev/null +++ b/tests/testthat/test-inner_comparison_linter.R @@ -0,0 +1,32 @@ +test_that("inner_comparison_linter skips allowed usages", { + linter <- inner_comparison_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) +}) + +test_that("inner_comparison_linter blocks simple disallowed usages", { + linter <- inner_comparison_linter() + lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") + + 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) + + # vapply counts as well + # NB: we ignore the FUN.VALUE argument, for now + expect_lint("vapply(x, function(xi) foo(xi) == 2, logical(1L))", lint_msg, linter) +}) + +test_that("inner_comparison_linter blocks other comparators as well", { + linter <- inner_comparison_linter() + lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") + + 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) +}) From 09ace01680f22b44307862d2df5b723f9ddd9e78 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 21:06:40 +0000 Subject: [PATCH 02/10] roxy for examples --- man/inner_comparison_linter.Rd | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/man/inner_comparison_linter.Rd b/man/inner_comparison_linter.Rd index aceaa95c3a..a91a7be3ed 100644 --- a/man/inner_comparison_linter.Rd +++ b/man/inner_comparison_linter.Rd @@ -8,7 +8,26 @@ inner_comparison_linter() } \description{ \code{sapply(x, function(xi) foo(xi) == 2)} is the same as \code{sapply(x, foo) == 2}, -but harder to read and requires two passes over the vector. +but misses the opportunity to vectorize the call to \code{==}. +} +\examples{ +# will produce lints +lint( + text = "sapply(x, function(xi) xi == 2)", + linters = inner_comparison_linter() +) + +lint( + text = "sapply(x, function(xi) sum(xi) > 0)", + linters = inner_comparison_linter() +) + +# okay +lint( + text = "sapply(x, sum) > 0", + linters = inner_comparison_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. From 851995101cc7bce2826911cb81857a73efc5bdd9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 21:41:27 -0800 Subject: [PATCH 03/10] ensure no previous expression as well --- NEWS.md | 4 +++- R/unnecessary_lambda_linter.R | 5 ++++- tests/testthat/test-unnecessary_lambda_linter.R | 4 ++++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index ff2572d815..8685031574 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,7 +37,9 @@ ### Lint accuracy fixes: removing false positives * `unreachable_code_linter()` ignores reachable code in inline functions like `function(x) if (x > 2) stop() else x` (#2259, @MEO265). -* `unnecessary_lambda_linter()` ignores extractions with explicit returns like `lapply(l, function(x) foo(x)$bar)` (#2258, @MichaelChirico). +* `unnecessary_lambda_linter()` + + ignores extractions with explicit returns like `lapply(l, function(x) foo(x)$bar)` (#2258, @MichaelChirico). + + ignores calls on the RHS of operators like `lapply(l, function(x) "a" %in% names(x))` (#2310, @MichaelChirico). # lintr 3.1.1 diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index abbd856fba..4b52644f96 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -75,7 +75,10 @@ unnecessary_lambda_linter <- function() { position() = 2 and preceding-sibling::expr/SYMBOL_FUNCTION_CALL and not(preceding-sibling::*[1][self::EQ_SUB]) - and not(parent::expr/following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)]) + and not(parent::expr[ + preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)] + or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)] + ]) ]/SYMBOL ] /parent::expr diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index b3649439d1..15d57bd192 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -71,6 +71,10 @@ test_that("unnecessary_lambda_linter skips allowed usages", { NULL, linter ) + + # only call is on RHS of operator, #2310 + expect_lint("lapply(l, function(x) 'a' %in% names(x))", NULL, linter) + expect_lint("lapply(l, function(x = 1) 'a' %in% names(x))", NULL, linter) }) test_that("unnecessary_lambda_linter blocks simple disallowed usage", { From 869959e61982402d2e17699c6b56ecee089eef10 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 21:58:08 -0800 Subject: [PATCH 04/10] initial merge into unnecessary_lambda_linter (not working yet) --- DESCRIPTION | 1 - NAMESPACE | 1 - NEWS.md | 2 +- R/inner_comparison_linter.R | 49 ----------------- R/unnecessary_lambda_linter.R | 53 ++++++++++++++++++- inst/lintr/linters.csv | 3 +- man/configurable_linters.Rd | 1 + man/consistency_linters.Rd | 1 - man/efficiency_linters.Rd | 1 - man/inner_comparison_linter.Rd | 37 ------------- man/linters.Rd | 9 ++-- man/unnecessary_lambda_linter.Rd | 34 +++++++++++- tests/testthat/test-inner_comparison_linter.R | 32 ----------- .../testthat/test-unnecessary_lambda_linter.R | 33 ++++++++++++ 14 files changed, 124 insertions(+), 133 deletions(-) delete mode 100644 R/inner_comparison_linter.R delete mode 100644 man/inner_comparison_linter.Rd delete mode 100644 tests/testthat/test-inner_comparison_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 6f454185e6..6e9bcfa024 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -115,7 +115,6 @@ Collate: 'indentation_linter.R' 'infix_spaces_linter.R' 'inner_combine_linter.R' - 'inner_comparison_linter.R' 'is_lint_level.R' 'is_numeric_linter.R' 'keyword_quote_linter.R' diff --git a/NAMESPACE b/NAMESPACE index d007df3a7d..604679f238 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,7 +77,6 @@ export(implicit_integer_linter) export(indentation_linter) export(infix_spaces_linter) export(inner_combine_linter) -export(inner_comparison_linter) export(is_lint_level) export(is_numeric_linter) export(keyword_quote_linter) diff --git a/NEWS.md b/NEWS.md index d7cba11a61..c056f8404f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,6 +19,7 @@ * More helpful errors for invalid configs (#2253, @MichaelChirico). * `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). +* `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 @@ -31,7 +32,6 @@ * `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico). * `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico). * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico). -* `inner_comparison_linter()` for encouraging vectorized code instead of loops like `sapply(x, function(xi) xi == 2)` (part of #884, @MichaelChirico). * `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (part of #884, @MichaelChirico). * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico). diff --git a/R/inner_comparison_linter.R b/R/inner_comparison_linter.R deleted file mode 100644 index 4187fd7b7f..0000000000 --- a/R/inner_comparison_linter.R +++ /dev/null @@ -1,49 +0,0 @@ -#' Require == to be used outside of sapply() when comparing to a constant -#' -#' `sapply(x, function(xi) foo(xi) == 2)` is the same as `sapply(x, foo) == 2`, -#' but misses the opportunity to vectorize the call to `==`. -#' -#' @examples -#' # will produce lints -#' lint( -#' text = "sapply(x, function(xi) xi == 2)", -#' linters = inner_comparison_linter() -#' ) -#' -#' lint( -#' text = "sapply(x, function(xi) sum(xi) > 0)", -#' linters = inner_comparison_linter() -#' ) -#' -#' # okay -#' lint( -#' text = "sapply(x, sum) > 0", -#' linters = inner_comparison_linter() -#' ) -#' -#' @evalRd rd_tags("inner_comparison_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -inner_comparison_linter <- make_linter_from_xpath( - # OP-PLUS: condition for complex literal, e.g. 0+2i. - # NB: this includes 0+3 and TRUE+FALSE, which are also fine. - xpath = " - //SYMBOL_FUNCTION_CALL[text() = 'sapply' or text() = 'vapply'] - /parent::expr - /parent::expr - /expr[FUNCTION] - /expr[ - (EQ or NE or GT or GE or LT or LE) - and expr[ - NUM_CONST - or STR_CONST - or (OP-PLUS and count(expr/NUM_CONST) = 2) - ] - ] - ", - lint_message = paste( - "Compare to a constant after calling sapply()/vapply()", - "to get the full benefits of vectorization.", - "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." - ) -) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 4b52644f96..4d9a5d5c57 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -8,6 +8,10 @@ #' 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( @@ -15,6 +19,16 @@ #' linters = unnecessary_lambda_linter() #' ) #' +#' lint( +#' text = "sapply(x, function(xi) xi == 2)", +#' linters = inner_comparison_linter() +#' ) +#' +#' lint( +#' text = "sapply(x, function(xi) sum(xi) > 0)", +#' linters = inner_comparison_linter() +#' ) +#' #' # okay #' lint( #' text = "lapply(list(1:3, 2:4), sum)", @@ -31,10 +45,25 @@ #' linters = unnecessary_lambda_linter() #' ) #' +#' lint( +#' text = "sapply(x, function(xi) xi == 2)", +#' linters = inner_comparison_linter(allow_comparison = TRUE) +#' ) +#' +#' lint( +#' text = "sapply(x, function(xi) sum(xi) > 0)", +#' linters = inner_comparison_linter(allow_comparison = TRUE) +#' ) +#' +#' lint( +#' text = "sapply(x, sum) > 0", +#' linters = inner_comparison_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 @@ -55,6 +84,28 @@ 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 <- " + //SYMBOL_FUNCTION_CALL[text() = 'sapply' or text() = 'vapply'] + /parent::expr + /parent::expr + /expr[FUNCTION] + /expr[ + (EQ or NE or GT or GE or LT or LE) + and expr[ + NUM_CONST + or STR_CONST + or (OP-PLUS and count(expr/NUM_CONST) = 2) + ] + ] + " + lint_message <- paste( + "Compare to a constant after calling sapply()/vapply()", + "to get the full benefits of vectorization.", + "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." + ) + # outline: # 1. match one of the identified mappers # 2. match an anonymous function that can be "symbol-ized" diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 2abf64279c..f6d2477274 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -42,7 +42,6 @@ implicit_integer_linter,style consistency best_practices configurable indentation_linter,style readability default configurable infix_spaces_linter,style readability default configurable inner_combine_linter,efficiency consistency readability -inner_comparison_linter,efficiency consistency is_numeric_linter,readability best_practices consistency keyword_quote_linter,readability consistency style length_levels_linter,readability best_practices consistency @@ -107,7 +106,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 diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index 0f5adb229a..fd3c597d4e 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -46,6 +46,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{undesirable_function_linter}}} \item{\code{\link{undesirable_operator_linter}}} \item{\code{\link{unnecessary_concatenation_linter}}} +\item{\code{\link{unnecessary_lambda_linter}}} \item{\code{\link{unused_import_linter}}} } } diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 47900c53c6..24ae08f8d7 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -22,7 +22,6 @@ The following linters are tagged with 'consistency': \item{\code{\link{if_not_else_linter}}} \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{inner_combine_linter}}} -\item{\code{\link{inner_comparison_linter}}} \item{\code{\link{is_numeric_linter}}} \item{\code{\link{keyword_quote_linter}}} \item{\code{\link{length_levels_linter}}} diff --git a/man/efficiency_linters.Rd b/man/efficiency_linters.Rd index e5bdee0c07..808cf7a107 100644 --- a/man/efficiency_linters.Rd +++ b/man/efficiency_linters.Rd @@ -18,7 +18,6 @@ The following linters are tagged with 'efficiency': \item{\code{\link{fixed_regex_linter}}} \item{\code{\link{ifelse_censor_linter}}} \item{\code{\link{inner_combine_linter}}} -\item{\code{\link{inner_comparison_linter}}} \item{\code{\link{length_test_linter}}} \item{\code{\link{lengths_linter}}} \item{\code{\link{list_comparison_linter}}} diff --git a/man/inner_comparison_linter.Rd b/man/inner_comparison_linter.Rd deleted file mode 100644 index a91a7be3ed..0000000000 --- a/man/inner_comparison_linter.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/inner_comparison_linter.R -\name{inner_comparison_linter} -\alias{inner_comparison_linter} -\title{Require == to be used outside of sapply() when comparing to a constant} -\usage{ -inner_comparison_linter() -} -\description{ -\code{sapply(x, function(xi) foo(xi) == 2)} is the same as \code{sapply(x, foo) == 2}, -but misses the opportunity to vectorize the call to \code{==}. -} -\examples{ -# will produce lints -lint( - text = "sapply(x, function(xi) xi == 2)", - linters = inner_comparison_linter() -) - -lint( - text = "sapply(x, function(xi) sum(xi) > 0)", - linters = inner_comparison_linter() -) - -# okay -lint( - text = "sapply(x, sum) > 0", - linters = inner_comparison_linter() -) - -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=consistency_linters]{consistency}, \link[=efficiency_linters]{efficiency} -} diff --git a/man/linters.Rd b/man/linters.Rd index 14fdbc0b1c..1883882839 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,12 +19,12 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (62 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (10 linters)} -\item{\link[=configurable_linters]{configurable} (35 linters)} -\item{\link[=consistency_linters]{consistency} (29 linters)} +\item{\link[=configurable_linters]{configurable} (36 linters)} +\item{\link[=consistency_linters]{consistency} (28 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (4 linters)} -\item{\link[=efficiency_linters]{efficiency} (31 linters)} +\item{\link[=efficiency_linters]{efficiency} (30 linters)} \item{\link[=executing_linters]{executing} (6 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} @@ -78,7 +78,6 @@ The following linters exist: \item{\code{\link{indentation_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{infix_spaces_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{inner_combine_linter}} (tags: consistency, efficiency, readability)} -\item{\code{\link{inner_comparison_linter}} (tags: consistency, efficiency)} \item{\code{\link{is_numeric_linter}} (tags: best_practices, consistency, readability)} \item{\code{\link{keyword_quote_linter}} (tags: consistency, readability, style)} \item{\code{\link{length_levels_linter}} (tags: best_practices, consistency, readability)} @@ -138,7 +137,7 @@ The following linters exist: \item{\code{\link{undesirable_function_linter}} (tags: best_practices, configurable, efficiency, robustness, style)} \item{\code{\link{undesirable_operator_linter}} (tags: best_practices, configurable, efficiency, robustness, style)} \item{\code{\link{unnecessary_concatenation_linter}} (tags: configurable, efficiency, readability, style)} -\item{\code{\link{unnecessary_lambda_linter}} (tags: best_practices, efficiency, readability)} +\item{\code{\link{unnecessary_lambda_linter}} (tags: best_practices, configurable, efficiency, readability)} \item{\code{\link{unnecessary_nested_if_linter}} (tags: best_practices, readability)} \item{\code{\link{unnecessary_placeholder_linter}} (tags: best_practices, readability)} \item{\code{\link{unreachable_code_linter}} (tags: best_practices, readability)} diff --git a/man/unnecessary_lambda_linter.Rd b/man/unnecessary_lambda_linter.Rd index 12a44eab32..4254aa3489 100644 --- a/man/unnecessary_lambda_linter.Rd +++ b/man/unnecessary_lambda_linter.Rd @@ -4,7 +4,12 @@ \alias{unnecessary_lambda_linter} \title{Block usage of anonymous functions in iteration functions when unnecessary} \usage{ -unnecessary_lambda_linter() +unnecessary_lambda_linter(allow_comparison = FALSE) +} +\arguments{ +\item{allow_comparison}{Logical, default \code{FALSE}. If \code{TRUE}, lambdas like +\code{function(x) foo(x) == 2}, where \code{foo} can be extracted to the "mapping" +function and \code{==} vectorized instead of called repeatedly, are linted.} } \description{ Using an anonymous function in, e.g., \code{\link[=lapply]{lapply()}} is not always necessary, @@ -23,6 +28,16 @@ lint( linters = unnecessary_lambda_linter() ) +lint( + text = "sapply(x, function(xi) xi == 2)", + linters = inner_comparison_linter() +) + +lint( + text = "sapply(x, function(xi) sum(xi) > 0)", + linters = inner_comparison_linter() +) + # okay lint( text = "lapply(list(1:3, 2:4), sum)", @@ -39,10 +54,25 @@ lint( linters = unnecessary_lambda_linter() ) +lint( + text = "sapply(x, function(xi) xi == 2)", + linters = inner_comparison_linter(allow_comparison = TRUE) +) + +lint( + text = "sapply(x, function(xi) sum(xi) > 0)", + linters = inner_comparison_linter(allow_comparison = TRUE) +) + +lint( + text = "sapply(x, sum) > 0", + linters = inner_comparison_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=efficiency_linters]{efficiency}, \link[=readability_linters]{readability} +\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=efficiency_linters]{efficiency}, \link[=readability_linters]{readability} } diff --git a/tests/testthat/test-inner_comparison_linter.R b/tests/testthat/test-inner_comparison_linter.R deleted file mode 100644 index 61cdfc989c..0000000000 --- a/tests/testthat/test-inner_comparison_linter.R +++ /dev/null @@ -1,32 +0,0 @@ -test_that("inner_comparison_linter skips allowed usages", { - linter <- inner_comparison_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) -}) - -test_that("inner_comparison_linter blocks simple disallowed usages", { - linter <- inner_comparison_linter() - lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") - - 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) - - # vapply counts as well - # NB: we ignore the FUN.VALUE argument, for now - expect_lint("vapply(x, function(xi) foo(xi) == 2, logical(1L))", lint_msg, linter) -}) - -test_that("inner_comparison_linter blocks other comparators as well", { - linter <- inner_comparison_linter() - lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") - - 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) -}) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 15d57bd192..73845ee441 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -77,6 +77,17 @@ 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) +}) + test_that("unnecessary_lambda_linter blocks simple disallowed usage", { linter <- unnecessary_lambda_linter() @@ -109,6 +120,28 @@ test_that("unnecessary_lambda_linter blocks simple disallowed usage", { ) }) +test_that("unnecessary_lambda_linter blocks simple disallowed usages", { + linter <- unnecessary_lambda_linter() + lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") + + 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) + + # vapply counts as well + # NB: we ignore the FUN.VALUE argument, for now + expect_lint("vapply(x, function(xi) foo(xi) == 2, logical(1L))", lint_msg, linter) +}) + +test_that("unnecessary_lambda_linter blocks other comparators as well", { + linter <- unnecessary_lambda_linter() + lint_msg <- rex::rex("Compare to a constant after calling sapply()/vapply()") + + 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) +}) + 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()) From 6ea4242b3d02beaf964bbccb5e88ca7eacf819fd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 22:12:58 -0800 Subject: [PATCH 05/10] Working now --- R/unnecessary_lambda_linter.R | 23 ++++++++++++++----- .../testthat/test-unnecessary_lambda_linter.R | 10 ++++++++ 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 4d9a5d5c57..a98611e2ba 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -100,11 +100,6 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { ] ] " - lint_message <- paste( - "Compare to a constant after calling sapply()/vapply()", - "to get the full benefits of vectorization.", - "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." - ) # outline: # 1. match one of the identified mappers @@ -182,6 +177,22 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { type = "warning" ) + inner_comparison_lints <- NULL + if (!allow_comparison) { + inner_comparison_expr <- xml_find_all(xml, inner_comparison_xpath) + + inner_comparison_lints <- xml_nodes_to_lints( + inner_comparison_expr, + source_expression = source_expression, + lint_message = paste( + "Compare to a constant after calling sapply()/vapply()", + "to get the full benefits of vectorization.", + "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." + ), + 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)) @@ -197,6 +208,6 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { type = "warning" ) - c(default_fun_lints, purrr_fun_lints) + c(default_fun_lints, inner_comparison_lints, purrr_fun_lints) }) } diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 73845ee441..e10dcdcb61 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -122,12 +122,17 @@ 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()/vapply()") 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))", lint_msg, linter) @@ -135,11 +140,16 @@ test_that("unnecessary_lambda_linter blocks simple disallowed usages", { 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()/vapply()") 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", { From 3c4ffe15e586dc062c81223b3702bcf05d017f84 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 22:29:19 -0800 Subject: [PATCH 06/10] customized lint --- R/unnecessary_lambda_linter.R | 13 +++++++++---- tests/testthat/test-unnecessary_lambda_linter.R | 10 +++++++--- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index a98611e2ba..ce797e79df 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -181,13 +181,18 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { 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 = " + inner_comparison_lints <- xml_nodes_to_lints( inner_comparison_expr, source_expression = source_expression, - lint_message = paste( - "Compare to a constant after calling sapply()/vapply()", - "to get the full benefits of vectorization.", - "Prefer sapply(x, foo) == 2 over sapply(x, function(xi) foo(xi) == 2)." + 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))." + ), + mapper, fun_value ), type = "warning" ) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index e10dcdcb61..ca883c6f36 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -123,7 +123,7 @@ 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()/vapply()") + 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) @@ -135,13 +135,17 @@ test_that("unnecessary_lambda_linter blocks simple disallowed usages", { # vapply counts as well # NB: we ignore the FUN.VALUE argument, for now - expect_lint("vapply(x, function(xi) foo(xi) == 2, logical(1L))", lint_msg, linter) + 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 = )"), + 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()/vapply()") + 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) From ce46fcfc9efa8dc9ec72278c45760a8195d1fccd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 22:30:47 -0800 Subject: [PATCH 07/10] shared infix metadata --- R/unnecessary_lambda_linter.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index ce797e79df..22cc7e6271 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -86,20 +86,20 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { # 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 <- " + inner_comparison_xpath <- glue(" //SYMBOL_FUNCTION_CALL[text() = 'sapply' or text() = 'vapply'] /parent::expr /parent::expr /expr[FUNCTION] /expr[ - (EQ or NE or GT or GE or LT or LE) + ({ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) }) and expr[ NUM_CONST or STR_CONST or (OP-PLUS and count(expr/NUM_CONST) = 2) ] ] - " + ") # outline: # 1. match one of the identified mappers From 35ba0309614dc2ffd0784f4ee200fb9d616e0d09 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 22:32:39 -0800 Subject: [PATCH 08/10] fix vestigial name, stage new example --- R/unnecessary_lambda_linter.R | 15 ++++++++++----- man/unnecessary_lambda_linter.Rd | 15 ++++++++++----- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 22cc7e6271..016480d579 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -21,12 +21,12 @@ #' #' lint( #' text = "sapply(x, function(xi) xi == 2)", -#' linters = inner_comparison_linter() +#' linters = unnecessary_lambda_linter() #' ) #' #' lint( #' text = "sapply(x, function(xi) sum(xi) > 0)", -#' linters = inner_comparison_linter() +#' linters = unnecessary_lambda_linter() #' ) #' #' # okay @@ -47,17 +47,22 @@ #' #' lint( #' text = "sapply(x, function(xi) xi == 2)", -#' linters = inner_comparison_linter(allow_comparison = TRUE) +#' linters = unnecessary_lambda_linter(allow_comparison = TRUE) #' ) #' #' lint( #' text = "sapply(x, function(xi) sum(xi) > 0)", -#' linters = inner_comparison_linter(allow_comparison = TRUE) +#' 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 = inner_comparison_linter() +#' linters = unnecessary_lambda_linter() #' ) #' #' @evalRd rd_tags("unnecessary_lambda_linter") diff --git a/man/unnecessary_lambda_linter.Rd b/man/unnecessary_lambda_linter.Rd index 4254aa3489..d151e7e6a9 100644 --- a/man/unnecessary_lambda_linter.Rd +++ b/man/unnecessary_lambda_linter.Rd @@ -30,12 +30,12 @@ lint( lint( text = "sapply(x, function(xi) xi == 2)", - linters = inner_comparison_linter() + linters = unnecessary_lambda_linter() ) lint( text = "sapply(x, function(xi) sum(xi) > 0)", - linters = inner_comparison_linter() + linters = unnecessary_lambda_linter() ) # okay @@ -56,17 +56,22 @@ lint( lint( text = "sapply(x, function(xi) xi == 2)", - linters = inner_comparison_linter(allow_comparison = TRUE) + linters = unnecessary_lambda_linter(allow_comparison = TRUE) ) lint( text = "sapply(x, function(xi) sum(xi) > 0)", - linters = inner_comparison_linter(allow_comparison = TRUE) + 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 = inner_comparison_linter() + linters = unnecessary_lambda_linter() ) } From 12a52a0078711b164dea5123a0c6e9ccf79cace0 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 22:36:26 -0800 Subject: [PATCH 09/10] Restrict to non-nested calls --- R/unnecessary_lambda_linter.R | 4 ++++ tests/testthat/test-unnecessary_lambda_linter.R | 3 +++ 2 files changed, 7 insertions(+) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 016480d579..99220c6f66 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -98,6 +98,10 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { /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 diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index ca883c6f36..4036e6839d 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -86,6 +86,9 @@ test_that("unnecessary_lambda_linter skips allowed inner comparisons", { # 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", { From 86005d52f17d172b488f0d34c57e9ba90d0eeb3c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 20 Nov 2023 21:34:31 +0000 Subject: [PATCH 10/10] remove dup NEWS entry --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 8b4300ee17..9ee99517a7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,7 +21,6 @@ * `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). -* `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). * `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