3030# '
3131# ' This function also standardise aesthetic names by performing partial
3232# ' matching, converting color to colour, and translating old style R names to
33- # ' ggplot names (eg. pch to shape, cex to size)
33+ # ' ggplot names (eg. pch to shape, cex to size).
34+ # '
35+ # '
36+ # ' @section Quasiquotation:
37+ # '
38+ # ' `aes()` is a [quoting function][rlang::quotation]. This means that
39+ # ' its inputs are quoted to be evaluated in the context of the
40+ # ' data. This makes it easy to work with variables from the data frame
41+ # ' because you can name those directly. The flip side is that you have
42+ # ' to use [quasiquotation][rlang::quasiquotation] to program with
43+ # ' `aes()`. See a tidy evaluation tutorial such as the [dplyr
44+ # ' programming vignette](http://dplyr.tidyverse.org/articles/programming.html)
45+ # ' to learn more about these techniques.
3446# '
3547# ' @param x,y,... List of name value pairs giving aesthetics to map to
3648# ' variables. The names for x and y aesthetics are typically omitted because
3749# ' they are so common; all other aesthetics must be named.
38- # ' @seealso See [aes_()] for a version of `aes` that is
39- # ' more suitable for programming with.
4050# ' @export
4151# ' @examples
4252# ' aes(x = mpg, y = wt)
5767# '
5868# ' # Aesthetics supplied to ggplot() are used as defaults for every layer
5969# ' # you can override them, or supply different aesthetics for each layer
70+ # '
71+ # '
72+ # ' # aes() is a quoting function, so you need to use tidy evaluation
73+ # ' # techniques to create wrappers around ggplot2 pipelines. The
74+ # ' # simplest case occurs when your wrapper takes dots:
75+ # ' scatter_by <- function(data, ...) {
76+ # ' ggplot(data) + geom_point(aes(...))
77+ # ' }
78+ # ' scatter_by(mtcars, disp, drat)
79+ # '
80+ # ' # If your wrapper has a more specific interface with named arguments,
81+ # ' # you need to use the "enquote and unquote" technique:
82+ # ' scatter_by <- function(data, x, y) {
83+ # ' ggplot(data) + geom_point(aes(!!enquo(x), !!enquo(y)))
84+ # ' }
85+ # ' scatter_by(mtcars, disp, drat)
86+ # '
87+ # ' # Note that users of your wrapper can use their own functions in the
88+ # ' # quoted expressions and all will resolve as it should!
89+ # ' cut3 <- function(x) cut_number(x, 3)
90+ # ' scatter_by(mtcars, cut3(disp), drat)
6091aes <- function (x , y , ... ) {
61- exprs <- rlang :: enexprs (x = x , y = y , ... )
62- is_missing <- vapply(exprs , rlang :: is_missing , logical (1 ))
92+ exprs <- rlang :: enquos (x = x , y = y , ... )
93+ is_missing <- vapply(exprs , rlang :: quo_is_missing , logical (1 ))
6394
64- aes <- structure (exprs [! is_missing ], class = " uneval "
95+ aes <- new_aes (exprs [! is_missing ], env = parent.frame() )
6596 rename_aes(aes )
6697}
98+
99+ # Wrap symbolic objects in quosures but pull out constants out of
100+ # quosures for backward-compatibility
101+ new_aesthetic <- function (x , env = globalenv()) {
102+ if (rlang :: is_quosure(x )) {
103+ if (! rlang :: quo_is_symbolic(x )) {
104+ x <- rlang :: quo_get_expr(x )
105+ }
106+ return (x )
107+ }
108+
109+ if (rlang :: is_symbolic(x )) {
110+ x <- rlang :: new_quosure(x , env = env )
111+ return (x )
112+ }
113+
114+ x
115+ }
116+ new_aes <- function (x , env = globalenv()) {
117+ stopifnot(is.list(x ))
118+ x <- lapply(x , new_aesthetic , env = env )
119+ structure(x , class = " uneval"
120+ }
121+
67122# ' @export
68123print.uneval <- function (x , ... ) {
69124 cat(" Aesthetic mapping: \n "
70125
71126 if (length(x ) == 0 ) {
72127 cat(" <empty>\n "
73128 } else {
74- values <- vapply(x , deparse2 , character (1 ))
75- bullets <- paste0(" * " x )), " -> " values , " \n "
129+ values <- vapply(x , rlang :: quo_label , character (1 ))
130+ bullets <- paste0(" * ` " x )), " ` -> " values , " \n "
76131
77132 cat(bullets , sep = " "
78133 }
134+
135+ invisible (x )
79136}
80137
81138# ' @export
82- str .uneval<- function (object , ... ) utils :: str(unclass( object ) , ... )
83- # ' @export
84- " [.uneval " <- function ( x , i , ... ) structure(unclass( x )[ i ], class = " uneval " )
139+ " [ .uneval" <- function (x , i , ... ) {
140+ new_aes(NextMethod())
141+ }
85142
143+ # If necessary coerce replacements to quosures for compatibility
144+ # ' @export
145+ " [[<-.uneval" <- function (x , i , value ) {
146+ new_aes(NextMethod())
147+ }
148+ # ' @export
149+ " $<-.uneval" <- function (x , i , value ) {
150+ # Can't use NextMethod() because of a bug in R 3.1
151+ x <- unclass(x )
152+ x [[i ]] <- value
153+ new_aes(x )
154+ }
86155# ' @export
87- as.character.uneval <- function (x , ... ) {
88- char <- as.character(unclass(x ))
89- names(char ) <- names(x )
90- char
156+ " [<-.uneval" <- function (x , i , value ) {
157+ new_aes(NextMethod())
91158}
92159
93160# Rename American or old-style aesthetics name
@@ -131,6 +198,13 @@ is_position_aes <- function(vars) {
131198# ' `aes(colour = "my colour")` or \code{aes{x = `X$1`}}
132199# ' with `aes_string()` is quite clunky.
133200# '
201+ # '
202+ # ' @section Life cycle:
203+ # '
204+ # ' All these functions are soft-deprecated. Please use tidy evaluation
205+ # ' idioms instead (see the quasiquotation section in
206+ # ' [aes()] documentation).
207+ # '
134208# ' @param x,y,... List of name value pairs. Elements must be either
135209# ' quoted calls, strings, one-sided formulas or constants.
136210# ' @seealso [aes()]
@@ -157,17 +231,19 @@ aes_ <- function(x, y, ...) {
157231 if (! missing(x )) mapping [" x" <- list (x )
158232 if (! missing(y )) mapping [" y" <- list (y )
159233
160- as_call <- function (x ) {
234+ caller_env <- parent.frame()
235+
236+ as_quosure_aes <- function (x ) {
161237 if (is.formula(x ) && length(x ) == 2 ) {
162- x [[ 2 ]]
238+ rlang :: as_quosure( x )
163239 } else if (is.call(x ) || is.name(x ) || is.atomic(x )) {
164- x
240+ new_aesthetic( x , caller_env )
165241 } else {
166242 stop(" Aesthetic must be a one-sided formula, call, name, or constant."
167243 call. = FALSE )
168244 }
169245 }
170- mapping <- lapply(mapping , as_call )
246+ mapping <- lapply(mapping , as_quosure_aes )
171247 structure(rename_aes(mapping ), class = " uneval"
172248}
173249
@@ -178,13 +254,14 @@ aes_string <- function(x, y, ...) {
178254 if (! missing(x )) mapping [" x" <- list (x )
179255 if (! missing(y )) mapping [" y" <- list (y )
180256
257+ caller_env <- parent.frame()
181258 mapping <- lapply(mapping , function (x ) {
182259 if (is.character(x )) {
183- parse(text = x )[[1 ]]
184- } else {
185- x
260+ x <- rlang :: parse_expr(x )
186261 }
262+ new_aesthetic(x , env = caller_env )
187263 })
264+
188265 structure(rename_aes(mapping ), class = " uneval"
189266}
190267
@@ -204,8 +281,10 @@ aes_all <- function(vars) {
204281 names(vars ) <- vars
205282 vars <- rename_aes(vars )
206283
284+ # Quosure the symbols in the empty environment because they can only
285+ # refer to the data mask
207286 structure(
208- lapply(vars , as.name ),
287+ lapply(vars , function ( x ) rlang :: new_quosure( as.name( x ), emptyenv()) ),
209288 class = " uneval"
210289 )
211290}
@@ -243,7 +322,10 @@ aes_auto <- function(data = NULL, ...) {
243322}
244323
245324mapped_aesthetics <- function (x ) {
325+ if (is.null(x )) {
326+ return (NULL )
327+ }
328+
246329 is_null <- vapply(x , is.null , logical (1 ))
247330 names(x )[! is_null ]
248-
249331}
0 commit comments