Merge pull request #2491 from tidyverse/tidyeval-facets

Port facets to tidy eval

Author: lionel-

NAMESPACE

@@ -548,6 +548,7 @@ export(unit)
 export(update_geom_defaults)
 export(update_labels)
 export(update_stat_defaults)
+export(vars)
 export(waiver)
 export(wrap_dims)
 export(xlab)
@@ -559,7 +560,6 @@ import(grid)
 import(gtable)
 import(scales)
 importFrom(lazyeval,f_eval)
-importFrom(plyr,as.quoted)
 importFrom(plyr,defaults)
 importFrom(rlang,.data)
 importFrom(rlang,enexpr)

NEWS.md

@@ -6,6 +6,26 @@
   and `:=`. This replaces `aes_()` and `aes_string()` which are now
   soft-deprecated (but will remain around for a long time).
 
+* `facet_wrap()` and `facet_grid()` now support `vars()` inputs. Like
+  `dplyr::vars()`, this helper quotes its inputs and supports
+  quasiquotation. For instance you can now supply facetting variables
+  like this: `facet_wrap(vars(am, cyl))` instead of `facet_wrap(~am +
+  cyl)`. Note that the formula interface is not going away and will
+  not be deprecated. `vars()` is simply meant to make it easier to
+  create functions around `facet_wrap()` and `facet_grid()`.
+
+  The first two arguments of `facet_grid()` become `rows` and `cols`
+  and now support `vars()` inputs. Note however that we took special
+  care to ensure complete backward compatibility. With this change
+  `facet_grid(vars(cyl), vars(am, vs))` is equivalent to
+  `facet_grid(cyl ~ am + vs)` and `facet_grid(cols = vars(am, vs))` is
+  equivalent to `facet_grid(. ~ am + vs)`.
+
+  One nice aspect of the new interface is that you can now easily
+  supply names: `facet_grid(vars(Cylinder = cyl), labeller =
+  label_both)` will give nice label titles to the facets. Of course
+  those names can be unquoted with the usual tidy eval syntax.
+
 * ggplot2 now works on R 3.1 onwards, and uses the 
   [vdiffr](https://github.com/lionel-/vdiffr) package for visual testing.
 

R/aes.r

@@ -47,6 +47,8 @@ NULL
 #' @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 [vars()] for another quoting function designed for
+#'   faceting specifications.
 #' @export
 #' @examples
 #' aes(x = mpg, y = wt)

R/facet-.r

@@ -170,6 +170,67 @@ Facet <- ggproto("Facet", NULL,
 
 # Helpers -----------------------------------------------------------------
 
+#' Quote faceting variables
+#'
+#' @description
+#'
+#' Just like [aes()], `vars()` is a [quoting function][rlang::quotation]
+#' that takes inputs to be evaluated in the context of a dataset.
+#' These inputs can be:
+#'
+#' * variable names
+#' * complex expressions
+#'
+#' In both cases, the results (the vectors that the variable
+#' represents or the results of the expressions) are used to form
+#' faceting groups.
+#'
+#' @param ... Variables or expressions automatically quoted. These are
+#'   evaluated in the context of the data to form faceting groups. Can
+#'   be named (the names are passed to a [labeller][labellers]).
+#'
+#' @seealso [aes()], [facet_wrap()], [facet_grid()]
+#' @export
+#' @examples
+#' p <- ggplot(diamonds) + geom_point(aes(carat, price))
+#' p + facet_wrap(vars(cut, clarity))
+#'
+#' # vars() makes it easy to pass variables from wrapper functions:
+#' wrap_by <- function(...) {
+#'   facet_wrap(vars(...), labeller = label_both)
+#' }
+#' p + wrap_by(cut)
+#' p + wrap_by(cut, clarity)
+#'
+#'
+#' # You can also supply expressions to vars(). In this case it's often a
+#' # good idea to supply a name as well:
+#' p + wrap_by(depth = cut_number(depth, 3))
+#'
+#' # Let's create another function for cutting and wrapping a
+#' # variable. This time it will take a named argument instead of dots,
+#' # so we'll have to use the "enquote and unquote" pattern:
+#' wrap_cut <- function(var, n = 3) {
+#'   # Let's enquote the named argument `var` to make it auto-quoting:
+#'   var <- enquo(var)
+#'
+#'   # `quo_name()` will create a nice default name:
+#'   nm <- quo_name(var)
+#'
+#'   # Now let's unquote everything at the right place. Note that we also
+#'   # unquote `n` just in case the data frame has a column named
+#'   # `n`. The latter would have precedence over our local variable
+#'   # because the data is always masking the environment.
+#'   wrap_by(!!nm := cut_number(!!var, !!n))
+#' }
+#'
+#' # Thanks to tidy eval idioms we now have another useful wrapper:
+#' p + wrap_cut(depth)
+vars <- function(...) {
+  rlang::quos(...)
+}
+
+
 #' Is this object a faceting specification?
 #'
 #' @param x object to test
@@ -203,38 +264,180 @@ df.grid <- function(a, b) {
   ))
 }
 
+# A facets spec is a list of facets. A grid facetting needs two facets
+# while a wrap facetting flattens all dimensions and thus accepts any
+# number of facets.
+#
+# A facets is a list of grouping variables. They are typically
+# supplied as variable names but can be expressions.
+#
+# as_facets() is complex due to historical baggage but its main
+# purpose is to create a facets spec from a formula: a + b ~ c + d
+# creates a facets list with two components, each of which bundles two
+# facetting variables.
+
+as_facets_list <- function(x) {
+  if (inherits(x, "mapping")) {
+    stop("Please use `vars()` to supply facet variables")
+  }
+  if (inherits(x, "quosures")) {
+    x <- rlang::quos_auto_name(x)
+    return(list(x))
+  }
+
+  # This needs to happen early because we might get a formula.
+  # facet_grid() directly converted strings to a formula while
+  # facet_wrap() called as.quoted(). Hence this is a little more
+  # complicated for backward compatibility.
+  if (rlang::is_string(x)) {
+    x <- rlang::parse_expr(x)
+  }
+
+  # At this level formulas are coerced to lists of lists for backward
+  # compatibility with facet_grid(). The LHS and RHS are treated as
+  # distinct facet dimensions and `+` defines multiple facet variables
+  # inside each dimension.
+  if (rlang::is_formula(x)) {
+    return(f_as_facets_list(x))
+  }
+
+  # For backward-compatibility with facet_wrap()
+  if (!rlang::is_bare_list(x)) {
+    x <- as_quoted(x)
+  }
+
+  # If we have a list there are two possibilities. We may already have
+  # a proper facet spec structure. Otherwise we coerce each element
+  # with as_quoted() for backward compatibility with facet_grid().
+  if (is.list(x)) {
+    x <- lapply(x, as_facets)
+  }
+
+  if (sum(vapply(x, length, integer(1))) == 0L) {
+    stop("Must specify at least one variable to facet by", call. = FALSE)
+  }
+
+  x
+}
+
+# Compatibility with plyr::as.quoted()
+as_quoted <- function(x) {
+  if (is.character(x)) {
+    return(rlang::parse_exprs(x))
+  }
+  if (is.null(x)) {
+    return(list())
+  }
+  if (rlang::is_formula(x)) {
+    return(simplify(x))
+  }
+  list(x)
+}
+# From plyr:::as.quoted.formula
+simplify <- function(x) {
+  if (length(x) == 2 && rlang::is_symbol(x[[1]], "~")) {
+    return(simplify(x[[2]]))
+  }
+  if (length(x) < 3) {
+    return(list(x))
+  }
+  op <- x[[1]]; a <- x[[2]]; b <- x[[3]]
+
+  if (rlang::is_symbol(op, c("+", "*", "~"))) {
+    c(simplify(a), simplify(b))
+  } else if (rlang::is_symbol(op, "-")) {
+    c(simplify(a), expr(-!!simplify(b)))
+  } else {
+    list(x)
+  }
+}
+
+f_as_facets_list <- function(f) {
+  lhs <- function(x) if (length(x) == 2) NULL else x[-3]
+  rhs <- function(x) if (length(x) == 2) x else x[-2]
+
+  rows <- f_as_facets(lhs(f))
+  cols <- f_as_facets(rhs(f))
+
+  if (length(rows) + length(cols) == 0) {
+    stop("Must specify at least one variable to facet by", call. = FALSE)
+  }
+
+  if (length(rows)) {
+    list(rows, cols)
+  } else {
+    list(cols)
+  }
+}
+
+as_facets <- function(x) {
+  if (is_facets(x)) {
+    return(x)
+  }
+
+  if (rlang::is_formula(x)) {
+    # Use different formula method because plyr's does not handle the
+    # environment correctly.
+    f_as_facets(x)
+  } else {
+    vars <- as_quoted(x)
+    rlang::as_quosures(vars, globalenv(), named = TRUE)
+  }
+}
+f_as_facets <- function(f) {
+  if (is.null(f)) {
+    return(rlang::as_quosures(list()))
+  }
+
+  env <- rlang::f_env(f) %||% globalenv()
+
+  # as.quoted() handles `+` specifications
+  vars <- plyr::as.quoted(f)
+
+  # `.` in formulas is ignored
+  vars <- discard_dots(vars)
+
+  rlang::as_quosures(vars, env, named = TRUE)
+}
+discard_dots <- function(x) {
+  x[!vapply(x, identical, logical(1), as.name("."))]
+}
+
+is_facets <- function(x) {
+  if (!is.list(x)) {
+    return(FALSE)
+  }
+  if (!length(x)) {
+    return(FALSE)
+  }
+  all(vapply(x, rlang::is_quosure, logical(1)))
+}
+
+
 # When evaluating variables in a facet specification, we evaluate bare
 # variables and expressions slightly differently. Bare variables should
 # always succeed, even if the variable doesn't exist in the data frame:
 # that makes it possible to repeat data across multiple factors. But
 # when evaluating an expression, you want to see any errors. That does
 # mean you can't have background data when faceting by an expression,
 # but that seems like a reasonable tradeoff.
-eval_facet_vars <- function(vars, data, env = emptyenv()) {
-  nms <- names(vars)
-  out <- list()
-
-  for (i in seq_along(vars)) {
-    out[[ nms[[i]] ]] <- eval_facet_var(vars[[i]], data, env = env)
-  }
-
-  tibble::as_tibble(out)
+eval_facets <- function(facets, data, env = globalenv()) {
+  vars <- compact(lapply(facets, eval_facet, data, env = env))
+  tibble::as_tibble(vars)
 }
+eval_facet <- function(facet, data, env = emptyenv()) {
+  if (rlang::quo_is_symbol(facet)) {
+    facet <- as.character(rlang::quo_get_expr(facet))
 
-eval_facet_var <- function(var, data, env = emptyenv()) {
-  if (is.name(var)) {
-    var <- as.character(var)
-    if (var %in% names(data)) {
-      data[[var]]
+    if (facet %in% names(data)) {
+      out <- data[[facet]]
     } else {
-      NULL
+      out <- NULL
     }
-  } else if (is.call(var)) {
-    eval(var, envir = data, enclos = env)
-  } else {
-    stop("Must use either variable name or expression when faceting",
-      call. = FALSE)
+    return(out)
   }
+
+  rlang::eval_tidy(facet, data, env)
 }
 
 layout_null <- function() {
@@ -325,7 +528,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) {
   if (length(vars) == 0) return(data.frame())
 
   # For each layer, compute the facet values
-  values <- compact(plyr::llply(data, eval_facet_vars, vars = vars, env = env))
+  values <- compact(plyr::llply(data, eval_facets, facets = vars, env = env))
 
   # Form the base data frame which contains all combinations of faceting
   # variables that appear in the data