diff --git a/NEWS.md b/NEWS.md
index 5d47b01f86..4bfdf74f6e 100644
--- 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
index 95e125cdc0..74f46433db 100644
--- 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
index 9f2ede8cce..1f0c778e5f 100644
--- 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
index f26b602f89..c2d7dc8df7 100644
--- 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
index 4afccc71f8..823170d0ce 100644
--- 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")
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 00c65dd49a..6058a57ad6 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -24,6 +24,16 @@ NULL
#' "bottom", "left", "right")}
#' @param dir Direction: either `"h"` for horizontal, the default, or `"v"`,
#' for vertical.
+#' @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
+#' panels too, whereas `"all"` will draw all axes at all panels.
+#' @param axis.labels Determines whether to draw labels for interior axes when
+#' the scale is fixed and the `axis` 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.
#' @inheritParams facet_grid
#' @export
#' @examples
@@ -61,6 +71,12 @@ NULL
#' geom_point() +
#' facet_wrap(vars(class), scales = "free")
#'
+#' # When scales are constant, duplicated axes can be shown with
+#' # or without labels
+#' ggplot(mpg, aes(displ, hwy)) +
+#' geom_point() +
+#' facet_wrap(vars(class), axes = "all", axis.labels = "all_y")
+#'
#' # To repeat the same data in every panel, simply construct a data frame
#' # that does not contain the faceting variable.
#' ggplot(mpg, aes(displ, hwy)) +
@@ -80,7 +96,8 @@ NULL
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') {
+ 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"))
free <- list(
@@ -88,6 +105,21 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
y = any(scales %in% c("free_y", "free"))
)
+ # If scales are free, always draw the axes
+ draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+ draw_axes <- list(
+ x = free$x || any(draw_axes %in% c("all_x", "all")),
+ y = free$y || any(draw_axes %in% c("all_y", "all"))
+ )
+
+ # Omitting labels is special-cased internally, so only omit labels if
+ # scales are not free and the axis is to be drawn
+ axis_labels <- arg_match0(axis.labels, c("margins", "all_x", "all_y", "all"))
+ axis_labels <- list(
+ x = free$x || !draw_axes$x || any(axis_labels %in% c("all_x", "all")),
+ y = free$y || !draw_axes$y || any(axis_labels %in% c("all_y", "all"))
+ )
+
# Check for deprecated labellers
labeller <- check_labeller(labeller)
@@ -121,7 +153,9 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
ncol = ncol,
nrow = nrow,
labeller = labeller,
- dir = dir
+ dir = dir,
+ draw_axes = draw_axes,
+ axis_labels = axis_labels
)
)
}
@@ -241,6 +275,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
panels <- panels[panel_order]
panel_pos <- convertInd(layout$ROW, layout$COL, nrow)
+ x_axis_order <- if (params$axis_labels$x) layout$SCALE_X else seq(n)
+ y_axis_order <- if (params$axis_labels$y) layout$SCALE_Y else seq(n)
+
+ ranges <- censor_labels(ranges, layout, params$axis_labels)
axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
if (length(params$facets) == 0) {
@@ -285,37 +323,23 @@ FacetWrap <- ggproto("FacetWrap", Facet,
# Add axes
axis_mat_x_top <- empty_table
- axis_mat_x_top[panel_pos] <- axes$x$top[layout$SCALE_X]
+ axis_mat_x_top[panel_pos] <- axes$x$top[x_axis_order]
axis_mat_x_bottom <- empty_table
- axis_mat_x_bottom[panel_pos] <- axes$x$bottom[layout$SCALE_X]
+ axis_mat_x_bottom[panel_pos] <- axes$x$bottom[x_axis_order]
axis_mat_y_left <- empty_table
- axis_mat_y_left[panel_pos] <- axes$y$left[layout$SCALE_Y]
+ axis_mat_y_left[panel_pos] <- axes$y$left[y_axis_order]
axis_mat_y_right <- empty_table
- axis_mat_y_right[panel_pos] <- axes$y$right[layout$SCALE_Y]
- if (!params$free$x) {
+ axis_mat_y_right[panel_pos] <- axes$y$right[y_axis_order]
+ if (!(params$free$x || params$draw_axes$x)) {
axis_mat_x_top[-1,]<- list(zeroGrob())
axis_mat_x_bottom[-nrow,]<- list(zeroGrob())
}
- if (!params$free$y) {
+ if (!(params$free$y || params$draw_axes$y)) {
axis_mat_y_left[, -1] <- list(zeroGrob())
axis_mat_y_right[, -ncol] <- list(zeroGrob())
}
- axis_height_top <- unit(
- apply(axis_mat_x_top, 1, max_height, value_only = TRUE),
- "cm"
- )
- axis_height_bottom <- unit(
- apply(axis_mat_x_bottom, 1, max_height, value_only = TRUE),
- "cm"
- )
- axis_width_left <- unit(
- apply(axis_mat_y_left, 2, max_width, value_only = TRUE),
- "cm"
- )
- axis_width_right <- unit(
- apply(axis_mat_y_right, 2, max_width, value_only = TRUE),
- "cm"
- )
+
+
# Add back missing axes
if (any(empties)) {
row_ind <- row(empties)
@@ -330,7 +354,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- x_axes <- axes$x$bottom[layout$SCALE_X[panels]]
+ x_axes <- axes$x$bottom[x_axis_order[panels]]
if (params$strip.position == "bottom" &&
!inside &&
any(!vapply(x_axes, is.zero, logical(1))) &&
@@ -349,7 +373,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- x_axes <- axes$x$top[layout$SCALE_X[panels]]
+ x_axes <- axes$x$top[x_axis_order[panels]]
if (params$strip.position == "top" &&
!inside &&
any(!vapply(x_axes, is.zero, logical(1))) &&
@@ -368,7 +392,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- y_axes <- axes$y$right[layout$SCALE_Y[panels]]
+ y_axes <- axes$y$right[y_axis_order[panels]]
if (params$strip.position == "right" &&
!inside &&
any(!vapply(y_axes, is.zero, logical(1))) &&
@@ -387,7 +411,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- y_axes <- axes$y$left[layout$SCALE_Y[panels]]
+ y_axes <- axes$y$left[y_axis_order[panels]]
if (params$strip.position == "left" &&
!inside &&
any(!vapply(y_axes, is.zero, logical(1))) &&
@@ -398,10 +422,16 @@ FacetWrap <- ggproto("FacetWrap", Facet,
}
}
}
- panel_table <- weave_tables_row(panel_table, axis_mat_x_top, -1, axis_height_top, "axis-t", 3)
- panel_table <- weave_tables_row(panel_table, axis_mat_x_bottom, 0, axis_height_bottom, "axis-b", 3)
- panel_table <- weave_tables_col(panel_table, axis_mat_y_left, -1, axis_width_left, "axis-l", 3)
- panel_table <- weave_tables_col(panel_table, axis_mat_y_right, 0, axis_width_right, "axis-r", 3)
+ panel_table <- weave_axes(
+ panel_table,
+ axes = list(
+ top = axis_mat_x_top, bottom = axis_mat_x_bottom,
+ left = axis_mat_y_left, right = axis_mat_y_right
+ ),
+ empty = empties
+ )
+ axis_size <- panel_table$sizes
+ panel_table <- panel_table$panels
strip_padding <- convertUnit(theme$strip.switch.pad.wrap, "cm")
strip_name <- paste0("strip-", substr(params$strip.position, 1, 1))
@@ -411,10 +441,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
if (params$strip.position == "top") {
placement <- if (inside_x) -1 else -2
- strip_pad <- axis_height_top
+ strip_pad <- axis_size$top
} else {
placement <- if (inside_x) 0 else 1
- strip_pad <- axis_height_bottom
+ strip_pad <- axis_size$bottom
}
strip_height <- unit(apply(strip_mat, 1, max_height, value_only = TRUE), "cm")
panel_table <- weave_tables_row(panel_table, strip_mat, placement, strip_height, strip_name, 2, coord$clip)
@@ -426,10 +456,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
if (params$strip.position == "left") {
placement <- if (inside_y) -1 else -2
- strip_pad <- axis_width_left
+ strip_pad <- axis_size$left
} else {
placement <- if (inside_y) 0 else 1
- strip_pad <- axis_width_right
+ strip_pad <- axis_size$right
}
strip_pad[as.numeric(strip_pad) != 0] <- strip_padding
strip_width <- unit(apply(strip_mat, 2, max_width, value_only = TRUE), "cm")
@@ -505,3 +535,41 @@ weave_tables_row <- function(table, table2, row_shift, row_height, name, z = 1,
}
table
}
+
+weave_axes <- function(panels, axes, empty = NULL, z = 3L) {
+ empty <- which(empty %||% matrix(logical(), 0, 0), arr.ind = TRUE)
+ sides <- match(names(axes), .trbl)
+ margin <- c(1L, 2L, 1L, 2L)[sides]
+ shift <- c(1L, -1L, -1L, 1L)[sides]
+ sizes <- Map(
+ measure_axes, axis = axes, margin = margin, shift = shift,
+ MoreArgs = list(empty_idx = empty)
+ )
+ names <- paste0("axis-", substr(names(axes), 1, 1))
+ shift <- c(-1L, 0L, 0L, -1L)[sides]
+ weave <- list(weave_tables_row, weave_tables_col)[c(1, 2, 1, 2)][sides]
+ for (i in seq_along(axes)) {
+ panels <- weave[[i]](panels, axes[[i]], shift[i], sizes[[i]], names[i], z = z)
+ }
+ list(panels = panels, sizes = sizes)
+}
+
+# Measures the size of axes while ignoring those bordering empty panels
+measure_axes <- function(empty_idx, axis, margin = 1L, shift = 0) {
+ dim <- dim(axis)
+
+ measure <- switch(margin, height_cm, width_cm)
+ cm <- matrix(measure(axis), dim[1], dim[2])
+
+ if (nrow(empty_idx) > 0 && shift != 0) {
+ set_zero <- empty_idx
+ set_zero[, margin] <- set_zero[, margin] + shift
+ keep <- set_zero[, margin] <= dim[margin] & set_zero[, margin] > 0
+ set_zero <- set_zero[keep, , drop = FALSE]
+ } else {
+ set_zero <- matrix(integer(), nrow = 0, ncol = 2)
+ }
+
+ cm[set_zero] <- 0
+ unit(apply(cm, margin, max), "cm")
+}
diff --git a/R/guide-.R b/R/guide-.R
index b90c7b93f4..e185ec67b0 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -314,9 +314,13 @@ Guide <- ggproto(
# Build grobs
grobs <- list(
title = self$build_title(params$title, elems, params),
- labels = self$build_labels(key, elems, params),
ticks = self$build_ticks(key, elems, params)
)
+ if (params$draw_label %||% TRUE) {
+ grobs$labels <- self$build_labels(key, elems, params)
+ } else {
+ grobs$labels <- list(zeroGrob())
+ }
grobs$decor <- self$build_decor(params$decor, grobs, elems, params)
# Arrange and assemble grobs
diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R
index 1e0f765898..7c345dff20 100644
--- a/R/guide-axis-stack.R
+++ b/R/guide-axis-stack.R
@@ -149,6 +149,11 @@ GuideAxisStack <- ggproto(
position <- params$position %||% position
direction <- params$direction %||% direction
+ # If we are instructed to not draw labels at interior panels, just render
+ # the first axis
+ draw_label <- params$draw_label %||% TRUE
+ guide_index <- if (draw_label) seq_along(params$guides) else 1L
+
if (position %in% c("theta", "theta.sec")) {
# If we are a theta guide, we need to keep track how much space in the
# radial direction a guide occupies, and add that as an offset to the
@@ -156,7 +161,8 @@ GuideAxisStack <- ggproto(
offset <- unit(0, "cm")
spacing <- params$spacing %||% unit(2.25, "pt")
grobs <- list()
- for (i in seq_along(params$guides)) {
+
+ for (i in guide_index) {
# Add offset to params
pars <- params$guide_params[[i]]
pars$stack_offset <- offset
@@ -177,10 +183,12 @@ GuideAxisStack <- ggproto(
# Loop through every guide's draw method
grobs <- list()
- for (i in seq_along(params$guides)) {
+ for (i in guide_index) {
+ pars <- params$guide_params[[i]]
+ pars$draw_label <- draw_label
grobs[[i]] <- params$guides[[i]]$draw(
theme, position = position, direction = direction,
- params = params$guide_params[[i]]
+ params = pars
)
}
diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R
index e8f4504050..306eab61af 100644
--- a/R/guide-axis-theta.R
+++ b/R/guide-axis-theta.R
@@ -308,6 +308,9 @@ GuideAxisTheta <- ggproto(
assemble_drawing = function(grobs, layout, sizes, params, elements) {
+ # Fix order of grobs
+ grobs <- grobs[c("title", "labels", "ticks", "decor")]
+
if (params$position %in% c("theta", "theta.sec")) {
# We append an 'offset' slot in case this guide is part
# of a stacked guide
diff --git a/man/facet_grid.Rd b/man/facet_grid.Rd
index a485a8a491..3b5b5becc7 100644
--- a/man/facet_grid.Rd
+++ b/man/facet_grid.Rd
@@ -15,6 +15,8 @@ facet_grid(
switch = NULL,
drop = TRUE,
margins = FALSE,
+ axes = "margins",
+ axis.labels = "all",
facets = deprecated()
)
}
@@ -77,6 +79,18 @@ default). If \code{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.}
+\item{axes}{Determines which axes will be drawn. When \code{"margins"}
+(default), axes will be drawn at the exterior margins. \code{"all_x"} and
+\code{"all_y"} will draw the respective axes at the interior panels too, whereas
+\code{"all"} will draw all axes at all panels.}
+
+\item{axis.labels}{Determines whether to draw labels for interior axes when
+the \code{axes} argument is not \code{"margins"}. When \code{"all"} (default), all
+interior axes get labels. When \code{"margins"}, only the exterior axes get
+labels and the interior axes get none. When \code{"all_x"} or \code{"all_y"}, only
+draws the labels at the interior axes in the x- or y-direction
+respectively.}
+
\item{facets}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use \code{rows}
and \code{cols} instead.}
}
diff --git a/man/facet_wrap.Rd b/man/facet_wrap.Rd
index 432884db5d..ed97d6e374 100644
--- a/man/facet_wrap.Rd
+++ b/man/facet_wrap.Rd
@@ -15,7 +15,9 @@ facet_wrap(
switch = deprecated(),
drop = TRUE,
dir = "h",
- strip.position = "top"
+ strip.position = "top",
+ axes = "margins",
+ axis.labels = "all"
)
}
\arguments{
@@ -69,6 +71,18 @@ for vertical.}
the plot. Using \code{strip.position} it is possible to place the labels on
either of the four sides by setting \code{strip.position = c("top",
"bottom", "left", "right")}}
+
+\item{axes}{Determines which axes will be drawn in case of fixed scales.
+When \code{"margins"} (default), axes will be drawn at the exterior margins.
+\code{"all_x"} and \code{"all_y"} will draw the respective axes at the interior
+panels too, whereas \code{"all"} will draw all axes at all panels.}
+
+\item{axis.labels}{Determines whether to draw labels for interior axes when
+the scale is fixed and the \code{axis} argument is not \code{"margins"}. When
+\code{"all"} (default), all interior axes get labels. When \code{"margins"}, only
+the exterior axes get labels, and the interior axes get none. When
+\code{"all_x"} or \code{"all_y"}, only draws the labels at the interior axes in the
+x- or y-direction respectively.}
}
\description{
\code{facet_wrap()} wraps a 1d sequence of panels into 2d. This is generally
diff --git a/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg
new file mode 100644
index 0000000000..4cdc17ce98
--- /dev/null
+++ b/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg
@@ -0,0 +1,347 @@
+
+
diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
new file mode 100644
index 0000000000..66caee5c07
--- /dev/null
+++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
@@ -0,0 +1,348 @@
+
+
diff --git a/tests/testthat/test-facet-.R b/tests/testthat/test-facet-.R
index 49c1316104..5d4b176b6b 100644
--- a/tests/testthat/test-facet-.R
+++ b/tests/testthat/test-facet-.R
@@ -235,6 +235,96 @@ test_that("facet gives clear error if ", {
expect_snapshot_error(print(ggplot(df, aes(x)) + facet_grid(vars(x), "free")))
})
+test_that("facet_grid `axis_labels` argument can be overruled", {
+
+ f <- facet_grid(vars(cyl), axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_grid(vars(cyl), axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = FALSE, y = FALSE))
+
+ # Overrule when only drawing at margins
+ f <- facet_grid(vars(cyl), axes = "margins", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+})
+
+test_that("facet_wrap `axis_labels` argument can be overruled", {
+
+ # The folllowing three should all draw axis labels
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_wrap(vars(cyl), scales = "free", axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "margins", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ # The only case when labels shouldn't be drawn is when scales are fixed but
+ # the axes are to be drawn
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = FALSE, y = FALSE))
+
+ # Should draw labels because scales are free
+ f <- facet_wrap(vars(cyl), scales = "free", axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ # Should draw labels because only drawing at margins
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "margins", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+})
+
+test_that("facet_grid `axes` can draw inner axes.", {
+ df <- data_frame(
+ x = 1:4, y = 1:4,
+ fx = c("A", "A", "B", "B"),
+ fy = c("c", "d", "c", "d")
+ )
+ p <- ggplot(df, aes(x, y)) + geom_point()
+
+ case <- ggplotGrob(p + facet_grid(vars(fy), vars(fx), axes = "all"))
+ ctrl <- ggplotGrob(p + facet_grid(vars(fy), vars(fx), axes = "margins"))
+
+ # 4 x-axes if all axes should be drawn
+ bottom <- case$grobs[grepl("axis-b", case$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 4)
+ # 2 x-axes if drawing at the margins
+ bottom <- ctrl$grobs[grepl("axis-b", ctrl$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 2)
+
+ # Ditto for y-axes
+ left <- case$grobs[grepl("axis-l", case$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 4)
+ left <- ctrl$grobs[grepl("axis-l", ctrl$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 2)
+})
+
+test_that("facet_wrap `axes` can draw inner axes.", {
+ df <- data_frame(
+ x = 1, y = 1, facet = LETTERS[1:4]
+ )
+
+ p <- ggplot(df, aes(x, y)) + geom_point()
+
+ case <- ggplotGrob(p + facet_wrap(vars(facet), axes = "all"))
+ ctrl <- ggplotGrob(p + facet_wrap(vars(facet), axes = "margins"))
+
+ # 4 x-axes if all axes should be drawn
+ bottom <- case$grobs[grepl("axis-b", case$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 4)
+ # 2 x-axes if drawing at the margins
+ bottom <- ctrl$grobs[grepl("axis-b", ctrl$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 2)
+
+ # Ditto for y-axes
+ left <- case$grobs[grepl("axis-l", case$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 4)
+ left <- ctrl$grobs[grepl("axis-l", ctrl$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 2)
+})
+
# Variable combinations ---------------------------------------------------
test_that("zero-length vars in combine_vars() generates zero combinations", {
@@ -413,3 +503,20 @@ test_that("facet labels respect both justification and margin arguments", {
expect_doppelganger("left justified facet labels with margins", p1)
expect_doppelganger("left justified rotated facet labels with margins", p2)
})
+
+test_that("facet's 'axis_labels' argument correctly omits labels", {
+
+ base <- ggplot(mtcars, aes(mpg, disp)) +
+ geom_point() +
+ guides(x = "axis", y = "axis", x.sec = "axis", y.sec = "axis")
+
+ expect_doppelganger(
+ "facet_grid with omitted inner axis labels",
+ base + facet_grid(vars(cyl), vars(vs), axes = "all", axis.labels = "margins")
+ )
+
+ expect_doppelganger(
+ "facet_wrap with omitted inner axis labels",
+ base + facet_wrap(vars(cyl, vs), axes = "all", axis.labels = "margins")
+ )
+})