Add access to the scales at draw time using a new layer_params object

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 3.1.0.9000
 
+* Scales are now accessible to the `Geom` at draw time through a new 
+  `layer_params` argument to `Geom$draw_layer()` (#3116).
+
 * `coord_sf()` graticule lines are now drawn in the same thickness as 
   panel grid lines in `coord_cartesian()`, and seting panel grid
   lines to `element_blank()` now also works in `coord_sf()` 

R/geom-.r

@@ -71,7 +71,7 @@ Geom <- ggproto("Geom",
     )
   },
 
-  draw_layer = function(self, data, params, layout, coord) {
+  draw_layer = function(self, data, params, layout, coord, layer_params, ...) {
     if (empty(data)) {
       n <- if (is.factor(data$PANEL)) nlevels(data$PANEL) else 1L
       return(rep(list(zeroGrob()), n))

R/layer.r

@@ -173,6 +173,7 @@ Layer <- ggproto("Layer", NULL,
   mapping = NULL,
   position = NULL,
   inherit.aes = FALSE,
+  layer_params = NULL,
 
   print = function(self) {
     if (!is.null(self$mapping)) {
@@ -202,6 +203,23 @@ Layer <- ggproto("Layer", NULL,
   # hook to allow a layer access to the final layer data
   # in input form and to global plot info
   setup_layer = function(self, data, plot) {
+
+    # generate the layer_params object that gets passed to
+    # Geom$draw_layer()
+    scales <- plot$scales
+    self$layer_params <- ggproto("LayerParams", NULL,
+      get_scale = function(self, scale, panel, layout) {
+        if(scale %in% c("x", "y")) {
+          # depends on panel
+          if(identical(panel, NA)) stop("Position scale depends on panel")
+          layout$get_scales(panel)[[scale]]
+        } else {
+          scales$get_scales(scale)
+        }
+      }
+    )
+
+    # return the data
     data
   },
 
@@ -332,7 +350,7 @@ Layer <- ggproto("Layer", NULL,
     }
 
     data <- self$geom$handle_na(data, self$geom_params)
-    self$geom$draw_layer(data, self$geom_params, layout, layout$coord)
+    self$geom$draw_layer(data, self$geom_params, layout, layout$coord, self$layer_params)
   }
 )
 

tests/testthat/test-layer.r

@@ -45,6 +45,85 @@ test_that("if an aes is mapped to a function that returns NULL, it is removed",
   expect_identical(names(p[[1]]), c("PANEL", "x", "group"))
 })
 
+# The layer_params object -------------------------------------------------
+
+test_that("layers in a built plot have a layer_params object", {
+  df <- data_frame(x = 1:10, y = 1:10)
+  built <- ggplot_build(ggplot(df, aes(x, y)) + geom_point())
+  expect_is(built$plot$layers[[1]]$layer_params, "LayerParams")
+})
+
+test_that("the correct scales are returned from layer_params$get_scale()", {
+
+  # test Geom that displays select scale information
+  GeomScaleInfo <- ggproto(
+    "GeomScaleInfo", Geom,
+    required_aes = "x",
+
+    draw_layer = function(self, data, params, layout, coord, layer_params, ...) {
+
+      # list the same length as number of panels in data$PANEL
+      lapply(unique(data$PANEL), function(panel) {
+        x_limits <- layer_params$get_scale("x", panel, layout)$get_limits()
+        y_limits <- layer_params$get_scale("y", panel, layout)$get_limits()
+        col_limits <- layer_params$get_scale("colour", panel, layout)$get_limits()
+        text <- sprintf(
+          "x: %s; y: %s; col: %s",
+          paste(x_limits, collapse = ", "),
+          paste(y_limits, collapse = ", "),
+          paste(col_limits, collapse = ", ")
+        )
+        grid::textGrob(text)
+      })
+    }
+  )
+
+  geom_scale_info <- function() {
+    layer(
+      geom = GeomScaleInfo, stat = "identity", data = data_frame(x = 1), mapping = aes(x = x),
+      position = "identity",
+      params = list(), inherit.aes = FALSE, show.legend = NA
+    )
+  }
+
+  # a test plot that has some position and non-position scales, function to extract text
+  # from the plot
+  df <- data_frame(x = 1:10, y = 21:30, col = factor(c(1, 1, 1, 1, 1, 2, 2, 2, 3, 3)))
+  p <- ggplot(df, aes(x, y, col = col)) + geom_blank() + geom_scale_info()
+  limits_from_plot <- function(p) {
+    built <- ggplot_build(p)
+    panels <- seq_along(built$layout$panel_params)
+    vapply(panels, function(panel) layer_grob(p, 2)[[panel]]$label, character(1))
+  }
+
+  # expect the correct limits for single, multi-panel plots with (possibly) free scales
+  expect_identical(limits_from_plot(p), "x: 1, 10; y: 21, 30; col: 1, 2, 3")
+  expect_identical(
+    unique(limits_from_plot(p + facet_wrap(vars(col)))),
+    "x: 1, 10; y: 21, 30; col: 1, 2, 3"
+  )
+  expect_identical(
+    unique(limits_from_plot(p + facet_grid(vars(col)))),
+    "x: 1, 10; y: 21, 30; col: 1, 2, 3"
+  )
+  expect_identical(
+    unique(limits_from_plot(p + facet_wrap(vars(col), scales = "free"))),
+    c(
+      "x: 1, 5; y: 21, 25; col: 1, 2, 3",
+      "x: 1, 8; y: 26, 28; col: 1, 2, 3",
+      "x: 1, 10; y: 29, 30; col: 1, 2, 3"
+    )
+  )
+  expect_identical(
+    unique(limits_from_plot(p + facet_grid(vars(col), scales = "free"))),
+    c(
+      "x: 1, 10; y: 21, 25; col: 1, 2, 3",
+      "x: 1, 10; y: 26, 28; col: 1, 2, 3",
+      "x: 1, 10; y: 29, 30; col: 1, 2, 3"
+    )
+  )
+})
+
 # Data extraction ---------------------------------------------------------
 
 test_that("layer_data returns a data.frame", {