length_levels_linter() for length(levels(x)) --> nlevels(x) (#2051)

DESCRIPTION

@@ -113,6 +113,7 @@ Collate:
     'inner_combine_linter.R'
     'is_lint_level.R'
     'is_numeric_linter.R'
+    'length_levels_linter.R'
     'lengths_linter.R'
     'library_call_linter.R'
     'line_length_linter.R'

NAMESPACE

@@ -77,6 +77,7 @@ export(infix_spaces_linter)
 export(inner_combine_linter)
 export(is_lint_level)
 export(is_numeric_linter)
+export(length_levels_linter)
 export(lengths_linter)
 export(library_call_linter)
 export(line_length_linter)

NEWS.md

@@ -23,6 +23,10 @@
   + `unreachable_code_linter()`
   + `yoda_test_linter()`
 
+### New linters
+
+* `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
+
 ## Changes to defaults
 
 * `assignment_linter()` lints the {magrittr} assignment pipe `%<>%` (#2008, @MichaelChirico). This can be deactivated by setting the new argument `allow_pipe_assign` to `TRUE`.

R/length_levels_linter.R

@@ -0,0 +1,45 @@
+#' Require usage of nlevels over length(levels(.))
+#'
+#' `length(levels(x))` is the same as `nlevels(x)`, but harder to read.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "length(levels(x))",
+#'   linters = length_levels_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "length(c(levels(x), levels(y)))",
+#'   linters = length_levels_linter()
+#' )
+#'
+#' @evalRd rd_tags("length_levels_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+length_levels_linter <- function() {
+  xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'levels']
+    /parent::expr
+    /parent::expr
+    /parent::expr[expr/SYMBOL_FUNCTION_CALL[text() = 'length']]
+  "
+
+  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)
+
+    xml_nodes_to_lints(
+      bad_expr,
+      source_expression = source_expression,
+      lint_message = "nlevels(x) is better than length(levels(x)).",
+      type = "warning"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -41,6 +41,7 @@ indentation_linter,style readability default configurable
 infix_spaces_linter,style readability default configurable
 inner_combine_linter,efficiency consistency readability
 is_numeric_linter,readability best_practices consistency
+length_levels_linter,readability best_practices consistency
 lengths_linter,efficiency readability best_practices
 library_call_linter,style best_practices readability
 line_length_linter,style readability default configurable

tests/testthat/test-length_levels_linter.R

@@ -0,0 +1,11 @@
+test_that("length_levels_linter skips allowed usages", {
+  expect_lint("length(c(levels(x), 'a'))", NULL, length_levels_linter())
+})
+
+test_that("length_levels_linter blocks simple disallowed usages", {
+  expect_lint(
+    "2:length(levels(x))",
+    rex::rex("nlevels(x) is better than length(levels(x))."),
+    length_levels_linter()
+  )
+})