Skip to content

Commit 1f39e13

Browse files
committed
Unwrap constants from quosures in aes objects
1 parent 1270bcf commit 1f39e13

File tree

4 files changed

+51
-34
lines changed

4 files changed

+51
-34
lines changed

R/aes.r

Lines changed: 28 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -61,12 +61,30 @@ aes <- function(x, y, ...) {
6161
exprs <- rlang::enquos(x = x, y = y, ...)
6262
is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1))
6363

64-
aes <- new_aes(exprs[!is_missing])
64+
aes <- new_aes(exprs[!is_missing], env = parent.frame())
6565
rename_aes(aes)
6666
}
6767

68-
new_aes <- function(x) {
68+
# Wrap symbolic objects in quosures but pull out constants out of
69+
# quosures for backward-compatibility
70+
new_aesthetic <- function(x, env = globalenv()) {
71+
if (rlang::is_quosure(x)) {
72+
if (!rlang::quo_is_symbolic(x)) {
73+
x <- rlang::quo_get_expr(x)
74+
}
75+
return(x)
76+
}
77+
78+
if (rlang::is_symbolic(x)) {
79+
x <- rlang::new_quosure(x, env = env)
80+
return(x)
81+
}
82+
83+
x
84+
}
85+
new_aes <- function(x, env = globalenv()) {
6986
stopifnot(is.list(x))
87+
x <- lapply(x, new_aesthetic, env = env)
7088
structure(x, class = "uneval")
7189
}
7290

@@ -94,21 +112,15 @@ print.uneval <- function(x, ...) {
94112
# If necessary coerce replacements to quosures for compatibility
95113
#' @export
96114
"[[<-.uneval" <- function(x, i, value) {
97-
x <- unclass(x)
98-
x[[i]] <- ensure_quosure(value)
99-
new_aes(x)
115+
new_aes(NextMethod())
100116
}
101117
#' @export
102118
"$<-.uneval" <- function(x, i, value) {
103-
i <- rlang::as_string(i)
104-
x[[i]] <- value
105-
x
119+
new_aes(NextMethod())
106120
}
107121
#' @export
108122
"[<-.uneval" <- function(x, i, value) {
109-
x <- unclass(x)
110-
x[i] <- lapply(value, ensure_quosure)
111-
new_aes(x)
123+
new_aes(NextMethod())
112124
}
113125

114126
# Rename American or old-style aesthetics name
@@ -184,7 +196,7 @@ aes_ <- function(x, y, ...) {
184196
if (is.formula(x) && length(x) == 2) {
185197
rlang::as_quosure(x)
186198
} else if (is.call(x) || is.name(x) || is.atomic(x)) {
187-
rlang::new_quosure(x, caller_env)
199+
new_aesthetic(x, caller_env)
188200
} else {
189201
stop("Aesthetic must be a one-sided formula, call, name, or constant.",
190202
call. = FALSE)
@@ -202,14 +214,13 @@ aes_string <- function(x, y, ...) {
202214
if (!missing(y)) mapping["y"] <- list(y)
203215

204216
caller_env <- parent.frame()
205-
206217
mapping <- lapply(mapping, function(x) {
207218
if (is.character(x)) {
208-
rlang::parse_quo(x, env = caller_env)
209-
} else {
210-
rlang::new_quosure(x, env = caller_env)
219+
x <- rlang::parse_expr(x)
211220
}
221+
new_aesthetic(x, env = caller_env)
212222
})
223+
213224
structure(rename_aes(mapping), class = "uneval")
214225
}
215226

@@ -274,6 +285,6 @@ mapped_aesthetics <- function(x) {
274285
return(NULL)
275286
}
276287

277-
is_null <- vapply(x, rlang::quo_is_null, logical(1))
288+
is_null <- vapply(x, is.null, logical(1))
278289
names(x)[!is_null]
279290
}

R/layer.r

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ validate_mapping <- function(mapping) {
163163
}
164164

165165
# For backward compatibility with pre-tidy-eval layers
166-
new_aes(lapply(mapping, ensure_quosure))
166+
new_aes(mapping)
167167
}
168168

169169
Layer <- ggproto("Layer", NULL,

R/utilities.r

Lines changed: 0 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -397,14 +397,3 @@ with_seed_null <- function(seed, code) {
397397
# Needed to trigger package loading
398398
#' @importFrom tibble tibble
399399
NULL
400-
401-
ensure_quosure <- function(x, env = baseenv()) {
402-
if (rlang::is_quosure(x)) {
403-
return(x)
404-
}
405-
406-
if (!rlang::is_symbolic(x)) {
407-
env <- emptyenv()
408-
}
409-
rlang::new_quosure(x, env)
410-
}

tests/testthat/test-aes.r

Lines changed: 22 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ test_that("aes_string() doesn't parse non-strings", {
2020
old <- options(OutDec = ",")
2121
on.exit(options(old))
2222

23-
expect_identical(aes_string(0.4)$x, rlang::new_quosure(0.4))
23+
expect_identical(aes_string(0.4)$x, 0.4)
2424
})
2525

2626
test_that("aes_q() & aes_string() preserves explicit NULLs", {
@@ -59,16 +59,33 @@ test_that("aes evaluated in environment where plot created", {
5959
expect_equal(layer_data(f())$x, 10)
6060
})
6161

62-
test_that("assignment methods create quosures", {
62+
test_that("constants are not wrapped in quosures", {
63+
aes <- aes(1L, "foo", 1.5)
64+
expect_identical(unclass(aes), list(x = 1L, y = "foo", 1.5))
65+
})
66+
67+
test_that("assignment methods wrap symbolic objects in quosures", {
6368
mapping <- aes(a, b, c = c)
6469
mapping[1] <- list(quote(foo))
65-
expect_identical(mapping[[1]], rlang::new_quosure(quote(foo), baseenv()))
70+
expect_identical(mapping[[1]], rlang::new_quosure(quote(foo), globalenv()))
6671

6772
mapping[[2]] <- quote(bar)
68-
expect_identical(mapping[[2]], rlang::new_quosure(quote(bar), baseenv()))
73+
expect_identical(mapping[[2]], rlang::new_quosure(quote(bar), globalenv()))
6974

7075
mapping$c <- quote(baz)
71-
expect_identical(mapping[[3]], rlang::new_quosure(quote(baz), baseenv()))
76+
expect_identical(mapping[[3]], rlang::new_quosure(quote(baz), globalenv()))
77+
})
78+
79+
test_that("assignment methods pull unwrap constants from quosures", {
80+
mapping <- aes(a, b, c = c)
81+
mapping[1] <- list(rlang::quo("foo"))
82+
expect_identical(mapping[[1]], "foo")
83+
84+
mapping[[2]] <- rlang::quo("bar")
85+
expect_identical(mapping[[2]], "bar")
86+
87+
mapping$c <- rlang::quo("baz")
88+
expect_identical(mapping[[3]], "baz")
7289
})
7390

7491

0 commit comments

Comments
 (0)