Reduce panel parameter setup in facetted plots (#5431)

* coords append information to layout

* compute panel params/guides once per scale combination

* Facets render axes once per x/y combination

* anonymous function to `MoreArgs`

* Sprinkle some comments

* Add news bullet

* add test

* format bullet

Author: teunbrand

NEWS.md

@@ -1,6 +1,8 @@
 # ggplot2 (development version)
 
-* (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand).
+* (internal) The plot's layout now has a coord parameter that is used to 
+  prevent setting up identical panel parameters (#5427)
+* (internal) rearranged the code of `Facet$draw_panels()` method (@teunbrand).
 * `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (@pn317, #5905)
 * `position_dodge(preserve = "single")` now handles multi-row geoms better,
   such as `geom_violin()` (@teunbrand based on @clauswilke's work, #2801).

R/coord-.R

@@ -196,6 +196,11 @@ Coord <- ggproto("Coord",
   },
 
   setup_layout = function(layout, params) {
+    # We're appending a COORD variable to the layout that determines the
+    # uniqueness of panel parameters. The layout uses this to prevent redundant
+    # setups of these parameters.
+    scales <- layout[c("SCALE_X", "SCALE_Y")]
+    layout$COORD <- vec_match(scales, unique0(scales))
     layout
   },
 

R/coord-flip.R

@@ -99,6 +99,7 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian,
   },
 
   setup_layout = function(layout, params) {
+    layout <- Coord$setup_layout(layout, params)
     # Switch the scales
     layout[c("SCALE_X", "SCALE_Y")] <- layout[c("SCALE_Y", "SCALE_X")]
     layout

R/layout.R

@@ -212,20 +212,32 @@ Layout <- ggproto("Layout", NULL,
     # scales is not elegant, but it is pragmatic
     self$coord$modify_scales(self$panel_scales_x, self$panel_scales_y)
 
-    scales_x <- self$panel_scales_x[self$layout$SCALE_X]
-    scales_y <- self$panel_scales_y[self$layout$SCALE_Y]
+    # We only need to setup panel params once for unique combinations of x/y
+    # scales. These will be repeated for duplicated combinations.
+    index <- vec_unique_loc(self$layout$COORD)
+    order <- vec_match(self$layout$COORD, self$layout$COORD[index])
 
-    setup_panel_params <- function(scale_x, scale_y) {
-      self$coord$setup_panel_params(scale_x, scale_y, params = self$coord_params)
-    }
-    self$panel_params <- Map(setup_panel_params, scales_x, scales_y)
+    scales_x <- self$panel_scales_x[self$layout$SCALE_X[index]]
+    scales_y <- self$panel_scales_y[self$layout$SCALE_Y[index]]
+
+    self$panel_params <- Map(
+      self$coord$setup_panel_params,
+      scales_x, scales_y,
+      MoreArgs = list(params = self$coord_params)
+    )[order] # `[order]` does the repeating
 
     invisible()
   },
 
   setup_panel_guides = function(self, guides, layers) {
+
+    # Like in `setup_panel_params`, we only need to setup guides for unique
+    # combinations of x/y scales.
+    index <- vec_unique_loc(self$layout$COORD)
+    order <- vec_match(self$layout$COORD, self$layout$COORD[index])
+
     self$panel_params <- lapply(
-      self$panel_params,
+      self$panel_params[index],
       self$coord$setup_panel_guides,
       guides,
       self$coord_params
@@ -236,7 +248,7 @@ Layout <- ggproto("Layout", NULL,
       self$coord$train_panel_guides,
       layers,
       self$coord_params
-    )
+    )[order]
 
     invisible()
   },

tests/testthat/test-coord-.R

@@ -53,3 +53,26 @@ test_that("check coord limits errors only on bad inputs", {
   # Should raise error if vector of wrong length is passed
   expect_error(check_coord_limits(1:3))
 })
+
+test_that("coords append a column to the layout correctly", {
+  layout <- data_frame0(SCALE_X = c(1, 1, 1), SCALE_Y = c(1, 1, 1))
+  test <- Coord$setup_layout(layout)
+  expect_equal(test$COORD, c(1, 1, 1))
+
+  layout <- data_frame0(SCALE_X = c(1, 1, 1), SCALE_Y = c(1, 2, 2))
+  test <- Coord$setup_layout(layout)
+  expect_equal(test$COORD, c(1, 2, 2))
+
+  layout <- data_frame0(SCALE_X = c(1, 2, 3), SCALE_Y = c(1, 1, 1))
+  test <- Coord$setup_layout(layout)
+  expect_equal(test$COORD, c(1, 2, 3))
+
+  layout <- data_frame0(SCALE_X = c(1, 2, 3), SCALE_Y = c(1, 2, 3))
+  test <- Coord$setup_layout(layout)
+  expect_equal(test$COORD, c(1, 2, 3))
+
+  layout <- data_frame0(SCALE_X = c(1, 1, 1), SCALE_Y = c(1, 2, 1))
+  test <- Coord$setup_layout(layout)
+  expect_equal(test$COORD, c(1, 2, 1))
+})
+