/
unnecessary_lambda_linter.R
217 lines (205 loc) · 7.95 KB
/
unnecessary_lambda_linter.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
#' Block usage of anonymous functions in iteration functions when unnecessary
#'
#' Using an anonymous function in, e.g., [lapply()] is not always necessary,
#' e.g. `lapply(DF, sum)` is the same as `lapply(DF, function(x) sum(x))` and
#' the former is more readable.
#'
#' Cases like `lapply(x, \(xi) grep("ptn", xi))` are excluded because, though
#' the anonymous function _can_ be avoided, doing so is not always more
#' readable.
#'
#' @param allow_comparison Logical, default `FALSE`. If `TRUE`, lambdas like
#' `function(x) foo(x) == 2`, where `foo` can be extracted to the "mapping"
#' function and `==` vectorized instead of called repeatedly, are linted.
#'
#' @examples
#' # will produce lints
#' lint(
#' text = "lapply(list(1:3, 2:4), function(xi) sum(xi))",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) xi == 2)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(xi) > 0)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' # okay
#' lint(
#' text = "lapply(list(1:3, 2:4), sum)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = 'lapply(x, function(xi) grep("ptn", xi))',
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "lapply(x, function(xi) data.frame(col = xi))",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) xi == 2)",
#' linters = unnecessary_lambda_linter(allow_comparison = TRUE)
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(xi) > 0)",
#' linters = unnecessary_lambda_linter(allow_comparison = TRUE)
#' )
#'
#' lint(
#' text = "sapply(x, function(xi) sum(abs(xi)) > 10)",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' lint(
#' text = "sapply(x, sum) > 0",
#' linters = unnecessary_lambda_linter()
#' )
#'
#' @evalRd rd_tags("unnecessary_lambda_linter")
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
unnecessary_lambda_linter <- function(allow_comparison = FALSE) {
# include any base function like those where FUN is an argument
# and ... follows positionally directly afterwards (with ...
# being passed on to FUN). That excludes functions like
# Filter/Reduce (which don't accept ...), as well as functions
# like sweep() (where check.margin comes between FUN and ...,
# and thus would need to be supplied in order to replicate
# positional arguments). Technically, these latter could
# be part of the linter logic (e.g., detect if the anonymous
# call is using positional or keyword arguments -- we can
# throw a lint for sweep() lambdas where the following arguments
# are all named) but for now it seems like overkill.
apply_funs <- c(
"lapply", "sapply", "vapply", "apply",
"tapply", "rapply", "eapply", "dendrapply",
"mapply", "by", "outer",
"mclapply", "mcmapply", "parApply", "parCapply", "parLapply",
"parLapplyLB", "parRapply", "parSapply", "parSapplyLB", "pvec",
purrr_mappers
)
# OP-PLUS: condition for complex literal, e.g. 0+2i.
# NB: this includes 0+3 and TRUE+FALSE, which are also fine.
inner_comparison_xpath <- glue("
parent::expr
/parent::expr
/expr[FUNCTION]
/expr[
({ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) })
and expr[
expr/SYMBOL_FUNCTION_CALL
and expr/SYMBOL
]
and expr[
NUM_CONST
or STR_CONST
or (OP-PLUS and count(expr/NUM_CONST) = 2)
]
]
")
# outline:
# 1. match one of the identified mappers
# 2. match an anonymous function that can be "symbol-ized"
# a. it's a one-variable function [TODO(#2477): relax this]
# b. the function is a single call
# c. that call's _first_ argument is just the function argument (a SYMBOL)
# - and it has to be passed positionally (not as a keyword)
# d. the function argument doesn't appear elsewhere in the call
default_fun_xpath <- glue("
parent::expr
/following-sibling::expr[(FUNCTION or OP-LAMBDA) and count(SYMBOL_FORMALS) = 1]
/expr[last()][
count(.//SYMBOL[self::* = preceding::SYMBOL_FORMALS[1]]) = 1
and count(.//SYMBOL_FUNCTION_CALL[text() != 'return']) = 1
and preceding-sibling::SYMBOL_FORMALS =
.//expr[
position() = 2
and preceding-sibling::expr/SYMBOL_FUNCTION_CALL
and not(preceding-sibling::*[1][self::EQ_SUB])
and not(parent::expr[
preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)]
or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)]
])
]/SYMBOL
]
/parent::expr
")
# purrr-style inline formulas-as-functions, e.g. ~foo(.x)
# logic is basically the same as that above, except we need
# 1. a formula (OP-TILDE)
# 2. the lone argument marker `.x` or `.`
purrr_symbol <- "SYMBOL[text() = '.x' or text() = '.']"
purrr_fun_xpath <- glue("
parent::expr
/following-sibling::expr[
OP-TILDE
and expr[OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[2][self::SYMBOL_SUB])]/{purrr_symbol}]
and not(expr/OP-LEFT-PAREN/following-sibling::expr[position() > 1]//{purrr_symbol})
]
")
# path to calling function symbol from the matched expressions
fun_xpath <- "./parent::expr/expr/SYMBOL_FUNCTION_CALL"
# path to the symbol of the simpler function that avoids a lambda
symbol_xpath <- "expr[last()]//expr[SYMBOL_FUNCTION_CALL[text() != 'return']]"
Linter(linter_level = "expression", function(source_expression) {
default_calls <- source_expression$xml_find_function_calls(apply_funs)
default_fun_expr <- xml_find_all(default_calls, default_fun_xpath)
# TODO(#2478): Give a specific recommendation in the message.
default_call_fun <- xml_text(xml_find_first(default_fun_expr, fun_xpath))
default_symbol <- xml_text(xml_find_first(default_fun_expr, symbol_xpath))
default_fun_lints <- xml_nodes_to_lints(
default_fun_expr,
source_expression = source_expression,
lint_message = paste0(
"Pass ", default_symbol, " directly as a symbol to ", default_call_fun, "() ",
"instead of wrapping it in an unnecessary anonymous function. ",
"For example, prefer lapply(DF, sum) to lapply(DF, function(x) sum(x))."
),
type = "warning"
)
inner_comparison_lints <- NULL
if (!allow_comparison) {
sapply_vapply_calls <- source_expression$xml_find_function_calls(c("sapply", "vapply"))
inner_comparison_expr <- xml_find_all(sapply_vapply_calls, inner_comparison_xpath)
mapper <- xp_call_name(xml_find_first(inner_comparison_expr, "parent::expr/parent::expr"))
if (length(mapper) > 0L) fun_value <- if (mapper == "sapply") "" else ", FUN.VALUE = <intermediate>"
inner_comparison_lints <- xml_nodes_to_lints(
inner_comparison_expr,
source_expression = source_expression,
lint_message = sprintf(
paste(
"Compare to a constant after calling %1$s() to get the full benefits of vectorization.",
"Prefer %1$s(x, foo%2$s) == 2 over %1$s(x, function(xi) foo(xi) == 2, logical(1L))."
),
mapper, fun_value
),
type = "warning"
)
}
purrr_calls <- source_expression$xml_find_function_calls(purrr_mappers)
purrr_fun_expr <- xml_find_all(purrr_calls, purrr_fun_xpath)
purrr_call_fun <- xml_text(xml_find_first(purrr_fun_expr, fun_xpath))
purrr_symbol <- xml_text(xml_find_first(purrr_fun_expr, symbol_xpath))
purrr_fun_lints <- xml_nodes_to_lints(
purrr_fun_expr,
source_expression = source_expression,
lint_message = paste0(
"Pass ", purrr_symbol, " directly as a symbol to ", purrr_call_fun, "() ",
"instead of wrapping it in an unnecessary anonymous function. ",
"For example, prefer purrr::map(DF, sum) to purrr::map(DF, ~sum(.x))."
),
type = "warning"
)
c(default_fun_lints, inner_comparison_lints, purrr_fun_lints)
})
}