New redundant_ifelse_linter (#1000)

* New redundant_ifelse_litner

* linting 1/0 is optional (on by default)

* roxygenize

* document parameter

Co-authored-by: AshesITR <alexander.rosenstock@web.de>

Author: MichaelChirico

DESCRIPTION

@@ -114,6 +114,7 @@ Collate:
     'path_linters.R'
     'pipe_call_linter.R'
     'pipe_continuation_linter.R'
+    'redundant_ifelse_linter.R'
     'regex_subset_linter.R'
     'semicolon_terminator_linter.R'
     'seq_linter.R'

NAMESPACE

@@ -78,6 +78,7 @@ export(paren_brace_linter)
 export(paste_sep_linter)
 export(pipe_call_linter)
 export(pipe_continuation_linter)
+export(redundant_ifelse_linter)
 export(regex_subset_linter)
 export(semicolon_terminator_linter)
 export(seq_linter)

NEWS.md

@@ -116,6 +116,7 @@ function calls. (#850, #851, @renkun-ken)
    * `literal_coercion_linter()` Require using correctly-typed literals instead of direct coercion, e.g. `1L` instead of `as.numeric(1)`
    * `paste_sep_linter()` Require usage of `paste0()` over `paste(sep = "")`
    * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar
+   * `redundant_ifelse_linter()` Prevent usage like `ifelse(A & B, TRUE, FALSE)` or `ifelse(C, 0, 1)` (the latter is `as.numeric(!C)`)
    * `else_same_line_linter()` Require `else` to come on the same line as the preceding `}`, if present
    * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached
    * `regex_subset_linter()` Require usage of `grep(ptn, x, value = TRUE)` over `x[grep(ptn, x)]` and similar

R/redundant_ifelse_linter.R

@@ -0,0 +1,76 @@
+#' Prevent ifelse() from being used to produce TRUE/FALSE or 1/0
+#'
+#' Expressions like `ifelse(x, TRUE, FALSE)` and `ifelse(x, FALSE, TRUE)` are
+#'   redundant; just `x` or `!x` suffice in R code where logical vectors are a
+#'   core data structure. `ifelse(x, 1, 0)` is also `as.numeric(x)`, but even
+#'   this should only be needed rarely.
+#'
+#' @evalRd rd_tags("redundant_ifelse_linter")
+#' @param allow10 Logical, default `FALSE`. If `TRUE`, usage like
+#'   `ifelse(x, 1, 0)` is allowed, i.e., only usage like
+#'   `ifelse(x, TRUE, FALSE)` is linted.
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+redundant_ifelse_linter <- function(allow10 = FALSE) {
+  Linter(function(source_file) {
+    if (length(source_file$xml_parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    tf_xpath <- glue::glue("//expr[
+      expr[SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]
+      and expr[NUM_CONST[text() = 'TRUE']]
+      and expr[NUM_CONST[text() = 'FALSE']]
+    ]")
+    tf_expr <- xml2::xml_find_all(xml, tf_xpath)
+    tf_lints <- lapply(
+      tf_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      lint_message = function(expr) {
+        matched_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL"))
+        # [1] call; [2] logical condiditon
+        first_arg <- xml2::xml_text(xml2::xml_find_first(expr, "expr[3]/NUM_CONST"))
+        second_arg <- xml2::xml_text(xml2::xml_find_first(expr, "expr[4]/NUM_CONST"))
+        sprintf(
+          "Just use the logical condition (or its negation) directly instead of calling %s(x, %s, %s)",
+          matched_call, first_arg, second_arg
+        )
+      },
+      type = "warning"
+    )
+
+    if (allow10) {
+      num_lints <- NULL
+    } else {
+      num_xpath <- glue::glue("//expr[
+        expr[SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]
+        and expr[NUM_CONST[text() = '1' or text() = '1L']]
+        and expr[NUM_CONST[text() = '0' or text() = '0L']]
+      ]")
+      num_expr <- xml2::xml_find_all(xml, num_xpath)
+      num_lints <- lapply(
+        num_expr,
+        xml_nodes_to_lint,
+        source_file = source_file,
+        lint_message = function(expr) {
+          matched_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL"))
+          # [1] call; [2] logical condiditon
+          first_arg <- xml2::xml_text(xml2::xml_find_first(expr, "expr[3]/NUM_CONST"))
+          second_arg <- xml2::xml_text(xml2::xml_find_first(expr, "expr[4]/NUM_CONST"))
+          replacement <- if (any(c(first_arg, second_arg) %in% c("0", "1"))) "as.numeric" else "as.integer"
+          message <- sprintf(
+            "Prefer %s(x) to %s(x, %s, %s) if really needed,",
+            replacement, matched_call, first_arg, second_arg
+          )
+          paste(message, "but do note that R will usually convert logical vectors to 0/1 on the fly when needed.")
+        },
+        type = "warning"
+      )
+    }
+
+    return(c(tf_lints, num_lints))
+  })
+}

inst/lintr/linters.csv

@@ -51,6 +51,7 @@ paren_brace_linter,style readability default
 paste_sep_linter,best_practices consistency
 pipe_call_linter,style readability
 pipe_continuation_linter,style readability default
+redundant_ifelse_linter,best_practices efficiency consistency
 regex_subset_linter,best_practices efficiency
 semicolon_terminator_linter,style readability default configurable
 seq_linter,robustness efficiency consistency best_practices default

man/best_practices_linters.Rd

@@ -0,0 +1,93 @@
+test_that("redundant_ifelse_linter skips allowed usages", {
+  expect_lint("ifelse(x > 5, 0, 2)", NULL, redundant_ifelse_linter())
+  expect_lint("ifelse(x > 5, TRUE, NA)", NULL, redundant_ifelse_linter())
+  expect_lint("ifelse(x > 5, FALSE, NA)", NULL, redundant_ifelse_linter())
+  expect_lint("ifelse(x > 5, TRUE, TRUE)", NULL, redundant_ifelse_linter())
+
+  expect_lint("ifelse(x > 5, 0L, 2L)", NULL, redundant_ifelse_linter())
+  expect_lint("ifelse(x > 5, 0L, 10L)", NULL, redundant_ifelse_linter())
+})
+
+test_that("redundant_ifelse_linter blocks simple disallowed usages", {
+  expect_lint(
+    "ifelse(x > 5, TRUE, FALSE)",
+    rex::rex("Just use the logical condition (or its negation) directly"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "ifelse(x > 5, FALSE, TRUE)",
+    rex::rex("Just use the logical condition (or its negation) directly"),
+    redundant_ifelse_linter()
+  )
+
+  # other ifelse equivalents from common packages
+  expect_lint(
+    "if_else(x > 5, TRUE, FALSE)",
+    rex::rex("Just use the logical condition (or its negation) directly"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "fifelse(x > 5, FALSE, TRUE)",
+    rex::rex("Just use the logical condition (or its negation) directly"),
+    redundant_ifelse_linter()
+  )
+})
+
+test_that("redundant_ifelse_linter blocks usages equivalent to as.numeric, optionally", {
+  expect_lint(
+    "ifelse(x > 5, 1L, 0L)",
+    rex::rex("Prefer as.integer(x) to ifelse(x, 1L, 0L)"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "ifelse(x > 5, 0L, 1L)",
+    rex::rex("Prefer as.integer(x) to ifelse(x, 0L, 1L)"),
+    redundant_ifelse_linter()
+  )
+
+  expect_lint(
+    "ifelse(x > 5, 1, 0)",
+    rex::rex("Prefer as.numeric(x) to ifelse(x, 1, 0)"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "ifelse(x > 5, 0, 1)",
+    rex::rex("Prefer as.numeric(x) to ifelse(x, 0, 1)"),
+    redundant_ifelse_linter()
+  )
+
+  # data.table/dplyr equivalents
+  expect_lint(
+    "dplyr::if_else(x > 5, 1L, 0L)",
+    rex::rex("Prefer as.integer(x) to if_else(x, 1L, 0L)"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "data.table::fifelse(x > 5, 0L, 1L)",
+    rex::rex("Prefer as.integer(x) to fifelse(x, 0L, 1L)"),
+    redundant_ifelse_linter()
+  )
+
+  expect_lint(
+    "if_else(x > 5, 1, 0)",
+    rex::rex("Prefer as.numeric(x) to if_else(x, 1, 0)"),
+    redundant_ifelse_linter()
+  )
+  expect_lint(
+    "fifelse(x > 5, 0, 1)",
+    rex::rex("Prefer as.numeric(x) to fifelse(x, 0, 1)"),
+    redundant_ifelse_linter()
+  )
+
+  expect_lint("ifelse(x > 5, 1L, 0L)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+  expect_lint("ifelse(x > 5, 0L, 1L)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+
+  expect_lint("ifelse(x > 5, 1, 0)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+  expect_lint("ifelse(x > 5, 0, 1)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+
+  expect_lint("dplyr::if_else(x > 5, 1L, 0L)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+  expect_lint("data.table::fifelse(x > 5, 0L, 1L)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+
+  expect_lint("if_else(x > 5, 1, 0)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+  expect_lint("fifelse(x > 5, 0, 1)", NULL, redundant_ifelse_linter(allow10 = TRUE))
+})