diff --git a/R/facet-.r b/R/facet-.r index 7e2b0eed66..c4c1e58859 100644 --- a/R/facet-.r +++ b/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 diff --git a/R/facet-grid-.r b/R/facet-grid-.r index 1a6bd430bb..fe4fe926f1 100644 --- a/R/facet-grid-.r +++ b/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 diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 926322c420..b5c11f895e 100644 --- a/R/facet-wrap.r +++ b/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)) diff --git a/tests/testthat/test-facet-.r b/tests/testthat/test-facet-.r index 2de43bc151..375305ab5d 100644 --- a/tests/testthat/test-facet-.r +++ b/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", {