Allow expressions in facet specs even when some variables are not available on some layers (#3757)

Author: yutannihilation

NEWS.md

@@ -168,6 +168,9 @@ fail.
   stepwise addition of individual partial themes is now equivalent to
   addition of multple theme elements at once (@clauswilke, #3039).
 
+* Facets now don't fail even when some variable in the spec are not available
+  in all layers (@yutannihilation, #2963).
+
 # ggplot2 3.2.1
 
 This is a patch release fixing a few regressions introduced in 3.2.0 as well as

R/facet-.r

@@ -155,6 +155,7 @@ Facet <- ggproto("Facet", NULL,
     panels
   },
   setup_params = function(data, params) {
+    params$.possible_columns <- unique(unlist(lapply(data, names)))
     params
   },
   setup_data = function(data, params) {
@@ -417,11 +418,13 @@ is_facets <- function(x) {
 # 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_facets <- function(facets, data, env = globalenv()) {
-  vars <- compact(lapply(facets, eval_facet, data, env = env))
+eval_facets <- function(facets, data, possible_columns = NULL) {
+  vars <- compact(lapply(facets, eval_facet, data, possible_columns = possible_columns))
   new_data_frame(tibble::as_tibble(vars))
 }
-eval_facet <- function(facet, data, env = emptyenv()) {
+eval_facet <- function(facet, data, possible_columns = NULL) {
+  # Treat the case when `facet` is a quosure of a symbol specifically
+  # to issue a friendlier warning
   if (quo_is_symbol(facet)) {
     facet <- as.character(quo_get_expr(facet))
 
@@ -433,7 +436,22 @@ eval_facet <- function(facet, data, env = emptyenv()) {
     return(out)
   }
 
-  eval_tidy(facet, data, env)
+  # Key idea: use active bindings so that column names missing in this layer
+  # but present in others raise a custom error
+  env <- new_environment(data)
+  missing_columns <- setdiff(possible_columns, names(data))
+  undefined_error <- function(e) abort("", class = "ggplot2_missing_facet_var")
+  bindings <- rep_named(missing_columns, list(undefined_error))
+  env_bind_active(env, !!!bindings)
+
+  # Create a data mask and install a data pronoun manually (see ?new_data_mask)
+  mask <- new_data_mask(env)
+  mask$.data <- as_data_pronoun(mask)
+
+  tryCatch(
+    eval_tidy(facet, mask),
+    ggplot2_missing_facet_var = function(e) NULL
+  )
 }
 
 layout_null <- function() {
@@ -524,10 +542,11 @@ panel_rows <- function(table) {
 #' @keywords internal
 #' @export
 combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) {
+  possible_columns <- unique(unlist(lapply(data, names)))
   if (length(vars) == 0) return(new_data_frame())
 
   # For each layer, compute the facet values
-  values <- compact(lapply(data, eval_facets, facets = vars, env = env))
+  values <- compact(lapply(data, eval_facets, facets = vars, possible_columns = possible_columns))
 
   # Form the base data.frame which contains all combinations of faceting
   # variables that appear in the data

R/facet-grid-.r

@@ -252,7 +252,7 @@ FacetGrid <- ggproto("FacetGrid", Facet,
       intersect(names(cols), names(data)))
     data <- reshape_add_margins(data, margin_vars, params$margins)
 
-    facet_vals <- eval_facets(c(rows, cols), data, params$plot_env)
+    facet_vals <- eval_facets(c(rows, cols), data, params$.possible_columns)
 
     # If any faceting variables are missing, add them in by
     # duplicating the data

R/facet-wrap.r

@@ -187,7 +187,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
       return(data)
     }
 
-    facet_vals <- eval_facets(vars, data, params$plot_env)
+    facet_vals <- eval_facets(vars, data, params$.possible_columns)
     facet_vals[] <- lapply(facet_vals[], as.factor)
 
     missing_facets <- setdiff(names(vars), names(facet_vals))

tests/testthat/test-facet-.r

@@ -302,6 +302,27 @@ test_that("combine_vars() generates the correct combinations with multiple data
   )
 })
 
+test_that("eval_facet() is tolerant for missing columns (#2963)", {
+  expect_null(eval_facet(quo(2 * x), data_frame(foo = 1), possible_columns = c("x")))
+  expect_null(eval_facet(quo(2 * .data$x), data_frame(foo = 1), possible_columns = c("x")))
+
+  # Even if there's the same name of external variable, eval_facet() returns NULL before
+  # reaching to the variable
+  bar <- 2
+  expect_null(eval_facet(quo(2 * bar), data_frame(foo = 1), possible_columns = c("bar")))
+  # If there's no same name of columns, the external variable is used
+  expect_equal(
+    eval_facet(quo(2 * bar), data_frame(foo = 1), possible_columns = c("x")),
+    4
+  )
+
+  # If the expression contains any non-existent variable, it fails
+  expect_error(
+    eval_facet(quo(no_such_variable * x), data_frame(foo = 1), possible_columns = c("x")),
+    "object 'no_such_variable' not found"
+  )
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("facet labels respect both justification and margin arguments", {