Consolidate suboptimal usages of which() under one linter

DESCRIPTION

@@ -197,7 +197,7 @@ Collate:
     'unused_import_linter.R'
     'use_lintr.R'
     'vector_logic_linter.R'
-    'which_grepl_linter.R'
+    'which_linter.R'
     'whitespace_linter.R'
     'with.R'
     'with_id.R'

NAMESPACE

@@ -159,7 +159,7 @@ export(unreachable_code_linter)
 export(unused_import_linter)
 export(use_lintr)
 export(vector_logic_linter)
-export(which_grepl_linter)
+export(which_linter)
 export(whitespace_linter)
 export(with_defaults)
 export(with_id)

NEWS.md

@@ -72,7 +72,7 @@
 * `nzchar_linter()` for encouraging `nzchar()` to test for empty strings, e.g. `nchar(x) > 0` can be `nzchar(x)` (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.
 * `rep_len_linter()` for encouraging use of `rep_len()` directly instead of `rep(x, length.out = n)` (part of #884, @MichaelChirico).
-* `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico).
+* `which_linter()` for discouraging `which(min(x))`, `which(max(x))`, and `which(grepl(ptn, x))` in favor of directly using `which.max(x)`, `which.min(x)`, and `grep(ptn, x)`, resp. (part of #884, @MichaelChirico, @IndrajeetPatil).
 * `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).
 * `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (#2317, #2334 and part of #884, @MichaelChirico).

R/which_linter.R

@@ -0,0 +1,99 @@
+#' Find suboptimal usages involving `which()`
+#'
+#' @description
+#'
+#' - `which.min(x)` and `which.max(x)` are optimized functions that directly return
+#' the index of the minimum or maximum value in a vector. They are more
+#' efficient and cleaner than using `which(min(x))` or `which(max(x))`.
+#'
+#' - `which(grepl(pattern, x))` is the same as `grep(pattern, x)`, but harder
+#' to read and requires two passes over the vector.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "which(x == max(x))",
+#'   linters = which_linter()
+#' )
+#'
+#' lint(
+#'   text = "which(x == min(x))",
+#'   linters = which_linter()
+#' )
+#'
+#' lint(
+#'   text = "which(grepl('^a', x))",
+#'   linters = which_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "which.max(x))",
+#'   linters = which_linter()
+#' )
+#'
+#' lint(
+#'   text = "which.min(x))",
+#'   linters = which_linter()
+#' )
+#'
+#' lint(
+#'   text = "which(grepl('^a', x) | grepl('^b', x))",
+#'   linters = which_linter()
+#' )
+#'
+#' @evalRd rd_tags("which_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+which_linter <- function() {
+  which_function_xpath <- function(func_name) {
+    glue("
+    //expr[
+      expr[SYMBOL_FUNCTION_CALL[text()='which']]
+      and expr/expr[
+        expr[SYMBOL_FUNCTION_CALL[text()='{func_name}']]
+      ]
+    ]
+  ")
+  }
+
+  which_min_xpath <- which_function_xpath("min")
+  which_max_xpath <- which_function_xpath("max")
+  which_grepl_xpath <- glue("
+    //expr[
+      expr[SYMBOL_FUNCTION_CALL[text()='which']]
+      and
+      expr/expr[SYMBOL_FUNCTION_CALL[text()='grepl']]
+    ]
+  ")
+
+  Linter(linter_level = "expression", function(source_expression) {
+    xml <- source_expression$xml_parsed_content
+
+    which_min_expr <- xml_find_all(xml, which_min_xpath)
+    which_min_lints <- xml_nodes_to_lints(
+      which_min_expr,
+      source_expression = source_expression,
+      lint_message = "which.min(x) is more efficient than which(x == min(x)).",
+      type = "warning"
+    )
+
+    which_max_expr <- xml_find_all(xml, which_max_xpath)
+    which_max_lints <- xml_nodes_to_lints(
+      which_max_expr,
+      source_expression = source_expression,
+      lint_message = "which.max(x) is more efficient than which(x == max(x)).",
+      type = "warning"
+    )
+
+    which_grepl_expr <- xml_find_all(xml, which_grepl_xpath)
+    which_grepl_lints <- xml_nodes_to_lints(
+      which_grepl_expr,
+      source_expression = source_expression,
+      lint_message = "grep(pattern, x) is better than which(grepl(pattern, x)).",
+      type = "warning"
+    )
+
+    c(which_min_lints, which_max_lints, which_grepl_lints)
+  })
+}

inst/lintr/linters.csv

@@ -119,6 +119,6 @@ unneeded_concatenation_linter,style readability efficiency configurable deprecat
 unreachable_code_linter,best_practices readability configurable
 unused_import_linter,best_practices common_mistakes configurable executing
 vector_logic_linter,default efficiency best_practices common_mistakes
-which_grepl_linter,readability efficiency consistency regex
+which_linter,readability efficiency consistency regex
 whitespace_linter,style consistency default
 yoda_test_linter,package_development best_practices readability pkg_testthat