diff --git a/NEWS.md b/NEWS.md index bfeaffcbae..e4361c5556 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* `facet_wrap()` has new options for the `dir` argument to more precisely + control panel directions (@teunbrand, #5212) * Prevented `facet_wrap(..., drop = FALSE)` from throwing spurious errors when a character facetting variable contained `NA`s (@teunbrand, #5485). * When facets coerce the faceting variables to factors, the 'ordered' class diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 3fcd05eacd..f69cdd8f95 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -23,7 +23,12 @@ NULL #' either of the four sides by setting \code{strip.position = c("top", #' "bottom", "left", "right")} #' @param dir Direction: either `"h"` for horizontal, the default, or `"v"`, -#' for vertical. +#' for vertical. When `"h"` or `"v"` will be combined with `as.table` to +#' set final layout. Alternatively, a combination of `"t"` (top) or +#' `"b"` (bottom) with `"l"` (left) or `"r"` (right) to set a layout directly. +#' These two letters give the starting position and the first letter gives +#' the growing direction. For example `"rt"` will place the first panel in +#' the top-right and starts filling in panels right-to-left. #' @param axes Determines which axes will be drawn in case of fixed scales. #' When `"margins"` (default), axes will be drawn at the exterior margins. #' `"all_x"` and `"all_y"` will draw the respective axes at the interior @@ -95,13 +100,29 @@ NULL #' facet_wrap(vars(variable), scales = "free_y", nrow = 2, strip.position = "top") + #' theme(strip.background = element_blank(), strip.placement = "outside") #' } +#' +#' # The two letters determine the starting position, so 'tr' starts +#' # in the top-right. +#' # The first letter determines direction, so 'tr' fills top-to-bottom. +#' # `dir = "tr"` is equivalent to `dir = "v", as.table = FALSE` +#' ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' facet_wrap(vars(class), dir = "tr") facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = deprecated(), drop = TRUE, dir = "h", strip.position = 'top', axes = "margins", axis.labels = "all") { scales <- arg_match0(scales %||% "fixed", c("fixed", "free_x", "free_y", "free")) - dir <- arg_match0(dir, c("h", "v")) + dir <- arg_match0(dir, c("h", "v", "lt", "tl", "lb", "bl", "rt", "tr", "rb", "br")) + if (nchar(dir) == 1) { + dir <- base::switch( + dir, + h = if (as.table) "lt" else "lb", + v = if (as.table) "tl" else "tr" + ) + } + free <- list( x = any(scales %in% c("free_x", "free")), y = any(scales %in% c("free_y", "free")) @@ -149,7 +170,6 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", params = list( facets = facets, free = free, - as.table = as.table, strip.position = strip.position, drop = drop, ncol = ncol, @@ -189,21 +209,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, n <- attr(id, "n") dims <- wrap_dims(n, params$nrow, params$ncol) - layout <- data_frame0( - PANEL = factor(id, levels = seq_len(n)), - ROW = if (params$as.table) { - as.integer((id - 1L) %/% dims[2] + 1L) - } else { - as.integer(dims[1] - (id - 1L) %/% dims[2]) - }, - COL = as.integer((id - 1L) %% dims[2] + 1L), - .size = length(id) - ) - - # For vertical direction, flip row and col - if (identical(params$dir, "v")) { - layout[c("ROW", "COL")] <- layout[c("COL", "ROW")] - } + layout <- wrap_layout(id, dims, params$dir) panels <- vec_cbind(layout, base) panels <- panels[order(panels$PANEL), , drop = FALSE] @@ -576,3 +582,31 @@ measure_axes <- function(empty_idx, axis, margin = 1L, shift = 0) { cm[set_zero] <- 0 unit(apply(cm, margin, max), "cm") } + +wrap_layout <- function(id, dims, dir) { + as.table <- TRUE + n <- attr(id, "n") + + ROW <- switch( + dir, + lt = , rt = (id - 1L) %/% dims[2] + 1L, + tl = , tr = (id - 1L) %% dims[1] + 1L, + lb = , rb = dims[1] - (id - 1L) %/% dims[2], + bl = , br = dims[1] - (id - 1L) %% dims[1] + ) + + COL <- switch( + dir, + lt = , lb = (id - 1L) %% dims[2] + 1L, + tl = , bl = (id - 1L) %/% dims[1] + 1L, + rt = , rb = dims[2] - (id - 1L) %% dims[2], + tr = , br = dims[2] - (id - 1L) %/% dims[1] + ) + + data_frame0( + PANEL = factor(id, levels = seq_len(n)), + ROW = as.integer(ROW), + COL = as.integer(COL), + .size = length(id) + ) +} diff --git a/man/facet_wrap.Rd b/man/facet_wrap.Rd index b765efe1dd..d431f0098a 100644 --- a/man/facet_wrap.Rd +++ b/man/facet_wrap.Rd @@ -65,7 +65,12 @@ data will automatically be dropped. If \code{FALSE}, all factor levels will be shown, regardless of whether or not they appear in the data.} \item{dir}{Direction: either \code{"h"} for horizontal, the default, or \code{"v"}, -for vertical.} +for vertical. When \code{"h"} or \code{"v"} will be combined with \code{as.table} to +set final layout. Alternatively, a combination of \code{"t"} (top) or +\code{"b"} (bottom) with \code{"l"} (left) or \code{"r"} (right) to set a layout directly. +These two letters give the starting position and the first letter gives +the growing direction. For example \code{"rt"} will place the first panel in +the top-right and starts filling in panels right-to-left.} \item{strip.position}{By default, the labels are displayed on the top of the plot. Using \code{strip.position} it is possible to place the labels on @@ -146,6 +151,14 @@ ggplot(economics_long, aes(date, value)) + facet_wrap(vars(variable), scales = "free_y", nrow = 2, strip.position = "top") + theme(strip.background = element_blank(), strip.placement = "outside") } + +# The two letters determine the starting position, so 'tr' starts +# in the top-right. +# The first letter determines direction, so 'tr' fills top-to-bottom. +# `dir = "tr"` is equivalent to `dir = "v", as.table = FALSE` +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + facet_wrap(vars(class), dir = "tr") } \seealso{ The \href{https://ggplot2-book.org/facet#sec-facet-wrap}{facet wrap section} of the online ggplot2 book. diff --git a/tests/testthat/test-facet-layout.R b/tests/testthat/test-facet-layout.R index c22d1c36ca..70a4ed30e8 100644 --- a/tests/testthat/test-facet-layout.R +++ b/tests/testthat/test-facet-layout.R @@ -32,6 +32,44 @@ test_that("grid: includes all combinations", { expect_equal(nrow(all), 4) }) +test_that("wrap: layout sorting is correct", { + + dummy <- list(data_frame0(x = 1:5)) + + test <- panel_layout(facet_wrap(~x, dir = "lt"), dummy) + expect_equal(test$ROW, rep(c(1,2), c(3, 2))) + expect_equal(test$COL, c(1:3, 1:2)) + + test <- panel_layout(facet_wrap(~x, dir = "tl"), dummy) + expect_equal(test$ROW, c(1, 2, 1, 2, 1)) + expect_equal(test$COL, c(1, 1, 2, 2, 3)) + + test <- panel_layout(facet_wrap(~x, dir = "lb"), dummy) + expect_equal(test$ROW, c(2, 2, 2, 1, 1)) + expect_equal(test$COL, c(1, 2, 3, 1, 2)) + + test <- panel_layout(facet_wrap(~x, dir = "bl"), dummy) + expect_equal(test$ROW, c(2, 1, 2, 1, 2)) + expect_equal(test$COL, c(1, 1, 2, 2, 3)) + + test <- panel_layout(facet_wrap(~x, dir = "rt"), dummy) + expect_equal(test$ROW, c(1, 1, 1, 2, 2)) + expect_equal(test$COL, c(3, 2, 1, 3, 2)) + + test <- panel_layout(facet_wrap(~x, dir = "tr"), dummy) + expect_equal(test$ROW, c(1, 2, 1, 2, 1)) + expect_equal(test$COL, c(3, 3, 2, 2, 1)) + + test <- panel_layout(facet_wrap(~x, dir = "rb"), dummy) + expect_equal(test$ROW, c(2, 2, 2, 1, 1)) + expect_equal(test$COL, c(3, 2, 1, 3, 2)) + + test <- panel_layout(facet_wrap(~x, dir = "br"), dummy) + expect_equal(test$ROW, c(2, 1, 2, 1, 2)) + expect_equal(test$COL, c(3, 3, 2, 2, 1)) + +}) + test_that("wrap and grid are equivalent for 1d data", { rowg <- panel_layout(facet_grid(a~.), list(a)) roww <- panel_layout(facet_wrap(~a, ncol = 1), list(a)) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index e658092339..01383378bc 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -1054,11 +1054,7 @@ FacetBootstrap <- ggproto("FacetBootstrap", FacetWrap, dims <- wrap_dims(params$n, params$nrow, params$ncol) layout <- data.frame(PANEL = factor(id)) - if (params$as.table) { - layout$ROW <- as.integer((id - 1L) %/% dims[2] + 1L) - } else { - layout$ROW <- as.integer(dims[1] - (id - 1L) %/% dims[2]) - } + layout$ROW <- as.integer((id - 1L) %/% dims[2] + 1L) layout$COL <- as.integer((id - 1L) %% dims[2] + 1L) layout <- layout[order(layout$PANEL), , drop = FALSE]