Port mappings to tidy eval

DESCRIPTION

@@ -20,7 +20,7 @@ Imports:
     MASS,
     plyr (>= 1.7.1),
     reshape2,
-    rlang (>= 0.1.6.9002),
+    rlang (>= 0.2.0.9001),
     scales (>= 0.4.1.9002),
     stats,
     tibble,
@@ -52,7 +52,7 @@ Suggests:
 Remotes: hadley/scales,
     hadley/svglite,
     jimhester/withr,
-    tidyverse/rlang
+    r-lib/rlang
 Enhances: sp
 License: GPL-2 | file LICENSE
 URL: http://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2
@@ -232,6 +232,7 @@ Collate:
     'utilities-matrix.r'
     'utilities-resolution.r'
     'utilities-table.r'
+    'utilities-tidy-eval.R'
     'zxx.r'
     'zzz.r'
 VignetteBuilder: knitr

NAMESPACE

@@ -2,11 +2,13 @@
 
 S3method("$",ggproto)
 S3method("$",ggproto_parent)
+S3method("$<-",uneval)
 S3method("+",gg)
 S3method("[",uneval)
+S3method("[<-",uneval)
 S3method("[[",ggproto)
+S3method("[[<-",uneval)
 S3method(.DollarNames,ggproto)
-S3method(as.character,uneval)
 S3method(as.list,ggproto)
 S3method(autolayer,default)
 S3method(autoplot,default)
@@ -107,12 +109,12 @@ S3method(scale_type,logical)
 S3method(scale_type,numeric)
 S3method(scale_type,ordered)
 S3method(scale_type,sfc)
-S3method(str,uneval)
 S3method(summary,ggplot)
 S3method(widthDetails,titleGrob)
 S3method(widthDetails,zeroGrob)
 export("%+%")
 export("%+replace%")
+export(.data)
 export(.pt)
 export(.stroke)
 export(AxisSecondary)
@@ -274,8 +276,16 @@ export(element_grob)
 export(element_line)
 export(element_rect)
 export(element_text)
+export(enexpr)
+export(enexprs)
+export(enquo)
+export(enquos)
+export(ensym)
+export(ensyms)
 export(expand_limits)
 export(expand_scale)
+export(expr)
+export(exprs)
 export(facet_grid)
 export(facet_null)
 export(facet_wrap)
@@ -382,6 +392,9 @@ export(position_nudge)
 export(position_stack)
 export(qplot)
 export(quickplot)
+export(quo)
+export(quo_name)
+export(quos)
 export(rel)
 export(remove_missing)
 export(render_axes)
@@ -513,6 +526,8 @@ export(stat_ydensity)
 export(summarise_coord)
 export(summarise_layers)
 export(summarise_layout)
+export(sym)
+export(syms)
 export(theme)
 export(theme_bw)
 export(theme_classic)
@@ -546,6 +561,20 @@ import(scales)
 importFrom(lazyeval,f_eval)
 importFrom(plyr,as.quoted)
 importFrom(plyr,defaults)
+importFrom(rlang,.data)
+importFrom(rlang,enexpr)
+importFrom(rlang,enexprs)
+importFrom(rlang,enquo)
+importFrom(rlang,enquos)
+importFrom(rlang,ensym)
+importFrom(rlang,ensyms)
+importFrom(rlang,expr)
+importFrom(rlang,exprs)
+importFrom(rlang,quo)
+importFrom(rlang,quo_name)
+importFrom(rlang,quos)
+importFrom(rlang,sym)
+importFrom(rlang,syms)
 importFrom(stats,setNames)
 importFrom(tibble,tibble)
 importFrom(utils,.DollarNames)

NEWS.md

@@ -2,11 +2,9 @@
 
 ## New features
 
-* `aes()` now supports quasiquotation so that you can use `!!`, `!!!`, and
-  `:=`. (ggplot2 does not currently support full tidy evaluation because
-  when I wrote ggplot2 my understanding of NSE was quite flawed, and hence
-  ggplot2 only captures one environment per plot, not one environment
-  per aesthetic. We will fix this in a future release.)
+* `aes()` now supports quasiquotation so that you can use `!!`, `!!!`,
+  and `:=`. This replaces `aes_()` and `aes_string()` which are now
+  soft-deprecated (but will remain around for a long time).
 
 * ggplot2 now works on R 3.1 onwards, and uses the 
   [vdiffr](https://github.com/lionel-/vdiffr) package for visual testing.

R/aes-calculated.r

@@ -91,7 +91,7 @@ make_labels <- function(mapping) {
     if (is.atomic(mapping)) {
       aesthetic
     } else {
-      x <- deparse(strip_dots(mapping))
+      x <- rlang::quo_text(strip_dots(mapping))
       if (length(x) > 1) {
         x <- paste0(x[[1]], "...")
       }

R/aes.r

@@ -30,13 +30,23 @@ NULL
 #'
 #' This function also standardise aesthetic names by performing partial
 #' matching, converting color to colour, and translating old style R names to
-#' ggplot names (eg. pch to shape, cex to size)
+#' ggplot names (eg. pch to shape, cex to size).
+#'
+#'
+#' @section Quasiquotation:
+#'
+#' `aes()` is a [quoting function][rlang::quotation]. This means that
+#' its inputs are quoted to be evaluated in the context of the
+#' data. This makes it easy to work with variables from the data frame
+#' because you can name those directly. The flip side is that you have
+#' to use [quasiquotation][rlang::quasiquotation] to program with
+#' `aes()`. See a tidy evaluation tutorial such as the [dplyr
+#' programming vignette](http://dplyr.tidyverse.org/articles/programming.html)
+#' to learn more about these techniques.
 #'
 #' @param x,y,... List of name value pairs giving aesthetics to map to
 #'   variables. The names for x and y aesthetics are typically omitted because
 #'   they are so common; all other aesthetics must be named.
-#' @seealso See [aes_()] for a version of `aes` that is
-#'   more suitable for programming with.
 #' @export
 #' @examples
 #' aes(x = mpg, y = wt)
@@ -57,37 +67,94 @@ NULL
 #'
 #' # Aesthetics supplied to ggplot() are used as defaults for every layer
 #' # you can override them, or supply different aesthetics for each layer
+#'
+#'
+#' # aes() is a quoting function, so you need to use tidy evaluation
+#' # techniques to create wrappers around ggplot2 pipelines. The
+#' # simplest case occurs when your wrapper takes dots:
+#' scatter_by <- function(data, ...) {
+#'   ggplot(data) + geom_point(aes(...))
+#' }
+#' scatter_by(mtcars, disp, drat)
+#'
+#' # If your wrapper has a more specific interface with named arguments,
+#' # you need to use the "enquote and unquote" technique:
+#' scatter_by <- function(data, x, y) {
+#'   ggplot(data) + geom_point(aes(!!enquo(x), !!enquo(y)))
+#' }
+#' scatter_by(mtcars, disp, drat)
+#'
+#' # Note that users of your wrapper can use their own functions in the
+#' # quoted expressions and all will resolve as it should!
+#' cut3 <- function(x) cut_number(x, 3)
+#' scatter_by(mtcars, cut3(disp), drat)
 aes <- function(x, y, ...) {
-  exprs <- rlang::enexprs(x = x, y = y, ...)
-  is_missing <- vapply(exprs, rlang::is_missing, logical(1))
+  exprs <- rlang::enquos(x = x, y = y, ...)
+  is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1))
 
-  aes <- structure(exprs[!is_missing], class = "uneval")
+  aes <- new_aes(exprs[!is_missing], env = parent.frame())
   rename_aes(aes)
 }
+
+# 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")
+}
+
 #' @export
 print.uneval <- function(x, ...) {
   cat("Aesthetic mapping: \n")
 
   if (length(x) == 0) {
     cat("<empty>\n")
   } else {
-    values <- vapply(x, deparse2, character(1))
-    bullets <- paste0("* ", format(names(x)), " -> ", values, "\n")
+    values <- vapply(x, rlang::quo_label, character(1))
+    bullets <- paste0("* `", format(names(x)), "` -> ", values, "\n")
 
     cat(bullets, sep = "")
   }
+
+  invisible(x)
 }
 
 #' @export
-str.uneval <- function(object, ...) utils::str(unclass(object), ...)
-#' @export
-"[.uneval" <- function(x, i, ...) structure(unclass(x)[i], class = "uneval")
+"[.uneval" <- function(x, i, ...) {
+  new_aes(NextMethod())
+}
 
+# If necessary coerce replacements to quosures for compatibility
+#' @export
+"[[<-.uneval" <- function(x, i, value) {
+  new_aes(NextMethod())
+}
+#' @export
+"$<-.uneval" <- function(x, i, value) {
+  # Can't use NextMethod() because of a bug in R 3.1
+  x <- unclass(x)
+  x[[i]] <- value
+  new_aes(x)
+}
 #' @export
-as.character.uneval <- function(x, ...) {
-  char <- as.character(unclass(x))
-  names(char) <- names(x)
-  char
+"[<-.uneval" <- function(x, i, value) {
+  new_aes(NextMethod())
 }
 
 # Rename American or old-style aesthetics name
@@ -131,6 +198,13 @@ is_position_aes <- function(vars) {
 #' `aes(colour = "my colour")` or \code{aes{x = `X$1`}}
 #' with `aes_string()` is quite clunky.
 #'
+#'
+#' @section Life cycle:
+#'
+#' All these functions are soft-deprecated. Please use tidy evaluation
+#' idioms instead (see the quasiquotation section in
+#' [aes()] documentation).
+#'
 #' @param x,y,... List of name value pairs. Elements must be either
 #'   quoted calls, strings, one-sided formulas or constants.
 #' @seealso [aes()]
@@ -157,17 +231,19 @@ aes_ <- function(x, y, ...) {
   if (!missing(x)) mapping["x"] <- list(x)
   if (!missing(y)) mapping["y"] <- list(y)
 
-  as_call <- function(x) {
+  caller_env <- parent.frame()
+
+  as_quosure_aes <- function(x) {
     if (is.formula(x) && length(x) == 2) {
-      x[[2]]
+      rlang::as_quosure(x)
     } else if (is.call(x) || is.name(x) || is.atomic(x)) {
-      x
+      new_aesthetic(x, caller_env)
     } else {
       stop("Aesthetic must be a one-sided formula, call, name, or constant.",
         call. = FALSE)
     }
   }
-  mapping <- lapply(mapping, as_call)
+  mapping <- lapply(mapping, as_quosure_aes)
   structure(rename_aes(mapping), class = "uneval")
 }
 
@@ -178,13 +254,14 @@ aes_string <- function(x, y, ...) {
   if (!missing(x)) mapping["x"] <- list(x)
   if (!missing(y)) mapping["y"] <- list(y)
 
+  caller_env <- parent.frame()
   mapping <- lapply(mapping, function(x) {
     if (is.character(x)) {
-      parse(text = x)[[1]]
-    } else {
-      x
+      x <- rlang::parse_expr(x)
     }
+    new_aesthetic(x, env = caller_env)
   })
+
   structure(rename_aes(mapping), class = "uneval")
 }
 
@@ -204,8 +281,10 @@ aes_all <- function(vars) {
   names(vars) <- vars
   vars <- rename_aes(vars)
 
+  # Quosure the symbols in the empty environment because they can only
+  # refer to the data mask
   structure(
-    lapply(vars, as.name),
+    lapply(vars, function(x) rlang::new_quosure(as.name(x), emptyenv())),
     class = "uneval"
   )
 }
@@ -243,7 +322,10 @@ aes_auto <- function(data = NULL, ...) {
 }
 
 mapped_aesthetics <- function(x) {
+  if (is.null(x)) {
+    return(NULL)
+  }
+
   is_null <- vapply(x, is.null, logical(1))
   names(x)[!is_null]
-
 }

R/geom-.r

@@ -108,10 +108,12 @@ Geom <- ggproto("Geom",
   use_defaults = function(self, data, params = list()) {
     # Fill in missing aesthetics with their defaults
     missing_aes <- setdiff(names(self$default_aes), names(data))
+
+    missing_eval <- lapply(self$default_aes[missing_aes], rlang::eval_tidy)
     if (empty(data)) {
-      data <- plyr::quickdf(self$default_aes[missing_aes])
+      data <- plyr::quickdf(missing_eval)
     } else {
-      data[missing_aes] <- self$default_aes[missing_aes]
+      data[missing_aes] <- missing_eval
     }
 
     # Override mappings with params