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
|
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----setup--------------------------------------------------------------------
library(tidyselect)
library(magrittr)
## ---- include = FALSE---------------------------------------------------------
# For better printing
mtcars <- tibble::as_tibble(mtcars)
iris <- tibble::as_tibble(iris)
options(
tibble.print_min = 4,
tibble.print_max = 4
)
## ---- eval = FALSE------------------------------------------------------------
# mtcars %>% dplyr::select(mpg, cyl)
## ---- eval = FALSE------------------------------------------------------------
# mtcars %>% pivot_longer(c(mpg, cyl))
# mtcars %>% pivot_longer(mpg | cyl)
## ---- eval = FALSE------------------------------------------------------------
# # Passing dots
# toupper_dots <- function(data, ...) {
# sel <- dplyr::select(data, ...)
# rlang::set_names(sel, toupper)
# }
# # Interpolating a named argument with {{ }}
# toupper_arg <- function(data, arg) {
# sel <- dplyr::select(data, {{ arg }})
# rlang::set_names(sel, toupper)
# }
#
# mtcars %>% toupper_dots(mpg:disp, vs)
# #> # A tibble: 32 x 4
# #> MPG CYL DISP VS
# #> <dbl> <dbl> <dbl> <dbl>
# #> 1 21 6 160 0
# #> 2 21 6 160 0
# #> 3 22.8 4 108 1
# #> 4 21.4 6 258 1
# #> # … with 28 more rows
#
# mtcars %>% toupper_arg(c(mpg:disp, vs))
# #> # A tibble: 32 x 4
# #> MPG CYL DISP VS
# #> <dbl> <dbl> <dbl> <dbl>
# #> 1 21 6 160 0
# #> 2 21 6 160 0
# #> 3 22.8 4 108 1
# #> 4 21.4 6 258 1
# #> # … with 28 more rows
## -----------------------------------------------------------------------------
own <- rlang::expr(1 + 2)
own
## -----------------------------------------------------------------------------
fn <- function(arg) {
expr <- rlang::enquo(arg)
expr
}
user <- fn(1 + 2)
user
## -----------------------------------------------------------------------------
rlang::eval_tidy(own)
rlang::eval_tidy(user)
## -----------------------------------------------------------------------------
with_data <- function(data, x) {
expr <- rlang::enquo(x)
rlang::eval_tidy(expr, data = data)
}
## ---- error = TRUE------------------------------------------------------------
NULL %>% with_data(mean(cyl) * 10)
mtcars %>% with_data(mean(cyl) * 10)
## -----------------------------------------------------------------------------
eval_select(rlang::expr(mpg), mtcars)
eval_select(rlang::expr(c(mpg:disp, vs)), mtcars)
## -----------------------------------------------------------------------------
eval_select(rlang::expr(c(foo = mpg, bar = disp)), mtcars)
eval_rename(rlang::expr(c(foo = mpg, bar = disp)), mtcars)
## -----------------------------------------------------------------------------
select <- function(.data, ...) {
expr <- rlang::expr(c(...))
pos <- eval_select(expr, data = .data)
rlang::set_names(.data[pos], names(pos))
}
mtcars %>%
select(mpg, cyl)
## -----------------------------------------------------------------------------
select <- function(.data, cols) {
expr <- rlang::enquo(cols)
pos <- eval_select(expr, data = .data)
rlang::set_names(.data[pos], names(pos))
}
mtcars %>%
select(c(mpg, cyl))
## -----------------------------------------------------------------------------
eval_select(rlang::expr(c(foo = mpg)), mtcars)
eval_rename(rlang::expr(c(foo = mpg)), mtcars)
## ---- error = TRUE------------------------------------------------------------
eval_rename(rlang::expr(mpg), mtcars)
eval_rename(rlang::expr(c(mpg)), mtcars)
eval_rename(rlang::expr(c(foo = mpg)), mtcars)
## -----------------------------------------------------------------------------
wrapper <- function(data, ...) {
eval_rename(rlang::expr(c(...)), data)
}
mtcars %>% wrapper(foo = mpg, bar = hp:wt)
## -----------------------------------------------------------------------------
rename <- function(.data, ...) {
pos <- eval_rename(rlang::expr(c(...)), .data)
names(.data)[pos] <- names(pos)
.data
}
mtcars %>%
rename(foo = mpg, bar = hp:wt)
## -----------------------------------------------------------------------------
x <- rlang::expr(print(peek_vars()))
invisible(eval_select(x, data = mtcars))
## -----------------------------------------------------------------------------
my_selector <- function(prefix, suffix) {
intersect(
starts_with(prefix),
ends_with(suffix)
)
}
iris %>% select(my_selector("Sepal", "Length"))
## -----------------------------------------------------------------------------
if_width <- function(n, vars = peek_vars(fn = "if_width")) {
vars[nchar(vars) == n]
}
mtcars %>% select(if_width(2))
## ---- error = TRUE------------------------------------------------------------
mtcars[if_width(2)]
## -----------------------------------------------------------------------------
if_width(2, vars = names(mtcars))
## -----------------------------------------------------------------------------
dups <- vctrs::new_data_frame(list(foo = 1, quux = 2, foo = 3))
dups %>% select(if_width(3))
## -----------------------------------------------------------------------------
if_width <- function(n, vars = peek_vars(fn = "if_width")) {
which(nchar(vars) == n)
}
## ---- error = TRUE------------------------------------------------------------
dups %>% select(if_width(3))
## -----------------------------------------------------------------------------
as.list(dups) %>% select(if_width(3))
|
