diff --git a/NEWS.md b/NEWS.md index b267737ea3..bcf979fe14 100644 --- a/NEWS.md +++ b/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). diff --git a/R/facet-.r b/R/facet-.r index 6eb990c3a6..4ccdcb3cd8 100644 --- a/R/facet-.r +++ b/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) { diff --git a/R/facet-grid-.r b/R/facet-grid-.r index ae2fb50578..4b1ba83357 100644 --- a/R/facet-grid-.r +++ b/R/facet-grid-.r @@ -145,35 +145,35 @@ 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) @@ -181,18 +181,10 @@ grid_as_facets_list <- function(rows, cols) { 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))) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 78c112751e..8c0b112c26 100644 --- a/R/facet-wrap.r +++ b/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"), diff --git a/tests/testthat/test-facet-.r b/tests/testthat/test-facet-.r index ed57f2e0b5..133a26bbc2 100644 --- a/tests/testthat/test-facet-.r +++ b/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")