New boolean_arithmetic_linter

DESCRIPTION

@@ -63,6 +63,7 @@ Collate:
     'any_is_na_linter.R'
     'assignment_linter.R'
     'backport_linter.R'
+    'boolean_arithmetic_linter.R'
     'brace_linter.R'
     'cache.R'
     'class_equals_linter.R'

NAMESPACE

@@ -25,6 +25,7 @@ export(assignment_linter)
 export(available_linters)
 export(available_tags)
 export(backport_linter)
+export(boolean_arithmetic_linter)
 export(brace_linter)
 export(checkstyle_output)
 export(class_equals_linter)

NEWS.md

@@ -26,12 +26,16 @@
 
 * `unnecessary_lambda_linter()`: detect unnecessary lambdas (anonymous functions), e.g.
   `lapply(x, function(xi) sum(xi))` can be `lapply(x, sum)` and `purrr::map(x, ~quantile(.x, 0.75, na.rm = TRUE))`
-  can be `purrr::map(x, quantile, 0.75, na.rm = TRUE)`. Naming `probs = 0.75` can further improve readability.
+  can be `purrr::map(x, quantile, 0.75, na.rm = TRUE)`. Naming `probs = 0.75` can further improve readability (#1531, @MichaelChirico).
+
 * `redundant_equals_linter()` for redundant comparisons to `TRUE` or `FALSE` like `is_treatment == TRUE` (#1500, @MichaelChirico)
 
 * `function_return_linter()` for handling issues in function `return()` statements. Currently handles assignments within the `return()`
   clause, e.g. `return(x <- foo())` (@MichaelChirico)
 
+* `boolean_arithmetic_linter()` for identifying places where logical aggregations are more appropriate, e.g.
+  `length(which(x == y)) == 0` is the same as `!any(x == y)` or even `all(x != y)` (@MichaelChirico)
+
 # lintr 3.0.1
 
 * Skip multi-byte tests in non UTF-8 locales (#1504)

R/boolean_arithmetic_linter.R

@@ -0,0 +1,57 @@
+#' Require usage of boolean operators over equivalent arithmetic
+#'
+#' `length(which(x == y)) == 0` is the same as `!any(x == y)`, but the latter
+#'   is more readable and more efficient.
+#'
+#' #' @evalRd rd_tags("boolean_arithmetic_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+boolean_arithmetic_linter <- function() {
+  # TODO(#1580): sum() cases x %in% y, A [&|] B, !A, is.na/is.nan/is.finite/is.infinite/is.element
+  # TODO(#1581): extend to include all()-alike expressions
+  zero_expr <-
+    "(EQ or NE or GT or LE) and expr[NUM_CONST[text() = '0' or text() = '0L']]"
+  one_expr <-
+    "(LT or GE) and expr[NUM_CONST[text() = '1' or text() = '1L']]"
+  length_xpath <- glue::glue("
+    //SYMBOL_FUNCTION_CALL[text() = 'which' or text() = 'grep']
+    /parent::expr
+    /parent::expr
+    /parent::expr[
+      expr[SYMBOL_FUNCTION_CALL[text() = 'length']]
+      and parent::expr[ ({zero_expr}) or ({one_expr})]
+    ]
+  ")
+  sum_xpath <- glue::glue("
+    //SYMBOL_FUNCTION_CALL[text() = 'sum']
+    /parent::expr
+    /parent::expr[
+      expr[
+        expr[SYMBOL_FUNCTION_CALL[text() = 'grepl']]
+        or (EQ or NE or GT or LT or GE or LE)
+      ] and parent::expr[ ({zero_expr}) or ({one_expr})]
+    ]
+  ")
+  any_xpath <- paste(length_xpath, "|", sum_xpath)
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    any_expr <- xml2::xml_find_all(xml, any_xpath)
+
+    xml_nodes_to_lints(
+      any_expr,
+      source_expression = source_expression,
+      # TODO(michaelchirico): customize this?
+      lint_message = paste(
+        "Use any() to express logical aggregations.",
+        "For example, replace length(which(x == y)) == 0 with !any(x == y)."
+      ),
+      type = "warning"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -4,6 +4,7 @@ any_duplicated_linter,efficiency best_practices
 any_is_na_linter,efficiency best_practices
 assignment_linter,style consistency default
 backport_linter,robustness configurable package_development
+boolean_arithmetic_linter,efficiency best_practices readability
 brace_linter,style readability default configurable
 class_equals_linter,best_practices robustness consistency
 closed_curly_linter,style readability deprecated configurable

tests/testthat/test-boolean_arithmetic_linter.R

@@ -0,0 +1,20 @@
+test_that("boolean_arithmetic_linter requires use of any() or !any()", {
+  linter <- boolean_arithmetic_linter()
+  lint_msg <- rex::rex("Use any() to express logical aggregations.")
+
+  expect_lint("length(which(x == y)) == 0", lint_msg, linter)
+  # anything passed to which() can be assumed to be logical
+  expect_lint("length(which(is_treatment)) == 0L", lint_msg, linter)
+  # regex version
+  expect_lint("length(grep(pattern, x)) == 0", lint_msg, linter)
+  # sum version
+  expect_lint("sum(x == y) == 0L", lint_msg, linter)
+  expect_lint("sum(grepl(pattern, x)) == 0", lint_msg, linter)
+
+  # non-== comparisons
+  expect_lint("length(which(x == y)) > 0L", lint_msg, linter)
+  expect_lint("length(which(is_treatment)) < 1", lint_msg, linter)
+  expect_lint("length(grep(pattern, x)) >= 1L", lint_msg, linter)
+  expect_lint("sum(x == y) != 0", lint_msg, linter)
+  expect_lint("sum(grepl(pattern, x)) > 0L", lint_msg, linter)
+})