Unwrap constants from quosures in aes objects

Author: lionel-

R/aes.r

@@ -61,12 +61,30 @@ aes <- function(x, y, ...) {
   exprs <- rlang::enquos(x = x, y = y, ...)
   is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1))
 
-  aes <- new_aes(exprs[!is_missing])
+  aes <- new_aes(exprs[!is_missing], env = parent.frame())
   rename_aes(aes)
 }
 
-new_aes <- function(x) {
+# Wrap symbolic objects in quosures but pull out constants out of
+# quosures for backward-compatibility
+new_aesthetic <- function(x, env = globalenv()) {
+  if (rlang::is_quosure(x)) {
+    if (!rlang::quo_is_symbolic(x)) {
+      x <- rlang::quo_get_expr(x)
+    }
+    return(x)
+  }
+
+  if (rlang::is_symbolic(x)) {
+    x <- rlang::new_quosure(x, env = env)
+    return(x)
+  }
+
+  x
+}
+new_aes <- function(x, env = globalenv()) {
   stopifnot(is.list(x))
+  x <- lapply(x, new_aesthetic, env = env)
   structure(x, class = "uneval")
 }
 
@@ -94,21 +112,15 @@ print.uneval <- function(x, ...) {
 # If necessary coerce replacements to quosures for compatibility
 #' @export
 "[[<-.uneval" <- function(x, i, value) {
-  x <- unclass(x)
-  x[[i]] <- ensure_quosure(value)
-  new_aes(x)
+  new_aes(NextMethod())
 }
 #' @export
 "$<-.uneval" <- function(x, i, value) {
-  i <- rlang::as_string(i)
-  x[[i]] <- value
-  x
+  new_aes(NextMethod())
 }
 #' @export
 "[<-.uneval" <- function(x, i, value) {
-  x <- unclass(x)
-  x[i] <- lapply(value, ensure_quosure)
-  new_aes(x)
+  new_aes(NextMethod())
 }
 
 # Rename American or old-style aesthetics name
@@ -184,7 +196,7 @@ aes_ <- function(x, y, ...) {
     if (is.formula(x) && length(x) == 2) {
       rlang::as_quosure(x)
     } else if (is.call(x) || is.name(x) || is.atomic(x)) {
-      rlang::new_quosure(x, caller_env)
+      new_aesthetic(x, caller_env)
     } else {
       stop("Aesthetic must be a one-sided formula, call, name, or constant.",
         call. = FALSE)
@@ -202,14 +214,13 @@ aes_string <- function(x, y, ...) {
   if (!missing(y)) mapping["y"] <- list(y)
 
   caller_env <- parent.frame()
-
   mapping <- lapply(mapping, function(x) {
     if (is.character(x)) {
-      rlang::parse_quo(x, env = caller_env)
-    } else {
-      rlang::new_quosure(x, env = caller_env)
+      x <- rlang::parse_expr(x)
     }
+    new_aesthetic(x, env = caller_env)
   })
+
   structure(rename_aes(mapping), class = "uneval")
 }
 
@@ -274,6 +285,6 @@ mapped_aesthetics <- function(x) {
     return(NULL)
   }
 
-  is_null <- vapply(x, rlang::quo_is_null, logical(1))
+  is_null <- vapply(x, is.null, logical(1))
   names(x)[!is_null]
 }

R/layer.r

@@ -163,7 +163,7 @@ validate_mapping <- function(mapping) {
   }
 
   # For backward compatibility with pre-tidy-eval layers
-  new_aes(lapply(mapping, ensure_quosure))
+  new_aes(mapping)
 }
 
 Layer <- ggproto("Layer", NULL,

R/utilities.r

@@ -397,14 +397,3 @@ with_seed_null <- function(seed, code) {
 # Needed to trigger package loading
 #' @importFrom tibble tibble
 NULL
-
-ensure_quosure <- function(x, env = baseenv()) {
-  if (rlang::is_quosure(x)) {
-    return(x)
-  }
-
-  if (!rlang::is_symbolic(x)) {
-    env <- emptyenv()
-  }
-  rlang::new_quosure(x, env)
-}

tests/testthat/test-aes.r

@@ -20,7 +20,7 @@ test_that("aes_string() doesn't parse non-strings", {
   old <- options(OutDec = ",")
   on.exit(options(old))
 
-  expect_identical(aes_string(0.4)$x, rlang::new_quosure(0.4))
+  expect_identical(aes_string(0.4)$x, 0.4)
 })
 
 test_that("aes_q() & aes_string() preserves explicit NULLs", {
@@ -59,16 +59,33 @@ test_that("aes evaluated in environment where plot created", {
   expect_equal(layer_data(f())$x, 10)
 })
 
-test_that("assignment methods create quosures", {
+test_that("constants are not wrapped in quosures", {
+  aes <- aes(1L, "foo", 1.5)
+  expect_identical(unclass(aes), list(x = 1L, y = "foo", 1.5))
+})
+
+test_that("assignment methods wrap symbolic objects in quosures", {
   mapping <- aes(a, b, c = c)
   mapping[1] <- list(quote(foo))
-  expect_identical(mapping[[1]], rlang::new_quosure(quote(foo), baseenv()))
+  expect_identical(mapping[[1]], rlang::new_quosure(quote(foo), globalenv()))
 
   mapping[[2]] <- quote(bar)
-  expect_identical(mapping[[2]], rlang::new_quosure(quote(bar), baseenv()))
+  expect_identical(mapping[[2]], rlang::new_quosure(quote(bar), globalenv()))
 
   mapping$c <- quote(baz)
-  expect_identical(mapping[[3]], rlang::new_quosure(quote(baz), baseenv()))
+  expect_identical(mapping[[3]], rlang::new_quosure(quote(baz), globalenv()))
+})
+
+test_that("assignment methods pull unwrap constants from quosures", {
+  mapping <- aes(a, b, c = c)
+  mapping[1] <- list(rlang::quo("foo"))
+  expect_identical(mapping[[1]], "foo")
+
+  mapping[[2]] <- rlang::quo("bar")
+  expect_identical(mapping[[2]], "bar")
+
+  mapping$c <- rlang::quo("baz")
+  expect_identical(mapping[[3]], "baz")
 })