Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

POC: replace facet_grid(switch) with strip.position #6161

Draft
wants to merge 4 commits into
base: main
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 29 additions & 16 deletions R/facet-grid-.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,11 +39,9 @@
#' @param as.table If `TRUE`, the default, the facets are laid out like
#' a table with highest values at the bottom-right. If `FALSE`, the
#' facets are laid out like a plot with the highest value at the top-right.
#' @param switch By default, the labels are displayed on the top and
#' right of the plot. If `"x"`, the top labels will be
#' displayed to the bottom. If `"y"`, the right-hand side
#' labels will be displayed to the left. Can also be set to
#' `"both"`.
#' @param strip.position One or more of `"top"`, `"right"`, `"bottom"` and
#' `"left"`, indicating where strips should be placed. When `NULL` (default),
#' strips are placed on the top and on the right.
#' @param shrink If `TRUE`, will shrink scales to fit output of
#' statistics, not raw data. If `FALSE`, will be range of raw data
#' before statistical summary.
Expand All @@ -57,6 +55,8 @@
#' 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 switch `r lifecycle::badge("deprecated")` Please use
#' `strip.position` instead.
#' @param facets `r lifecycle::badge("deprecated")` Please use `rows`
#' and `cols` instead.
#' @param axes Determines which axes will be drawn. When `"margins"`
Expand Down Expand Up @@ -129,9 +129,9 @@
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,
strip.position = NULL, drop = TRUE, margins = FALSE,
axes = "margins", axis.labels = "all",
facets = deprecated()) {
facets = deprecated(), switch = deprecated()) {
# `facets` is deprecated and renamed to `rows`
if (lifecycle::is_present(facets)) {
deprecate_warn0("2.2.0", "facet_grid(facets)", "facet_grid(rows)")
Expand Down Expand Up @@ -170,8 +170,21 @@
y = !draw_axes$y || any(axis_labels %in% c("all_y", "all"))
)

if (!is.null(switch)) {
arg_match0(switch, c("both", "x", "y"))
if (lifecycle::is_present(switch)) {
deprecate_soft0("3.6.0", "facet_grid(switch)", "facet_grid(strip.position)")
switch <- arg_match0(switch, c("both", "x", "y"))
strip.position <- strip.position %||%
base::switch(switch, both = c("bottom", "left"), x = "bottom", y = "left")

Check warning on line 177 in R/facet-grid-.R

View check run for this annotation

Codecov / codecov/patch

R/facet-grid-.R#L174-L177

Added lines #L174 - L177 were not covered by tests
}
check_character(strip.position, allow_null = TRUE)
if (!is.waive(strip.position) && !all(strip.position %in% .trbl)) {
cli::cli_abort("{.arg strip.position} can only contain {.or {.val {(.trbl)}}}.")
}
if (!any(c("top", "bottom") %in% strip.position)) {
strip.position <- c(strip.position, "top")
}
if (!any(c("left", "right") %in% strip.position)) {
strip.position <- c(strip.position, "right")
}

facets_list <- grid_as_facets_list(rows, cols)
Expand All @@ -183,7 +196,7 @@
shrink = shrink,
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,
as.table = as.table, drop = drop, strip.position = strip.position,
draw_axes = draw_axes, axis_labels = axis_labels)
)
}
Expand Down Expand Up @@ -396,35 +409,35 @@

padding <- convertUnit(calc_element("strip.switch.pad.grid", theme), "cm")

switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")
inside_x <- (calc_element("strip.placement.x", theme) %||% "inside") == "inside"
shift_x <- if (inside_x) 1 else 2

if (switch_x) {
if ("bottom" %in% params$strip.position) {
space <- if (!inside_x & table_has_grob(table, "axis-b")) padding
table <- seam_table(
table, strips$x$bottom, side = "bottom", name = "strip-b",
shift = shift_x, z = 2, clip = "off", spacing = space
)
} else {
}
if ("top" %in% params$strip.position) {
space <- if (!inside_x & table_has_grob(table, "axis-t")) padding
table <- seam_table(
table, strips$x$top, side = "top", name = "strip-t",
shift = shift_x, z = 2, clip = "off", spacing = space
)
}

switch_y <- !is.null(params$switch) && params$switch %in% c("both", "y")
inside_y <- (calc_element("strip.placement.y", theme) %||% "inside") == "inside"
shift_y <- if (inside_y) 1 else 2

if (switch_y) {
if ("left" %in% params$strip.position) {
space <- if (!inside_y & table_has_grob(table, "axis-l")) padding
table <- seam_table(
table, strips$y$left, side = "left", name = "strip-l",
shift = shift_y, z = 2, clip = "off", spacing = space
)
} else {
}
if ("right" %in% params$strip.position) {
space <- if (!inside_y & table_has_grob(table, "axis-r")) padding
table <- seam_table(
table, strips$y$right, side = "right", name = "strip-r",
Expand Down
16 changes: 9 additions & 7 deletions man/facet_grid.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 2 additions & 5 deletions man/facet_wrap.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion tests/testthat/_snaps/facet-strips.md
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# facet_grid() warns about bad switch input

`switch` must be one of "both", "x", or "y", not "z".
`strip.position` can only contain "top", "right", "bottom", or "left".

12 changes: 6 additions & 6 deletions tests/testthat/test-facet-strips.R
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ test_that("facet_grid() builds correct output", {
})

test_that("facet_grid() switches to 'x'", {
grid_x <- p + facet_grid(am ~ cyl, switch = "x")
grid_x <- p + facet_grid(am ~ cyl, strip.position = "bottom")

grid_x_expected <- list(
t = c(6, 6, 6, 3, 5),
Expand All @@ -95,7 +95,7 @@ test_that("facet_grid() switches to 'x'", {
})

test_that("facet_grid() switches to 'y'", {
grid_y <- p + facet_grid(am ~ cyl, switch = "y")
grid_y <- p + facet_grid(am ~ cyl, strip.position = "left")

grid_y_expected <- list(
t = c(3, 3, 3, 4, 6),
Expand All @@ -108,7 +108,7 @@ test_that("facet_grid() switches to 'y'", {
})

test_that("facet_grid() switches to both 'x' and 'y'", {
grid_xy <- p + facet_grid(am ~ cyl, switch = "both")
grid_xy <- p + facet_grid(am ~ cyl, strip.position = c("bottom", "left"))

grid_xy_expected <- list(
t = c(6, 6, 6, 3, 5),
Expand All @@ -121,7 +121,7 @@ test_that("facet_grid() switches to both 'x' and 'y'", {
})

test_that("facet_grid() warns about bad switch input", {
expect_snapshot_error(facet_grid(am ~ cyl, switch = "z"))
expect_snapshot_error(facet_grid(am ~ cyl, strip.position = "z"))
})

test_that("strips can be removed", {
Expand Down Expand Up @@ -165,7 +165,7 @@ test_that("padding is only added if axis is present", {

# Inverse should be true when strips are switched
p <- ggplot(data = mpg, aes(x = displ, y = hwy)) +
facet_grid(year ~ drv, switch = "both") +
facet_grid(year ~ drv, strip.position = c("bottom", "left")) +
theme(
strip.placement = "outside",
strip.switch.pad.grid = unit(10, "mm")
Expand All @@ -186,7 +186,7 @@ test_that("padding is only added if axis is present", {
})

test_that("y strip labels are rotated when strips are switched", {
switched <- p + facet_grid(am ~ cyl, switch = "both")
switched <- p + facet_grid(am ~ cyl, strip.position = c("bottom", "left"))

expect_doppelganger("switched facet strips", switched)
})
Expand Down
Loading