From a4c38e6c92db834d823e101a4e92ff5a17ad9efd Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 22 Apr 2024 15:37:21 +0200 Subject: [PATCH 1/6] resolve `dir`/`as.table` --- R/facet-wrap.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 3fcd05eacd..ded6add070 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -101,7 +101,15 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", 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 +157,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, From a23e45e872312a603ece5b20d1e956d49458d5ed Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 22 Apr 2024 16:29:56 +0200 Subject: [PATCH 2/6] new wrap layouts --- R/facet-wrap.R | 51 ++++++++++++++++++++++++++++++++--------------- man/facet_wrap.Rd | 7 ++++++- 2 files changed, 41 insertions(+), 17 deletions(-) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index ded6add070..23d0c8de2b 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 @@ -196,21 +201,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] @@ -583,3 +574,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..e9fdc33019 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 From 676f6890f4c3551e806e7661e0479efdef17ba74 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 22 Apr 2024 16:30:05 +0200 Subject: [PATCH 3/6] add tests --- tests/testthat/test-facet-layout.R | 38 ++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/tests/testthat/test-facet-layout.R b/tests/testthat/test-facet-layout.R index 9ab6e80eeb..e0c8df1ff0 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)) From 3c4ae066425e131200a2a1dea865aca93663dad3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 22 Apr 2024 16:31:39 +0200 Subject: [PATCH 4/6] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index eef76f1cec..55babfff23 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # ggplot2 (development version) +* `facet_wrap()` has new options for the `dir` argument to more precisely + control panel directions (@teunbrand, #5212) * When facets coerce the faceting variables to factors, the 'ordered' class is dropped (@teunbrand, #5666). * `coord_map()` and `coord_polar()` throw informative warnings when used From 2e3a322adb139feae356f8ec054d83898cff10db Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 26 Apr 2024 13:46:53 +0200 Subject: [PATCH 5/6] skip `as.table` option in vignette --- vignettes/extending-ggplot2.Rmd | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) 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] From 6f2ce12a8b1b84c77d43135a43238d5c2d330530 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 29 Apr 2024 10:30:52 +0200 Subject: [PATCH 6/6] add example --- R/facet-wrap.R | 8 ++++++++ man/facet_wrap.Rd | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 23d0c8de2b..f69cdd8f95 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -100,6 +100,14 @@ 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", diff --git a/man/facet_wrap.Rd b/man/facet_wrap.Rd index e9fdc33019..d431f0098a 100644 --- a/man/facet_wrap.Rd +++ b/man/facet_wrap.Rd @@ -151,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.