From 696e7dd31192ac81bb5dee25486d261616069ce1 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 19 Feb 2019 18:24:49 -0500 Subject: [PATCH 1/4] implement layer params that live in the layer --- R/geom-.r | 2 +- R/layer.r | 32 +++++++++++++++++++++++++++++++- R/plot-build.r | 3 +++ 3 files changed, 35 insertions(+), 2 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 4f19896ee2..9ce6f9f1af 100644 --- a/R/geom-.r +++ b/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)) diff --git a/R/layer.r b/R/layer.r index df3b5d1fa4..198654b376 100644 --- a/R/layer.r +++ b/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)) { @@ -205,6 +206,35 @@ Layer <- ggproto("Layer", NULL, data }, + # hook to generate the layer_params object that gets passed to + # Geom$draw_layer() + build_init = function(self, index, plot, layout) { + force(index) + scales <- plot$scales + force(layout) + + layer_params <- list( + index = index, + get_scale = function(scale, panel = NA) { + if(scale %in% c("x", "y")) { + # depends on panel + if(identical(panel, NA)) stop("Position scale depends on panel") + if(scale == "x") { + layout$panel_scales_x[[panel]] + } else if(scale == "y") { + layout$panel_scales_y[[panel]] + } else { + stop("Unknown position scale: ", scale) + } + } else { + scales$get_scales(scale) + } + } + ) + + self$layer_params <- layer_params + }, + compute_aesthetics = function(self, data, plot) { # For annotation geoms, it is useful to be able to ignore the default aes if (self$inherit.aes) { @@ -332,7 +362,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) } ) diff --git a/R/plot-build.r b/R/plot-build.r index 0bcb856338..d0f8f4799c 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -54,6 +54,9 @@ ggplot_build.ggplot <- function(plot) { layout <- create_layout(plot$facet, plot$coordinates) data <- layout$setup(data, plot$data, plot$plot_env) + # initialize the layer_params for each layer + lapply(seq_along(layers), function(i) layers[[i]]$build_init(i, plot, layout)) + # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot)) From be19517e9eca5ceb990968a16ca4f477461a4a94 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Thu, 21 Feb 2019 22:32:49 -0500 Subject: [PATCH 2/4] make layer_params a ggproto object, modify get_scale to take layout as an arg, move layer_params to get assigned in setup_layer(). --- R/geom-.r | 2 +- R/layer.r | 21 ++++++++------------- R/plot-build.r | 3 --- 3 files changed, 9 insertions(+), 17 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 9ce6f9f1af..1c60b76056 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -71,7 +71,7 @@ Geom <- ggproto("Geom", ) }, - draw_layer = function(self, data, params, layout, coord, layer_params) { + 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)) diff --git a/R/layer.r b/R/layer.r index 198654b376..fe024fbe9a 100644 --- a/R/layer.r +++ b/R/layer.r @@ -203,19 +203,13 @@ 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) { - data - }, - # hook to generate the layer_params object that gets passed to - # Geom$draw_layer() - build_init = function(self, index, plot, layout) { - force(index) + # generate the layer_params object that gets passed to + # Geom$draw_layer() scales <- plot$scales - force(layout) - - layer_params <- list( - index = index, - get_scale = function(scale, panel = NA) { + self$layer_params <- ggproto("LayerParams", NULL, + scales = plot$scales, + 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") @@ -227,12 +221,13 @@ Layer <- ggproto("Layer", NULL, stop("Unknown position scale: ", scale) } } else { - scales$get_scales(scale) + self$scales$get_scales(scale) } } ) - self$layer_params <- layer_params + # return the data + data }, compute_aesthetics = function(self, data, plot) { diff --git a/R/plot-build.r b/R/plot-build.r index d0f8f4799c..0bcb856338 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -54,9 +54,6 @@ ggplot_build.ggplot <- function(plot) { layout <- create_layout(plot$facet, plot$coordinates) data <- layout$setup(data, plot$data, plot$plot_env) - # initialize the layer_params for each layer - lapply(seq_along(layers), function(i) layers[[i]]$build_init(i, plot, layout)) - # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot)) From 295eee2ba302135a67b018d38eda2aca9c66ca6a Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Thu, 21 Feb 2019 22:43:19 -0500 Subject: [PATCH 3/4] remove ref to scales list, fix layout scale getting --- R/layer.r | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/R/layer.r b/R/layer.r index fe024fbe9a..aaf81172fa 100644 --- a/R/layer.r +++ b/R/layer.r @@ -208,20 +208,13 @@ Layer <- ggproto("Layer", NULL, # Geom$draw_layer() scales <- plot$scales self$layer_params <- ggproto("LayerParams", NULL, - scales = plot$scales, 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") - if(scale == "x") { - layout$panel_scales_x[[panel]] - } else if(scale == "y") { - layout$panel_scales_y[[panel]] - } else { - stop("Unknown position scale: ", scale) - } + layout$get_scales(panel)[[scale]] } else { - self$scales$get_scales(scale) + scales$get_scales(scale) } } ) From 037b9e4e3dc669e315bfe6a5a00d2e708d9ff7a1 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Fri, 1 Mar 2019 13:02:03 -0400 Subject: [PATCH 4/4] add test and news item in prep for PR --- NEWS.md | 3 ++ tests/testthat/test-layer.r | 79 +++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) diff --git a/NEWS.md b/NEWS.md index 360fd75990..34c510acfa 100644 --- a/NEWS.md +++ b/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()` diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index f07228adec..25753ae1a3 100644 --- a/tests/testthat/test-layer.r +++ b/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", {