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
|
#' @rdname eval_select
#' @export
eval_rename <- function(expr,
data,
env = caller_env(),
...,
strict = TRUE,
name_spec = NULL,
allow_predicates = TRUE,
error_call = caller_env()) {
check_dots_empty()
allow_predicates <- allow_predicates && tidyselect_data_has_predicates(data)
data <- tidyselect_data_proxy(data)
rename_impl(
data,
names(data),
as_quosure(expr, env),
strict = strict,
name_spec = name_spec,
allow_predicates = allow_predicates,
error_call = error_call
)
}
# Caller must put vars in scope
rename_impl <- function(x,
names,
sel,
strict = TRUE,
name_spec = NULL,
allow_predicates = TRUE,
error_call) {
if (is_null(names)) {
cli::cli_abort("Can't rename an unnamed vector.", call = error_call)
}
pos <- eval_select_impl(
x,
names,
{{ sel }},
strict = strict,
name_spec = name_spec,
type = "rename",
allow_predicates = allow_predicates,
error_call = error_call
)
# Check for unique names only if input is a data frame
if (is.data.frame(x) || is_null(x)) {
names[pos] <- names(pos)
with_subscript_errors(
vctrs::vec_as_names(
names,
repair = "check_unique",
call = error_call
)
)
}
pos
}
# Example implementation mainly used for unit tests
rename <- function(.x, ..., .strict = TRUE) {
pos <- eval_rename(expr(c(...)), .x, strict = .strict)
names(.x)[pos] <- names(pos)
.x
}
|
