Axes at interior panels #4064 (#4467)

* Add axis drawing to fixed scale facet_wrap * Add draw.axis argument to facet_grid * Switch to facet_wrap approach when drawing additional axis in facet_grid * Document draw.axis argument * Add unit tests for draw.axes * resolve conflict * Rename user-facing argument to 'axes' * Sync latest changes * Mechanism for label suppression * censoring for wrap * Label censoring for grid * Test censoring logic * Label censoring for wrap * Test logic for wrap censoring * Visual test for censoring * Add NEWS bullet * Better panel spacing with empty panels * Only draw first in stack * Funnel radial r-axis through CoordCartesian * Fix order of theta grobs * use dot.case instead of snake_case for argument * use dot.case instead of snake_case for argument * More snake_case to dot.case conversions * New args before deprecated args * add examples * add `weave_axes` helper * use helper
tidyverse · Dec 14, 2023 · 204c238 · 204c238
1 parent 0f9fb64
commit 204c238
Show file tree

Hide file tree

Showing 14 changed files with 1,079 additions and 69 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,10 @@
 # ggplot2 (development version)
 
+* The new argument `axes` in `facet_grid()` and `facet_wrap()` controls the
+ display of axes at interior panel positions. Additionally, the `axis.labels`
+ argument can be used to only draw tick marks or fully labelled axes 
+ (@teunbrand, #4064).
+
 * The `name` argument in most scales is now explicitly the first argument 
  (#5535)
 

diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R
@@ -117,15 +117,27 @@ CoordCartesian <- ggproto("CoordCartesian", Coord,
 
  render_axis_h = function(panel_params, theme) {
  list(
- top = panel_guides_grob(panel_params$guides, position = "top", theme = theme),
- bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme)
+ top = panel_guides_grob(
+ panel_params$guides, position = "top",
+ theme = theme, labels = panel_params$draw_labels$top
+ ),
+ bottom = panel_guides_grob(
+ panel_params$guides, position = "bottom",
+ theme = theme, labels = panel_params$draw_labels$bottom
+ )
  )
  },
 
  render_axis_v = function(panel_params, theme) {
  list(
- left = panel_guides_grob(panel_params$guides, position = "left", theme = theme),
- right = panel_guides_grob(panel_params$guides, position = "right", theme = theme)
+ left = panel_guides_grob(
+ panel_params$guides, position = "left",
+ theme = theme, labels = panel_params$draw_labels$left
+ ),
+ right = panel_guides_grob(
+ panel_params$guides, position = "right",
+ theme = theme, labels = panel_params$draw_labels$right
+ )
  )
  }
 )
@@ -146,10 +158,11 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
  view_scales
 }
 
-panel_guides_grob <- function(guides, position, theme) {
+panel_guides_grob <- function(guides, position, theme, labels = NULL) {
  if (!inherits(guides, "Guides")) {
  return(zeroGrob())
  }
  pair <- guides$get_position(position)
+ pair$params$draw_label <- labels %||% NULL
  pair$guide$draw(theme, params = pair$params)
 }
diff --git a/R/coord-radial.R b/R/coord-radial.R
@@ -241,20 +241,14 @@ CoordRadial <- ggproto("CoordRadial", Coord,
  if (self$r_axis_inside) {
  return(list(left = zeroGrob(), right = zeroGrob()))
  }
- list(
- left = panel_guides_grob(panel_params$guides, position = "left", theme = theme),
- right = panel_guides_grob(panel_params$guides, position = "right", theme = theme)
- )
+ CoordCartesian$render_axis_v(panel_params, theme)
  },
 
  render_axis_h = function(self, panel_params, theme) {
  if (self$r_axis_inside) {
  return(list(top = zeroGrob(), bottom = zeroGrob()))
  }
- list(
- top = panel_guides_grob(panel_params$guides, position = "top", theme = theme),
- bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme)
- )
+ CoordCartesian$render_axis_h(panel_params, theme)
  },
 
  render_bg = function(self, panel_params, theme) {

diff --git a/R/facet-.R b/R/facet-.R
@@ -701,3 +701,31 @@ render_strips <- function(x = NULL, y = NULL, labeller, theme) {
  y = build_strip(y, labeller, theme, FALSE)
  )
 }
+
+
+censor_labels <- function(ranges, layout, labels) {
+ if (labels$x && labels$y) {
+ return(ranges)
+ }
+ draw <- matrix(
+ TRUE, length(ranges), 4,
+ dimnames = list(NULL, c("top", "bottom", "left", "right"))
+ )
+
+ if (!labels$x) {
+ xmax <- stats::ave(layout$ROW, layout$COL, FUN = max)
+ xmin <- stats::ave(layout$ROW, layout$COL, FUN = min)
+ draw[which(layout$ROW != xmax), "bottom"] <- FALSE
+ draw[which(layout$ROW != xmin), "top"] <- FALSE
+ }
+ if (!labels$y) {
+ ymax <- stats::ave(layout$COL, layout$ROW, FUN = max)
+ ymin <- stats::ave(layout$COL, layout$ROW, FUN = min)
+ draw[which(layout$COL != ymax), "right"] <- FALSE
+ draw[which(layout$COL != ymin), "left"] <- FALSE
+ }
+ for (i in seq_along(ranges)) {
+ ranges[[i]]$draw_labels <- as.list(draw[i, ])
+ }
+ ranges
+}
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
@@ -59,6 +59,16 @@ NULL
 #' variables for which margins are to be created.
 #' @param facets `r lifecycle::badge("deprecated")` Please use `rows`
 #' and `cols` instead.
+#' @param axes Determines which axes will be drawn. When `"margins"`
+#' (default), axes will be drawn at the exterior margins. `"all_x"` and
+#' `"all_y"` will draw the respective axes at the interior panels too, whereas
+#' `"all"` will draw all axes at all panels.
+#' @param axis.labels Determines whether to draw labels for interior axes when
+#' the `axes` argument is not `"margins"`. When `"all"` (default), all
+#' interior axes get labels. When `"margins"`, only the exterior axes get
+#' labels and the interior axes get none. When `"all_x"` or `"all_y"`, only
+#' draws the labels at the interior axes in the x- or y-direction
+#' respectively.
 #' @export
 #' @examples
 #' p <- ggplot(mpg, aes(displ, cty)) + geom_point()
@@ -79,6 +89,12 @@ NULL
 #' facet_grid(cols = vars(cyl)) +
 #' geom_point(data = df, colour = "red", size = 2)
 #'
+#' # When scales are constant, duplicated axes can be shown with
+#' # or without labels
+#' ggplot(mpg, aes(cty, hwy)) +
+#' geom_point() +
+#' facet_grid(year ~ drv, axes = "all", axis.labels = "all_x")
+#'
 #' # Free scales -------------------------------------------------------
 #' # You can also choose whether the scales should be constant
 #' # across all panels (the default), or whether they should be allowed
@@ -112,6 +128,7 @@ 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,
+ axes = "margins", axis.labels = "all",
  facets = deprecated()) {
  # `facets` is deprecated and renamed to `rows`
  if (lifecycle::is_present(facets)) {
@@ -137,6 +154,20 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
  y = any(space %in% c("free_y", "free"))
  )
 
+ draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+ draw_axes <- list(
+ x = any(draw_axes %in% c("all_x", "all")),
+ y = any(draw_axes %in% c("all_y", "all"))
+ )
+
+ # Omitting labels is special-cased internally, so even when no internal axes
+ # are to be drawn, register as labelled.
+ axis_labels <- arg_match0(axis.labels, c("margins", "all_x", "all_y", "all"))
+ axis_labels <- list(
+ x = !draw_axes$x || any(axis_labels %in% c("all_x", "all")),
+ y = !draw_axes$y || any(axis_labels %in% c("all_y", "all"))
+ )
+
  if (!is.null(switch)) {
  arg_match0(switch, c("both", "x", "y"))
  }
@@ -150,7 +181,8 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
  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, switch = switch, drop = drop,
+ draw_axes = draw_axes, axis_labels = axis_labels)
  )
 }
 
@@ -306,8 +338,22 @@ FacetGrid <- ggproto("FacetGrid", Facet,
  cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales.")
  }
 
- cols <- which(layout$ROW == 1)
- rows <- which(layout$COL == 1)
+ if (!params$axis_labels$x) {
+ cols <- seq_len(nrow(layout))
+ x_axis_order <- as.integer(layout$PANEL[order(layout$ROW, layout$COL)])
+ } else {
+ cols <- which(layout$ROW == 1)
+ x_axis_order <- layout$COL
+ }
+ if (!params$axis_labels$y) {
+ rows <- seq_len(nrow(layout))
+ y_axis_order <- as.integer(layout$PANEL[order(layout$ROW, layout$COL)])
+ } else {
+ rows <- which(layout$COL == 1)
+ y_axis_order <- layout$ROW
+ }
+
+ ranges <- censor_labels(ranges, layout, params$axis_labels)
  axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
 
  col_vars <- unique0(layout[names(params$cols)])
@@ -334,7 +380,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
  }
  ncol <- max(layout$COL)
  nrow <- max(layout$ROW)
- panel_table <- matrix(panels, nrow = nrow, ncol = ncol, byrow = TRUE)
+ mtx <- function(x) matrix(x, nrow = nrow, ncol = ncol, byrow = TRUE)
+ panel_table <- mtx(panels)
 
  # @kohske
  # Now size of each panel is calculated using PANEL$ranges, which is given by
@@ -358,7 +405,7 @@ FacetGrid <- ggproto("FacetGrid", Facet,
  }
 
  panel_table <- gtable_matrix("layout", panel_table,
- panel_widths, panel_heights, respect = respect, clip = coord$clip, z = matrix(1, ncol = ncol, nrow = nrow))
+ panel_widths, panel_heights, respect = respect, clip = coord$clip, z = mtx(1))
  panel_table$layout$name <- paste0('panel-', rep(seq_len(nrow), ncol), '-', rep(seq_len(ncol), each = nrow))
 
  panel_table <- gtable_add_col_space(panel_table,
@@ -367,17 +414,27 @@ FacetGrid <- ggproto("FacetGrid", Facet,
  theme$panel.spacing.y %||% theme$panel.spacing)
 
  # Add axes
- panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
- panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
- panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
- panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
- panel_pos_col <- panel_cols(panel_table)
- panel_pos_rows <- panel_rows(panel_table)
+ if (params$draw_axes$x) {
+ axes$x <- lapply(axes$x, function(x) mtx(x[x_axis_order]))
+ panel_table <- weave_axes(panel_table, axes$x)$panels
+ } else {
+ panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
+ panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
+ panel_pos_col <- panel_cols(panel_table)
+ panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off", name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
+ panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off", name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
+ }
 
- panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off", name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off", name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off", name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off", name = paste0("axis-r-", seq_along(axes$y$right)), z= 3)
+ if (params$draw_axes$y) {
+ axes$y <- lapply(axes$y, function(y) mtx(y[y_axis_order]))
+ panel_table <- weave_axes(panel_table, axes$y)$panels
+ } else {
+ panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
+ panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
+ panel_pos_rows <- panel_rows(panel_table)
+ panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off", name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
+ panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off", name = paste0("axis-r-", seq_along(axes$y$right)), z= 3)
+ }
 
  # Add strips
  switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")