Add potential sequence() lints to seq_linter()

NEWS.md

@@ -32,6 +32,7 @@
 
 ## New and improved features
 
+* `seq_linter()` now includes lints to inform about missed opportunities to use the `sequence()` base R function, e.g. `unlist(lapply(ints, seq))` (#2618, @Bisaloo)
 * More helpful errors for invalid configs (#2253, @MichaelChirico).
 * `library_call_linter()` is extended
   + to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).

R/seq_linter.R

@@ -26,6 +26,11 @@
 #'   linters = seq_linter()
 #' )
 #'
+#' lint(
+#'   text = "unlist(lapply(x, seq_len))",
+#'   linters = seq_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "seq_along(x)",
@@ -42,6 +47,11 @@
 #'   linters = seq_linter()
 #' )
 #'
+#' lint(
+#'   text = "sequence(x)",
+#'   linters = seq_linter()
+#' )
+#'
 #' @evalRd rd_tags("seq_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
@@ -66,6 +76,17 @@ seq_linter <- function() {
     ]
   ")
 
+  map_funcs <- c("sapply", "lapply", "map")
+  seq_funcs <- xp_text_in_table(c("seq_len", "seq"))
+  # count(expr) = 3 because we only want seq() calls without extra arguments
+  sequence_xpath <- glue("
+    parent::expr/parent::expr[
+      count(expr) = 3
+      and expr/SYMBOL[ {seq_funcs} ]
+      and preceding-sibling::expr/SYMBOL_FUNCTION_CALL[text() = 'unlist']
+    ]
+  ")
+
   ## The actual order of the nodes is document order
   ## In practice we need to handle length(x):1
   get_fun <- function(expr, n) {
@@ -113,6 +134,17 @@ seq_linter <- function() {
       )
     )
 
-    xml_nodes_to_lints(badx, source_expression, lint_message, type = "warning")
+    seq_lints <- xml_nodes_to_lints(badx, source_expression, lint_message, type = "warning")
+
+    xml_map_calls <- source_expression$xml_find_function_calls(map_funcs)
+    potential_sequence_calls <- xml_find_all(xml_map_calls, sequence_xpath)
+    sequence_lints <- xml_nodes_to_lints(
+      potential_sequence_calls,
+      source_expression,
+      "Use sequence() to generate a concatenated sequence of seq_len().",
+      type = "warning"
+    )
+
+    c(seq_lints, sequence_lints)
   })
 }

tests/testthat/test-seq_linter.R

@@ -123,6 +123,40 @@ test_that("reverse seq is ok", {
   )
 })
 
+test_that("finds potential sequence() replacements", {
+  linter <- seq_linter()
+  lint_msg <- rex::rex("Use sequence()")
+
+  expect_lint(
+    "unlist(lapply(x, seq_len))",
+    lint_msg,
+    linter
+  )
+
+  expect_lint(
+    "unlist(lapply(x, seq))",
+    lint_msg,
+    linter
+  )
+
+  # Even for prefixed purrr:: calls
+  expect_lint(
+    "unlist(purrr::map(x, seq_len))",
+    lint_msg,
+    linter
+  )
+})
+
+test_that("sequence() is not recommended for complex seq() calls", {
+  linter <- seq_linter()
+
+  expect_lint(
+    "unlist(lapply(x, seq, from = 2))",
+    NULL,
+    linter
+  )
+})
+
 test_that("Message vectorization works for multiple lints", {
   linter <- seq_linter()
 
@@ -173,6 +207,18 @@ test_that("Message vectorization works for multiple lints", {
     ),
     linter
   )
+
+  expect_lint(
+    trim_some("{
+      1:NROW(x)
+      unlist(lapply(y, seq_len))
+    }"),
+    list(
+      list(rex::rex("seq_len(NROW(...))", anything, "1:NROW(...)"), line_number = 2L),
+      list(rex::rex("sequence()"), line_number = 3L)
+    ),
+    linter
+  )
 })
 
 test_that("Message recommends rev() correctly", {