Lint identical(x, sort(x)) in sort_linter()

NEWS.md

@@ -49,6 +49,7 @@
 * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico).
 * `sprintf_linter()` lints `sprintf()` and `gettextf()` calls when a constant string is passed to `fmt` (#2894, @Bisaloo).
 * `use_lintr()` adds the created `.lintr` file to the `.Rbuildignore` if run in a package (#2926, initial work by @MEO265, finalized by @Bisaloo).
+* `sort_linter()` recommends usage of `!is.unsorted(x)` over `identical(x, sort(x))` (#2921, @Bisaloo).
 * `length_test_linter()` is extended to check incorrect usage of `nrow()`, `ncol()`, `NROW()`, `NCOL()` (#2933, @mcol).
 * `implicit_assignment_linter()` gains argument `allow_paren_print` to disable lints for the use of `(` for auto-printing (#2962, @TimTaylor).
 

R/sort_linter.R

@@ -89,7 +89,13 @@ sort_linter <- function() {
       and expr/expr = expr
     ]
   "
-
+  sorted_identical_xpath <- "
+  parent::expr[not(SYMBOL_SUB)]
+    /parent::expr[
+      expr/SYMBOL_FUNCTION_CALL[text() = 'identical']
+      and expr/expr = expr
+    ]
+  "
 
   arguments_xpath <-
     ".//SYMBOL_SUB[text() = 'method' or text() = 'decreasing' or text() = 'na.last']"
@@ -142,8 +148,22 @@ sort_linter <- function() {
       "Use is.unsorted(x) to test the unsortedness of a vector."
     )
 
+    sorted_identical_expr <- xml_find_all(xml_calls, sorted_identical_xpath)
+    is_negated <- !is.na(
+      xml_find_first(sorted_identical_expr, "preceding-sibling::*[not(self::COMMENT)][1][self::OP-EXCLAMATION]")
+    )
+
+    lint_message <- c(
+      lint_message,
+      ifelse(
+        is_negated,
+        "Use is.unsorted(x) to test the unsortedness of a vector.",
+        "Use !is.unsorted(x) to test the sortedness of a vector."
+      )
+    )
+
     sorted_lints <- xml_nodes_to_lints(
-      sorted_expr,
+      combine_nodesets(sorted_expr, sorted_identical_expr),
       source_expression = source_expression,
       lint_message = lint_message,
       type = "warning"

tests/testthat/test-sort_linter.R

@@ -1,17 +1,21 @@
 test_that("sort_linter skips allowed usages", {
   linter <- sort_linter()
 
-  expect_lint("order(y)", NULL, linter)
+  expect_no_lint("order(y)", linter)
 
-  expect_lint("y[order(x)]", NULL, linter)
+  expect_no_lint("y[order(x)]", linter)
 
   # If another function is intercalated, don't fail
-  expect_lint("x[c(order(x))]", NULL, linter)
+  expect_no_lint("x[c(order(x))]", linter)
 
-  expect_lint("x[order(y, x)]", NULL, linter)
-  expect_lint("x[order(x, y)]", NULL, linter)
+  expect_no_lint("x[order(y, x)]", linter)
+  expect_no_lint("x[order(x, y)]", linter)
   # pretty sure this never makes sense, but test anyway
-  expect_lint("x[order(y, na.last = x)]", NULL, linter)
+  expect_no_lint("x[order(y, na.last = x)]", linter)
+
+  # is.unsorted false positives
+  expect_no_lint("identical(sort(x), y)", linter)
+  expect_no_lint("identical(sort(foo(x)), x)", linter)
 })
 
 
@@ -108,15 +112,20 @@ test_that("sort_linter blocks simple disallowed usages", {
   sorted_msg <- rex::rex("Use !is.unsorted(x) to test the sortedness of a vector.")
 
   expect_lint("sort(x) == x", sorted_msg, linter)
+  expect_lint("identical(x, sort(x))", sorted_msg, linter)
 
   # argument order doesn't matter
   expect_lint("x == sort(x)", sorted_msg, linter)
+  expect_lint("identical(sort(x), x)", sorted_msg, linter)
 
   # inverted version
   expect_lint("sort(x) != x", unsorted_msg, linter)
+  expect_lint("!identical(x, sort(x))", unsorted_msg, linter)
 
   # expression matching
   expect_lint("sort(foo(x)) == foo(x)", sorted_msg, linter)
+  expect_lint("identical(foo(x), sort(foo(x)))", sorted_msg, linter)
+  expect_lint("identical(sort(foo(x)), foo(x))", sorted_msg, linter)
 })
 
 test_that("lints vectorize", {