Speed up backport_linter()

NEWS.md

@@ -28,6 +28,7 @@
   + to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico).
 * `return_linter()` also has an argument `return_style` (`"implicit"` by default) which checks that all functions confirm to the specified return style of `"implicit"` or `"explicit"` (part of #884, @MichaelChirico, @AshesITR and @MEO265).
 * `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`.
+* `backport_linter()` is slightly faster by moving expensive computations outside the linting function (#2339, #2348, @AshesITR and @MichaelChirico).
 * `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR).
 
 ### New linters

R/backport_linter.R

@@ -42,6 +42,8 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
 
   backport_blacklist <- backports[r_version < R_system_version(names(backports))]
   backport_blacklist <- lapply(backport_blacklist, setdiff, except)
+  backport_index <- rep(names(backport_blacklist), times = lengths(backport_blacklist))
+  names(backport_index) <- unlist(backport_blacklist)
 
   names_xpath <- "//SYMBOL | //SYMBOL_FUNCTION_CALL"
 
@@ -52,26 +54,20 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
     all_names_nodes <- xml_find_all(xml, names_xpath)
     all_names <- xml_text(all_names_nodes)
 
-    # not sapply/vapply, which may over-simplify to vector
-    # rbind makes sure we have a matrix with dimensions [n_versions x n_names]
-    # so that colSums() works to tell us which names are in an unavailable version
-    # rbind not cbind because R is column-major --> which() below will be in column order
-    needs_backport <- do.call(rbind, lapply(backport_blacklist, function(nm) all_names %in% nm))
-    bad_idx <- colSums(needs_backport) > 0L
+    bad_versions <- unname(backport_index[all_names])
+    needs_backport <- !is.na(bad_versions)
 
-    # which(arr.ind) returns things in the same order as which()
-    needs_backport_version_idx <- ((which(needs_backport) - 1L) %% length(backport_blacklist)) + 1L
     lint_message <- sprintf(
       paste(
         "%s (R %s) is not available for dependency R >= %s.",
         "Use the `except` argument of `backport_linter()` to configure available backports."
       ),
-      all_names[bad_idx],
-      names(backport_blacklist)[needs_backport_version_idx],
+      all_names[needs_backport],
+      bad_versions[needs_backport],
       r_version
     )
     xml_nodes_to_lints(
-      all_names_nodes[bad_idx],
+      all_names_nodes[needs_backport],
       source_expression = source_expression,
       lint_message = lint_message,
       type = "warning"