Reduce panel parameter setup in facetted plots

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* (internal) The plot's layout now has a coord parameters that is used to 
+  prevent setting up identical panel parameters (#5427)
+
 * Legend titles no longer take up space if they've been removed by setting 
   `legend.title = element_blank()` (@teunbrand, #3587).
 

R/coord-.R

@@ -192,6 +192,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

@@ -86,6 +86,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/facet-grid-.R

@@ -306,9 +306,22 @@ FacetGrid <- ggproto("FacetGrid", Facet,
       cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales")
     }
 
+    # Because within a row or column the scales are static, we only need to
+    # render one set of axes per row/column. If scales are fixed, we only need
+    # to render one set of axes, that we can repeat for other panels.
     cols <- which(layout$ROW == 1)
     rows <- which(layout$COL == 1)
-    axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
+    # Figure out unique x/y scale combinations
+    col_idx <- cols[!duplicated(layout$COORD[cols])]
+    row_idx <- rows[!duplicated(layout$COORD[rows])]
+    # Map all combinations to unique ones
+    col_ord <- vec_match(layout$COORD[cols], layout$COORD[col_idx])
+    row_ord <- vec_match(layout$COORD[rows], layout$COORD[row_idx])
+    # Render the axes for unique combinations
+    axes <- render_axes(ranges[col_idx], ranges[row_idx], coord, theme, transpose = TRUE)
+    # Repeat axes for all combinations
+    axes$x <- lapply(axes$x, `[`, i = col_ord)
+    axes$y <- lapply(axes$y, `[`, i = row_ord)
 
     col_vars <- unique0(layout[names(params$cols)])
     row_vars <- unique0(layout[names(params$rows)])

R/facet-wrap.R

@@ -241,7 +241,15 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     panels <- panels[panel_order]
     panel_pos <- convertInd(layout$ROW, layout$COL, nrow)
 
-    axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
+    # If scales are fixed, we only need to render one set of axes which can be
+    # repeated. Below, we find the unique combinations of scales, and map all
+    # combinations to the unique ones.
+    index <- vec_unique_loc(layout$COORD)
+    order <- vec_match(layout$COORD, layout$COORD[index])
+
+    # Render axes and repeat them for all combinations
+    axes <- render_axes(ranges[index], ranges[index], coord, theme, transpose = TRUE)
+    axes <- lapply(axes, lapply, function(x) x[order])
 
     if (length(params$facets) == 0) {
       # Add a dummy label

R/layout.R

@@ -209,20 +209,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
@@ -233,7 +245,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))
+})
+