New any_is_na_linter

DESCRIPTION

@@ -49,6 +49,7 @@ Collate:
     'aaa.R'
     'actions.R'
     'addins.R'
+    'any_is_na_linter.R'
     'assignment_linter.R'
     'backport_linter.R'
     'cache.R'

NAMESPACE

@@ -13,6 +13,7 @@ export(T_and_F_symbol_linter)
 export(absolute_path_linter)
 export(all_undesirable_functions)
 export(all_undesirable_operators)
+export(any_is_na_linter)
 export(assignment_linter)
 export(available_linters)
 export(backport_linter)

NEWS.md

@@ -97,6 +97,7 @@ function calls. (#850, #851, @renkun-ken)
    * `expect_length_linter()` Require usage of `expect_length(x, n)` over `expect_equal(length(x), n)` and similar
    * `expect_identical_linter()` Require usage of `expect_identical()` by default, and `expect_equal()` only by exception
    * `expect_comparison_linter()` Require usage of `expect_gt(x, y)` over `expect_true(x > y)` and similar
+   * `any_is_na_linter()` Require usage of `anyNA(x)` over `any(is.na(x))`
 * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico)
 * `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico)
 * `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico)

R/any_is_na_linter.R

@@ -0,0 +1,37 @@
+#' Require usage of anyNA over any(is.na(.))
+#'
+#' [anyNA()] exists as a replacement for `any(is.na(.))` which is more efficient
+#'   for simple objects, and in the worst case is the same efficiency. Therefore
+#'   it should be used in all situations instead of the latter.
+#'
+#' @evalRd rd_tags("any_is_na_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+any_is_na_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    xpath <- "//expr[
+      expr[SYMBOL_FUNCTION_CALL[text() = 'any']]
+      and expr[expr[SYMBOL_FUNCTION_CALL[text() = 'is.na']]]
+      and (
+        count(expr) = 2
+        or (count(expr) = 3 and SYMBOL_SUB[text() = 'na.rm'])
+      )
+    ]"
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    return(lapply(
+      bad_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      lint_message = "anyNA(x) is better than any(is.na(x)).",
+      type = "warning"
+    ))
+  })
+}

inst/lintr/linters.csv

@@ -1,5 +1,6 @@
 linter,tags
 absolute_path_linter,robustness best_practices configurable
+any_is_na_linter,efficiency best_practices
 assignment_linter,style consistency default
 backport_linter,robustness configurable package_development
 closed_curly_linter,style readability default configurable

tests/testthat/test-any_is_na_linter.R

@@ -0,0 +1,22 @@
+test_that("any_is_na_linter skips allowed usages", {
+  expect_lint("x <- any(y)", NULL, any_is_na_linter())
+
+  expect_lint("y <- is.na(z)", NULL, any_is_na_linter())
+
+  # extended usage of ... arguments to any is not covered
+  expect_lint("any(is.na(y), b)", NULL, any_is_na_linter())
+  expect_lint("any(b, is.na(y))", NULL, any_is_na_linter())
+})
+
+test_that("any_is_na_linter blocks simple disallowed usages", {
+  lint_message <- rex::rex("anyNA(x) is better than any(is.na(x)).")
+  expect_lint("any(is.na(x))", lint_message, any_is_na_linter())
+
+  expect_lint("any(is.na(foo(x)))", lint_message, any_is_na_linter())
+
+  # na.rm doesn't really matter for this since is.na can't return NA
+  expect_lint("any(is.na(x), na.rm = TRUE)", lint_message, any_is_na_linter())
+
+  # also catch nested usage
+  expect_lint("foo(any(is.na(x)))", lint_message, any_is_na_linter())
+})