Add theme(axis.ontop)

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

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

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

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"),

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

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
@@ -407,6 +408,7 @@ theme <- function(...,
                   axis.line.y.right,
                   axis.line.theta,
                   axis.line.r,
+                  axis.ontop,
                   legend.background,
                   legend.margin,
                   legend.spacing,

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", {