Axes at interior panels #4064

NEWS.md

@@ -1,5 +1,9 @@
 # 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).
 * When legend titles are larger than the legend, title justification extends
   to the placement of keys and labels (#1903).
 

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)
 }

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) {

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
+}

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()
@@ -112,7 +122,8 @@ 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,
-                       facets = deprecated()) {
+                       facets = deprecated(), axes = "margins",
+                       axis_labels = "all") {
   # `facets` is deprecated and renamed to `rows`
   if (lifecycle::is_present(facets)) {
     deprecate_warn0("2.2.0", "facet_grid(facets)", "facet_grid(rows)")
@@ -137,6 +148,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 +175,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 +332,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)])
@@ -367,17 +407,53 @@ 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) {
+      # Take facet_wrap approach to axis placement
+      axes$x$top <- matrix(axes$x$top[x_axis_order],
+                           nrow = nrow, ncol = ncol, byrow = TRUE)
+      panel_table <- weave_tables_row(
+        panel_table, axes$x$top, -1,
+        unit(apply(axes$x$top, 1, max_height, value_only = TRUE), "cm"),
+        name = "axis-t", z = 3
+      )
+      axes$x$bottom <- matrix(axes$x$bottom[x_axis_order],
+                              nrow = nrow, ncol = ncol, byrow = TRUE)
+      panel_table <- weave_tables_row(
+        panel_table, axes$x$bottom, 0,
+        unit(apply(axes$x$bottom, 1, max_height, value_only = TRUE), "cm"),
+        name = "axis-b", z = 3
+      )
+    } 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) {
+      # Take facet_wrap approach to axis placement
+      axes$y$left <- matrix(axes$y$left[y_axis_order],
+                            nrow = nrow, ncol = ncol, byrow = TRUE)
+      panel_table <- weave_tables_col(
+        panel_table, axes$y$left, -1,
+        unit(apply(axes$y$left, 2, max_width, value_only = TRUE), "cm"),
+        name = "axis-l", z = 3
+      )
+      axes$y$right <- matrix(axes$y$right[y_axis_order],
+                             nrow = nrow, ncol = ncol, byrow = TRUE)
+      panel_table <- weave_tables_col(
+        panel_table, axes$y$right, 0,
+        unit(apply(axes$y$right, 2, max_width, value_only = TRUE), "cm"),
+        name = "axis-r", z = 3
+      )
+    } 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")