allow empty facet specs (#3162)

Author: yutannihilation

NEWS.md

@@ -108,6 +108,9 @@ core developer team.
 * `stat_bin()` will now error when the number of bins exceeds 1e6 to avoid 
   accidentally freezing the user session (@thomasp85).
 
+* `facet_wrap()` and `facet_grid()` now automatically remove NULL from facet
+  specs, and accept empty specs (@yutannihilation, #3070, #2986).
+
 * `stat_bin()` now handles data with only one unique value (@yutannihilation 
   #3047).
 

R/facet-.r

@@ -275,10 +275,10 @@ df.grid <- function(a, b) {
 # facetting variables.
 
 as_facets_list <- function(x) {
-  if (inherits(x, "mapping")) {
-    stop("Please use `vars()` to supply facet variables")
+  if (inherits(x, "uneval")) {
+    stop("Please use `vars()` to supply facet variables", call. = FALSE)
   }
-  if (inherits(x, "quosures")) {
+  if (rlang::is_quosures(x)) {
     x <- rlang::quos_auto_name(x)
     return(list(x))
   }
@@ -311,13 +311,16 @@ as_facets_list <- function(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
 }
 
+# Flatten a list of quosures objects to a quosures object, and compact it
+compact_facets <- function(x) {
+  x <- rlang::flatten_if(x, rlang::is_list)
+  null <- vapply(x, rlang::quo_is_null, logical(1))
+  rlang::new_quosures(x[!null])
+}
+
 # Compatibility with plyr::as.quoted()
 as_quoted <- function(x) {
   if (is.character(x)) {
@@ -360,15 +363,7 @@ f_as_facets_list <- function(f) {
   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)
-  }
+  list(rows, cols)
 }
 
 as_facets <- function(x) {

R/facet-grid-.r

@@ -145,54 +145,46 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   }
 
   facets_list <- grid_as_facets_list(rows, cols)
-  n <- length(facets_list)
-  if (n > 2L) {
-    stop("A grid facet specification can't have more than two dimensions", call. = FALSE)
-  }
-  if (n == 1L) {
-    rows <- rlang::quos()
-    cols <- facets_list[[1]]
-  } else {
-    rows <- facets_list[[1]]
-    cols <- facets_list[[2]]
-  }
 
   # Check for deprecated labellers
   labeller <- check_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,
-    params = list(rows = rows, cols = cols, margins = margins,
+    params = list(rows = facets_list$rows, cols = facets_list$cols, margins = margins,
       free = free, space_free = space_free, labeller = labeller,
       as.table = as.table, switch = switch, drop = drop)
   )
 }
+
+# Returns a list of quosures objects. The list has exactly two elements, `rows` and `cols`.
 grid_as_facets_list <- function(rows, cols) {
   is_rows_vars <- is.null(rows) || rlang::is_quosures(rows)
   if (!is_rows_vars) {
     if (!is.null(cols)) {
       stop("`rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list", call. = FALSE)
     }
-    return(as_facets_list(rows))
+    # For backward-compatibility
+    facets_list <- as_facets_list(rows)
+    if (length(facets_list) > 2L) {
+      stop("A grid facet specification can't have more than two dimensions", call. = FALSE)
+    }
+    # Fill with empty quosures
+    facets <- list(rows = rlang::quos(), cols = rlang::quos())
+    facets[seq_along(facets_list)] <- facets_list
+    # Do not compact the legacy specs
+    return(facets)
   }
 
   is_cols_vars <- is.null(cols) || rlang::is_quosures(cols)
   if (!is_cols_vars) {
     stop("`cols` must be `NULL` or a `vars()` specification", call. = FALSE)
   }
 
-  if (is.null(rows)) {
-    rows <- rlang::quos()
-  } else {
-    rows <- rlang::quos_auto_name(rows)
-  }
-  if (is.null(cols)) {
-    cols <- rlang::quos()
-  } else {
-    cols <- rlang::quos_auto_name(cols)
-  }
-
-  list(rows, cols)
+  list(
+    rows = compact_facets(as_facets_list(rows)),
+    cols = compact_facets(as_facets_list(cols))
+  )
 }
 
 #' @rdname ggplot2-ggproto
@@ -223,6 +215,10 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     base_cols <- combine_vars(data, params$plot_env, cols, drop = params$drop)
     base <- df.grid(base_rows, base_cols)
 
+    if (nrow(base) == 0) {
+      return(new_data_frame(list(PANEL = 1L, ROW = 1L, COL = 1L, SCALE_X = 1L, SCALE_Y = 1L)))
+    }
+
     # Add margins
     base <- reshape2::add_margins(base, list(names(rows), names(cols)), params$margins)
     # Work around bug in reshape2
@@ -253,6 +249,11 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     cols <- params$cols
     vars <- c(names(rows), names(cols))
 
+    if (length(vars) == 0) {
+      data$PANEL <- layout$PANEL
+      return(data)
+    }
+
     # Compute faceting values and add margins
     margin_vars <- list(intersect(names(rows), names(data)),
       intersect(names(cols), names(data)))

R/facet-wrap.r

@@ -109,8 +109,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   labeller <- check_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
-  facets_list <- as_facets_list(facets)
-  facets <- rlang::flatten_if(facets_list, rlang::is_list)
+  facets <- wrap_as_facets_list(facets)
 
   ggproto(NULL, FacetWrap,
     shrink = shrink,
@@ -128,6 +127,12 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 }
 
+# Returns a quosures object
+wrap_as_facets_list <- function(x) {
+  facets_list <- as_facets_list(x)
+  compact_facets(facets_list)
+}
+
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL
@@ -177,8 +182,14 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     if (empty(data)) {
       return(cbind(data, PANEL = integer(0)))
     }
+
     vars <- params$facets
 
+    if (length(vars) == 0) {
+      data$PANEL <- 1L
+      return(data)
+    }
+
     facet_vals <- eval_facets(vars, data, params$plot_env)
     facet_vals[] <- lapply(facet_vals[], as.factor)
 
@@ -229,7 +240,12 @@ FacetWrap <- ggproto("FacetWrap", Facet,
 
     axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
 
-    labels_df <- layout[names(params$facets)]
+    if (length(params$facets) == 0) {
+      # Add a dummy label
+      labels_df <- new_data_frame(list("(all)" = "(all)"), n = 1)
+    } else {
+      labels_df <- layout[names(params$facets)]
+    }
     attr(labels_df, "facet") <- "wrap"
     strips <- render_strips(
       structure(labels_df, type = "rows"),

tests/testthat/test-facet-.r

@@ -1,9 +1,8 @@
 context("Facetting")
 
 test_that("as_facets_list() coerces formulas", {
-  expect_identical(as_facets_list(~foo), list(quos(foo = foo)))
-  expect_identical(as_facets_list(~foo + bar), list(quos(foo = foo, bar = bar)))
-
+  expect_identical(as_facets_list(~foo), list(quos(), quos(foo = foo)))
+  expect_identical(as_facets_list(~foo + bar), list(quos(), quos(foo = foo, bar = bar)))
   expect_identical(as_facets_list(foo ~ bar), list(quos(foo = foo), quos(bar = bar)))
 
   exp <- list(quos(foo = foo, bar = bar), quos(baz = baz, bam = bam))
@@ -18,8 +17,13 @@ test_that("as_facets_list() coerces strings containing formulas", {
 })
 
 test_that("as_facets_list() coerces character vectors", {
-  expect_identical(as_facets_list("foo"), as_facets_list(local(~foo, globalenv())))
-  expect_identical(as_facets_list(c("foo", "bar")), as_facets_list(local(foo ~ bar, globalenv())))
+  foo <- rlang::new_quosure(quote(foo), globalenv())
+  bar <- rlang::new_quosure(quote(bar), globalenv())
+  foobar <- rlang::as_quosures(list(foo, bar), named = TRUE)
+
+  expect_identical(as_facets_list("foo"), list(foobar[1]))
+  expect_identical(as_facets_list(c("foo", "bar")), list(foobar[1], foobar[2]))
+  expect_identical(wrap_as_facets_list(c("foo", "bar")), foobar)
 })
 
 test_that("as_facets_list() coerces lists", {
@@ -36,17 +40,39 @@ test_that("as_facets_list() coerces lists", {
   expect_identical(out, exp)
 })
 
-test_that("as_facets_list() errors with empty specs", {
-  expect_error(as_facets_list(list()), "at least one variable to facet by")
-  expect_error(as_facets_list(. ~ .), "at least one variable to facet by")
-  expect_error(as_facets_list(list(. ~ .)), "at least one variable to facet by")
-  expect_error(as_facets_list(list(NULL)), "at least one variable to facet by")
+test_that("as_facets_list() coerces quosures objectss", {
+  expect_identical(as_facets_list(vars(foo)), list(quos(foo = foo)))
+})
+
+test_that("facets reject aes()", {
+  expect_error(facet_wrap(aes(foo)), "Please use `vars()` to supply facet variables", fixed = TRUE)
+  expect_error(facet_grid(aes(foo)), "Please use `vars()` to supply facet variables", fixed = TRUE)
 })
 
-test_that("as_facets_list() coerces quosure lists", {
-  expect_identical(as_facets_list(vars(foo)), list(rlang::quos(foo = foo)))
+test_that("wrap_as_facets_list() returns a quosures object with compacted", {
+  expect_identical(wrap_as_facets_list(vars(foo)), quos(foo = foo))
+  expect_identical(wrap_as_facets_list(~foo + bar), quos(foo = foo, bar = bar))
+  expect_identical(wrap_as_facets_list(vars(foo, NULL, bar)), quos(foo = foo, bar = bar))
 })
 
+test_that("grid_as_facets_list() returns a list of quosures objects with compacted", {
+  expect_identical(grid_as_facets_list(vars(foo), NULL), list(rows = quos(foo = foo), cols = quos()))
+  expect_identical(grid_as_facets_list(~foo, NULL), list(rows = quos(), cols = quos(foo = foo)))
+  expect_identical(grid_as_facets_list(vars(foo, NULL, bar), NULL), list(rows = quos(foo = foo, bar = bar), cols = quos()))
+})
+
+test_that("wrap_as_facets_list() and grid_as_facets_list() accept empty specs", {
+  expect_identical(wrap_as_facets_list(NULL), quos())
+  expect_identical(wrap_as_facets_list(list()), quos())
+  expect_identical(wrap_as_facets_list(. ~ .), quos())
+  expect_identical(wrap_as_facets_list(list(. ~ .)), quos())
+  expect_identical(wrap_as_facets_list(list(NULL)), quos())
+
+  expect_identical(grid_as_facets_list(list(), NULL), list(rows = quos(), cols = quos()))
+  expect_identical(grid_as_facets_list(. ~ ., NULL), list(rows = quos(), cols = quos()))
+  expect_identical(grid_as_facets_list(list(. ~ .), NULL), list(rows = quos(), cols = quos()))
+  expect_identical(grid_as_facets_list(list(NULL), NULL), list(rows = quos(), cols = quos()))
+})
 
 df <- data_frame(x = 1:3, y = 3:1, z = letters[1:3])
 
@@ -110,6 +136,23 @@ test_that("vars() accepts optional names", {
   expect_named(wrap$params$facets, c("A", "b"))
 })
 
+test_that("facets_wrap() compacts the facet spec and accept empty spec", {
+  p <- ggplot(df, aes(x, y)) + geom_point() + facet_wrap(vars(NULL))
+  d <- layer_data(p)
+
+  expect_equal(d$PANEL, c(1L, 1L, 1L))
+  expect_equal(d$group, c(-1L, -1L, -1L))
+})
+
+test_that("facets_grid() compacts the facet spec and accept empty spec", {
+  p <- ggplot(df, aes(x, y)) + geom_point() + facet_grid(vars(NULL))
+  d <- layer_data(p)
+
+  expect_equal(d$PANEL, c(1L, 1L, 1L))
+  expect_equal(d$group, c(-1L, -1L, -1L))
+})
+
+
 test_that("facets with free scales scale independently", {
   l1 <- ggplot(df, aes(x, y)) + geom_point() +
     facet_wrap(~z, scales = "free")