From 27b0b10daa2231ea46d53f3f6258cfe61cd38be3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 10 Dec 2025 14:28:06 +0100 Subject: [PATCH 1/5] add `axis.ontop` theme element --- R/theme-elements.R | 2 +- R/theme.R | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/theme-elements.R b/R/theme-elements.R index c8dab6c69f..2f0575753a 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -915,7 +915,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { axis.minor.ticks.length.r = el_def( c("unit", "rel"), c("axis.minor.ticks.length.y", "axis.ticks.length.r") ), - + axis.ontop = el_def("logical"), legend.background = el_def(element_rect, "rect"), legend.margin = el_def(c("margin", "unit", "rel"), "margins"), legend.spacing = el_def(c("unit", "rel"), "spacing"), diff --git a/R/theme.R b/R/theme.R index d263ff0fe6..43fea5fee9 100644 --- a/R/theme.R +++ b/R/theme.R @@ -407,6 +407,7 @@ theme <- function(..., axis.line.y.right, axis.line.theta, axis.line.r, + axis.ontop, legend.background, legend.margin, legend.spacing, From b6202f4e6eab78c0775af0d9b5c28cff0ad5fc3a Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 10 Dec 2025 14:28:39 +0100 Subject: [PATCH 2/5] set `z` gtable property based on theme element --- R/facet-grid-.R | 17 +++++++++++------ R/facet-null.R | 9 ++++++++- R/facet-wrap.R | 10 +++++++--- 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 5ffe43cc77..9ef66c5a88 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -323,18 +323,23 @@ FacetGrid <- ggproto("FacetGrid", Facet, axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE) mtx <- function(x, o) matrix(x[o], dim[1], dim[2], byrow = TRUE) + z <- 3L + if (!isTRUE(calc_element("axis.ontop", theme) %||% TRUE)) { + z <- 0L + } + if (draw_axes$x) { - table <- weave_axes(table, lapply(axes$x, mtx, o = x_order)) + table <- weave_axes(table, lapply(axes$x, mtx, o = x_order), z = z) } else { - table <- seam_table(table, axes$x$top, side = "top", name = "axis-t", z = 3) - table <- seam_table(table, axes$x$bottom, side = "bottom", name = "axis-b", z = 3) + table <- seam_table(table, axes$x$top, side = "top", name = "axis-t", z = z) + table <- seam_table(table, axes$x$bottom, side = "bottom", name = "axis-b", z = z) } if (draw_axes$y) { - table <- weave_axes(table, lapply(axes$y, mtx, o = y_order)) + table <- weave_axes(table, lapply(axes$y, mtx, o = y_order), z = z) } else { - table <- seam_table(table, axes$y$left, side = "left", name = "axis-l", z = 3) - table <- seam_table(table, axes$y$right, side = "right", name = "axis-r", z = 3) + table <- seam_table(table, axes$y$left, side = "left", name = "axis-l", z = z) + table <- seam_table(table, axes$y$right, side = "right", name = "axis-r", z = z) } table diff --git a/R/facet-null.R b/R/facet-null.R index 860e5f3b84..30c0ebda3d 100644 --- a/R/facet-null.R +++ b/R/facet-null.R @@ -62,7 +62,14 @@ FacetNull <- ggproto("FacetNull", Facet, axis_v$left, panels[[1]], axis_v$right, zeroGrob(), axis_h$bottom, zeroGrob() ), ncol = 3, byrow = TRUE) - z_matrix <- matrix(c(5, 6, 4, 7, 1, 8, 3, 9, 2), ncol = 3, byrow = TRUE) + + if (isTRUE(calc_element("axis.ontop", theme) %||% TRUE)) { + z_matrix <- matrix(c(5, 6, 4, 7, 1, 8, 3, 9, 2), ncol = 3, byrow = TRUE) + } else { + # Panel (index = 5) has higher value than other cells + z_matrix <- matrix(c(4, 5, 3, 6, 9, 7, 2, 8, 1), ncol = 3, byrow = TRUE) + } + grob_widths <- unit.c(grobWidth(axis_v$left), unit(1, "null"), grobWidth(axis_v$right)) grob_heights <- unit.c(grobHeight(axis_h$top), unit(abs(aspect_ratio), "null"), grobHeight(axis_h$bottom)) grob_names <- c("spacer", "axis-l", "spacer", "axis-t", "panel", "axis-b", "spacer", "axis-r", "spacer") diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 2cc7a9c2d7..be6f8c9077 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -303,12 +303,17 @@ FacetWrap <- ggproto("FacetWrap", Facet, right[, -dim[2]] <- list(zeroGrob()) } + z <- 3L + if (!isTRUE(calc_element("axis.ontop", theme) %||% TRUE)) { + z <- 0L + } + # Check for empty panels and exit early if there are none empty <- matrix(TRUE, dim[1], dim[2]) empty[index] <- FALSE if (!any(empty)) { axes <- list(top = top, bottom = bottom, left = left, right = right) - return(weave_axes(table, axes, empty)) + return(weave_axes(table, axes, empty, z = z)) } # Match empty table to layout @@ -372,9 +377,8 @@ FacetWrap <- ggproto("FacetWrap", Facet, {.code strip.placement = \"outside\".}" ) } - axes <- list(top = top, bottom = bottom, left = left, right = right) - weave_axes(table, axes, empty) + weave_axes(table, axes, empty, z = z) }, attach_strips = function(self, table, layout, params, theme) { From 8479f490c08243cee5175db07fff5b5ac73d6493 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 10 Dec 2025 14:40:33 +0100 Subject: [PATCH 3/5] add test --- tests/testthat/test-theme.R | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 55f9b8d47d..384be8738a 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -444,6 +444,39 @@ test_that("theme element conversion to lists works", { expect_silent(convert(x, element_text)) }) +test_that("axis.ontop changes z-column in gtable", { + + get_z <- function(p, pattern = c("panel", "axis")) { + gt <- ggplotGrob(p) + + out <- list() + for (pat in pattern) { + out[[pat]] <- gtable_filter(gt, pat)$layout$z + } + out + } + + p <- ggplot() + annotate("point", 1, 1) + + z <- get_z(p + facet_null() + theme(axis.ontop = TRUE)) + expect_all_true(z$panel < z$axis) + + z <- get_z(p + facet_null() + theme(axis.ontop = FALSE)) + expect_all_true(z$panel > z$axis) + + z <- get_z(p + facet_wrap(~"foo") + theme(axis.ontop = TRUE)) + expect_all_true(z$panel < z$axis) + + z <- get_z(p + facet_wrap(~"foo") + theme(axis.ontop = FALSE)) + expect_all_true(z$panel > z$axis) + + z <- get_z(p + facet_grid(~"foo") + theme(axis.ontop = TRUE)) + expect_all_true(z$panel < z$axis) + + z <- get_z(p + facet_grid(~"foo") + theme(axis.ontop = FALSE)) + expect_all_true(z$panel > z$axis) +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", { From bce37c131303a94f9c0b98431f84a99618dc850b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 10 Dec 2025 15:03:52 +0100 Subject: [PATCH 4/5] document --- R/theme.R | 3 ++- man/theme.Rd | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/theme.R b/R/theme.R index 43fea5fee9..33e4648b59 100644 --- a/R/theme.R +++ b/R/theme.R @@ -67,7 +67,8 @@ #' `axis.line.y.left`, `axis.line.y.right`). `axis.line.*.*` inherits from #' `axis.line.*` which inherits from `axis.line`, which in turn inherits #' from `line` -#' +#' @param axis.ontop Controls whether axes are displayed above panel elements +#' (`TRUE`, default) or below panel elements (`FALSE`). #' @param legend.background background of legend ([element_rect()]; inherits #' from `rect`) #' @param legend.margin the margin around each legend ([margin()]); inherits diff --git a/man/theme.Rd b/man/theme.Rd index 66a9be0d32..b325783ff3 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -74,6 +74,7 @@ theme( axis.line.y.right, axis.line.theta, axis.line.r, + axis.ontop, legend.background, legend.margin, legend.spacing, @@ -214,6 +215,9 @@ for each axis (using \code{axis.line.x.bottom}, \code{axis.line.x.top}, \verb{axis.line.*} which inherits from \code{axis.line}, which in turn inherits from \code{line}} +\item{axis.ontop}{Controls whether axes are displayed above panel elements +(\code{TRUE}, default) or below panel elements (\code{FALSE}).} + \item{legend.background}{background of legend (\code{\link[=element_rect]{element_rect()}}; inherits from \code{rect})} From 72d272e57f0128d82ede326de1a30360834f6a61 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 10 Dec 2025 15:31:46 +0100 Subject: [PATCH 5/5] add to `theme_sub_axis(ontop)` too --- R/theme-sub.R | 2 +- man/subtheme.Rd | 11 ++++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/theme-sub.R b/R/theme-sub.R index f7644fc08d..e34d45b99c 100644 --- a/R/theme-sub.R +++ b/R/theme-sub.R @@ -55,7 +55,7 @@ subtheme <- function(elements, prefix = "", suffix = "", call = caller_env()) { #' @export #' @describeIn subtheme Theme specification for all axes. -theme_sub_axis <- function(..., title, text, ticks, ticks.length, line, minor.ticks.length) { +theme_sub_axis <- function(..., title, text, ticks, ticks.length, line, minor.ticks.length, ontop) { warn_dots_empty() subtheme(find_args(), "axis.") } diff --git a/man/subtheme.Rd b/man/subtheme.Rd index 1200580280..5134b44438 100644 --- a/man/subtheme.Rd +++ b/man/subtheme.Rd @@ -15,7 +15,16 @@ \alias{theme_sub_strip} \title{Shortcuts for theme settings} \usage{ -theme_sub_axis(..., title, text, ticks, ticks.length, line, minor.ticks.length) +theme_sub_axis( + ..., + title, + text, + ticks, + ticks.length, + line, + minor.ticks.length, + ontop +) theme_sub_axis_x( ...,