Adding Layout slot to ggplot object (#5576)

* as an S3 generic for  class

* tests required to pass tests

* reverting changes according to @teunbrand 's request

* It is probably important to include a test that whatever makes it through `plot$layout` is actually a Layout ggproto object

* adding layout slot

* Typos: forgot to remove `plot` from body of create_layout

* Update R/layout.R

teunbrand's suggestion for checking Layout type

Co-authored-by: Teun van den Brand <[email protected]>

* adding News bullet

* This is likely a safer implementation - previously, if someone were to modify the  it would affect all future ggplot objects and any still in memory.

* typo, wrote layer, meant to say Layout

* clearer word choice

---------

Co-authored-by: Teun van den Brand <[email protected]>

Author: jtlandis

NEWS.md

@@ -1,5 +1,10 @@
 # ggplot2 (development version)
 
+* The ggplot object now contains `$layout` which points to the `Layout` ggproto
+  object and will be used by the `ggplot_build.ggplot` method. This was exposed
+  so that package developers may extend the behavior of the `Layout` ggproto object
+  without needing to develop an entirely new `ggplot_build` method (@jtlandis, #5077).
+
 * `coord_polar()` can have free scales in facets (@teunbrand, #2815).
 
 * The new argument `axes` in `facet_grid()` and `facet_wrap()` controls the

R/layout.R

@@ -6,9 +6,12 @@
 # This includes managing the parameters for the facet and the coord
 # so that we don't modify the ggproto object in place.
 
-create_layout <- function(facet = FacetNull, coord = CoordCartesian) {
-  ggproto(NULL, Layout, facet = facet, coord = coord)
+create_layout <- function(facet, coord, layout = NULL) {
+  layout <- layout %||% Layout
+  check_inherits(layout, "Layout")
+  ggproto(NULL, layout, facet = facet, coord = coord)
 }
+
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL

R/plot-build.R

@@ -46,7 +46,7 @@ ggplot_build.ggplot <- function(plot) {
 
   # Initialise panels, add extra data for margins & missing faceting
   # variables, and add on a PANEL variable to data
-  layout <- create_layout(plot$facet, plot$coordinates)
+  layout <- create_layout(plot$facet, plot$coordinates, plot$layout)
   data <- layout$setup(data, plot$data, plot$plot_env)
 
   # Compute aesthetics to produce data with generalised variable names

R/plot.R

@@ -127,7 +127,8 @@ ggplot.default <- function(data = NULL, mapping = aes(), ...,
     theme = list(),
     coordinates = coord_cartesian(default = TRUE),
     facet = facet_null(),
-    plot_env = environment
+    plot_env = environment,
+    layout = ggproto(NULL, Layout)
   ), class = c("gg", "ggplot"))
 
   p$labels <- make_labels(mapping)

tests/testthat/test-facet-layout.R

@@ -4,7 +4,7 @@ c <- data_frame(b = 3)
 empty <- data_frame()
 
 panel_layout <- function(facet, data) {
-  layout <- create_layout(facet)
+  layout <- create_layout(facet = facet, coord = CoordCartesian)
   layout$setup(data)
   layout$layout
 }

tests/testthat/test-facet-map.R

@@ -4,7 +4,7 @@ df_b <- unique(df["b"])
 df_c <- unique(data_frame(c = 1))
 
 panel_map_one <- function(facet, data, plot_data = data) {
-  layout <- create_layout(facet)
+  layout <- create_layout(facet = facet, coord = CoordCartesian)
   layout$setup(list(data), plot_data)[[1]]
 }