Accept vars() specs in facet_grid()

Author: lionel-

R/facet-grid-.r

@@ -7,18 +7,18 @@ NULL
 #' faceting variables. It is most useful when you have two discrete
 #' variables, and all combinations of the variables exist in the data.
 #'
-#' @param facets a formula with the rows (of the tabular display) on the LHS
-#'   and the columns (of the tabular display) on the RHS; the dot in the
-#'   formula is used to indicate there should be no faceting on this dimension
-#'   (either row or column). The formula can also be provided as a string
-#'   instead of a classical formula object
-#' @param margins either a logical value or a character
-#'   vector. Margins are additional facets which contain all the data
-#'   for each of the possible values of the faceting variables. If
-#'   `FALSE`, no additional facets are included (the
-#'   default). If `TRUE`, margins are included for all faceting
-#'   variables. If specified as a character vector, it is the names of
-#'   variables for which margins are to be created.
+#' @param rows,cols A set of variables or expressions quoted by
+#'   [vars()] and defining faceting groups on the rows or columns
+#'   dimension. The names will be shown if a relevant `labeller` is
+#'   set.
+#'
+#'   For backward compatibility with the historical interface, `rows`
+#'   can also be a formula with the rows (of the tabular display) on
+#'   the LHS and the columns (of the tabular display) on the RHS; the
+#'   dot in the formula is used to indicate there should be no
+#'   faceting on this dimension (either row or column). The formula
+#'   can also be provided as a string instead of a classical formula
+#'   object.
 #' @param scales Are scales shared across all facets (the default,
 #'   `"fixed"`), or do they vary across rows (`"free_x"`),
 #'   columns (`"free_y"`), or both rows and columns (`"free"`)
@@ -50,6 +50,15 @@ NULL
 #' @param drop If `TRUE`, the default, all factor levels not used in the
 #'   data will automatically be dropped. If `FALSE`, all factor levels
 #'   will be shown, regardless of whether or not they appear in the data.
+#' @param margins either a logical value or a character
+#'   vector. Margins are additional facets which contain all the data
+#'   for each of the possible values of the faceting variables. If
+#'   `FALSE`, no additional facets are included (the
+#'   default). If `TRUE`, margins are included for all faceting
+#'   variables. If specified as a character vector, it is the names of
+#'   variables for which margins are to be created.
+#' @param facets This argument is soft-deprecated, please us `rows`
+#'   and `cols` instead.
 #' @export
 #' @examples
 #' p <- ggplot(mpg, aes(displ, cty)) + geom_point()
@@ -129,7 +138,27 @@ NULL
 #' mg + facet_grid(vs + am ~ gear, margins = c("gear", "am"))
 #' }
 #' @importFrom plyr as.quoted
-facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = NULL, drop = TRUE) {
+facet_grid <- function(rows = NULL,
+                       cols = NULL,
+                       scales = "fixed",
+                       space = "fixed",
+                       shrink = TRUE,
+                       labeller = "label_value",
+                       as.table = TRUE,
+                       switch = NULL,
+                       drop = TRUE,
+                       margins = FALSE,
+                       facets = NULL) {
+  # `facets` is soft-deprecated and renamed to `rows`
+  if (!is.null(facets)) {
+    rows <- facets
+  }
+  # Should become a warning in a future release
+  if (is.logical(cols)) {
+    margins <- cols
+    cols <- NULL
+  }
+
   scales <- match.arg(scales, c("fixed", "free_x", "free_y", "free"))
   free <- list(
     x = any(scales %in% c("free_x", "free")),
@@ -146,21 +175,17 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed
     stop("switch must be either 'both', 'x', or 'y'", call. = FALSE)
   }
 
-  facets <- as_facets_list(facets)
-
-  n <- length(facets)
-  if (!n) {
-    stop("FIXME: Internal error grid?")
-  }
+  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 <- list()
-    cols <- facets[[1]]
+    rows <- quos()
+    cols <- facets_list[[1]]
   } else {
-    rows <- facets[[1]]
-    cols <- facets[[2]]
+    rows <- facets_list[[1]]
+    cols <- facets_list[[2]]
   }
 
   # Check for deprecated labellers
@@ -173,6 +198,33 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed
       as.table = as.table, switch = switch, drop = drop)
   )
 }
+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))
+  }
+
+  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 <- quos()
+  } else {
+    rows <- rlang::quos_auto_name(rows)
+  }
+  if (is.null(cols)) {
+    cols <- quos()
+  } else {
+    cols <- rlang::quos_auto_name(cols)
+  }
+
+  list(rows, cols)
+}
 
 #' @rdname ggplot2-ggproto
 #' @format NULL

man/facet_grid.Rd

@@ -76,6 +76,37 @@ test_that("facet_wrap() accept vars()", {
   expect_identical(layer_data(p1), layer_data(p2))
 })
 
+test_that("facet_grid() accepts vars()", {
+  grid <- facet_grid(vars(a = foo))
+  expect_identical(grid$params$rows, quos(a = foo))
+
+  grid <- facet_grid(vars(a = foo), vars(b = bar))
+  expect_identical(grid$params$rows, quos(a = foo))
+  expect_identical(grid$params$cols, quos(b = bar))
+
+  grid <- facet_grid(vars(foo), vars(bar))
+  expect_identical(grid$params$rows, quos(foo = foo))
+  expect_identical(grid$params$cols, quos(bar = bar))
+
+  expect_equal(facet_grid(vars(am, vs)), facet_grid(am + vs ~ .))
+  expect_equal(facet_grid(vars(am, vs), vars(cyl)), facet_grid(am + vs ~ cyl))
+  expect_equal(facet_grid(NULL, vars(cyl)), facet_grid(. ~ cyl))
+  expect_equal(facet_grid(vars(am, vs), TRUE), facet_grid(am + vs ~ ., margins = TRUE))
+})
+
+test_that("facet_grid() fails if passed both a formula and a vars()", {
+  expect_error(facet_grid(~foo, vars()), "`rows` must be `NULL` or a `vars\\(\\)` list if")
+})
+
+test_that("can't pass formulas to `cols`", {
+  expect_error(facet_grid(NULL, ~foo), "`cols` must be `NULL` or a `vars\\(\\)`")
+})
+
+test_that("can still pass `margins` as second argument", {
+  grid <- facet_grid(~foo, TRUE)
+  expect_true(grid$params$margins)
+})
+
 test_that("vars() accepts optional names", {
   wrap <- facet_wrap(vars(A = a, b))
   expect_named(wrap$params$facets, c("A", "b"))