scalar_in_linter() for x %in% 1 (#2084)

* New scalar_in_linter()

* NEWS

* specific TODO

* Update test-scalar_in_linter.R

* progress customizing for NA

* correct tests

* revert most changes related to NA (just skip linting)

* tests for NA

* tweak comment

---------

Co-authored-by: AshesITR <alexander.rosenstock@web.de>

Author: MichaelChirico

DESCRIPTION

@@ -150,6 +150,7 @@ Collate:
     'redundant_ifelse_linter.R'
     'regex_subset_linter.R'
     'routine_registration_linter.R'
+    'scalar_in_linter.R'
     'semicolon_linter.R'
     'seq_linter.R'
     'settings.R'

NAMESPACE

@@ -115,6 +115,7 @@ export(redundant_ifelse_linter)
 export(regex_subset_linter)
 export(routine_registration_linter)
 export(sarif_output)
+export(scalar_in_linter)
 export(semicolon_linter)
 export(semicolon_terminator_linter)
 export(seq_linter)

NEWS.md

@@ -39,6 +39,7 @@
 * `library_call_linter()` can detect if all library/require calls are not at the top of your script (#2027 and #2043, @nicholas-masel and @MichaelChirico).
 * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`).
 * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
+* `scalar_in_linter()` for discouraging `%in%` when the right-hand side is a scalar, e.g. `x %in% 1` (part of #884, @MichaelChirico).
 * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico).
 * `commas_linter()` gains an option `allow_trailing` (default `FALSE`) to allow trailing commas while indexing. (#2104, @MEO265)
 

R/scalar_in_linter.R

@@ -0,0 +1,41 @@
+#' Block usage like x %in% "a"
+#'
+#' `vector %in% set` is appropriate for matching a vector to a set, but if
+#'   that set has size 1, `==` is more appropriate. `%chin%` from `data.table`
+#'   is matched as well.
+#'
+#' `scalar %in% vector` is OK, because the alternative (`any(vector == scalar)`)
+#'   is more circuitous & potentially less clear.
+#'
+#' @evalRd rd_tags("scalar_in_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+scalar_in_linter <- function() {
+  # TODO(#2085): Extend to include other cases where the RHS is clearly a scalar
+  # NB: all of logical, integer, double, hex, complex are parsed as NUM_CONST
+  xpath <- "
+  //SPECIAL[text() = '%in%' or text() = '%chin%']
+    /following-sibling::expr[NUM_CONST[not(starts-with(text(), 'NA'))] or STR_CONST]
+    /parent::expr
+  "
+
+  return(Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    bad_expr <- xml_find_all(xml, xpath)
+    in_op <- xml_find_chr(bad_expr, "string(SPECIAL)")
+    lint_msg <-
+      paste0("Use == to match length-1 scalars, not ", in_op, ". Note that == preserves NA where ", in_op, " does not.")
+
+    xml_nodes_to_lints(
+      bad_expr,
+      source_expression = source_expression,
+      lint_message = lint_msg,
+      type = "warning"
+    )
+  }))
+}

inst/lintr/linters.csv

@@ -72,6 +72,7 @@ redundant_equals_linter,best_practices readability efficiency common_mistakes
 redundant_ifelse_linter,best_practices efficiency consistency configurable
 regex_subset_linter,best_practices efficiency
 routine_registration_linter,best_practices efficiency robustness
+scalar_in_linter,readability consistency best_practices efficiency
 semicolon_linter,style readability default configurable
 semicolon_terminator_linter,style readability deprecated configurable
 seq_linter,robustness efficiency consistency best_practices default

man/best_practices_linters.Rd

@@ -0,0 +1,37 @@
+test_that("scalar_in_linter skips allowed usages", {
+  linter <- scalar_in_linter()
+
+  expect_lint("x %in% y", NULL, linter)
+  expect_lint("y %in% c('a', 'b')", NULL, linter)
+  expect_lint("c('a', 'b') %chin% x", NULL, linter)
+  expect_lint("z %in% 1:3", NULL, linter)
+  # scalars on LHS are fine (often used as `"col" %in% names(DF)`)
+  expect_lint("3L %in% x", NULL, linter)
+
+  # this should be is.na(x), but it more directly uses the "always TRUE/FALSE, _not_ NA"
+  #   aspect of %in%, so we delegate linting here to equals_na_linter()
+  expect_lint("x %in% NA", NULL, linter)
+  expect_lint("x %in% NA_character_", NULL, linter)
+})
+
+test_that("scalar_in_linter blocks simple disallowed usages", {
+  linter <- scalar_in_linter()
+  lint_in_msg <- rex::rex("Use == to match length-1 scalars, not %in%.")
+  lint_chin_msg <- rex::rex("Use == to match length-1 scalars, not %chin%.")
+
+  expect_lint("x %in% 1", lint_in_msg, linter)
+  expect_lint("x %chin% 'a'", lint_chin_msg, linter)
+})
+
+test_that("multiple lints are generated correctly", {
+  linter <- scalar_in_linter()
+
+  expect_lint(
+    trim_some('{
+      x %in% 1
+      y %chin% "a"
+    }'),
+    list("%in%", "%chin%"),
+    linter
+  )
+})