From d3cf2251766b8c56d64ca8cc69c2cbe0ed0f0eff Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Thu, 28 Jan 2016 15:40:35 +0100 Subject: [PATCH 01/11] fortify.function passes function along --- R/fortify.r | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/fortify.r b/R/fortify.r index ca378e0b3d..a35be2a3d9 100644 --- a/R/fortify.r +++ b/R/fortify.r @@ -16,6 +16,8 @@ fortify.data.frame <- function(model, data, ...) model #' @export fortify.NULL <- function(model, data, ...) waiver() #' @export +fortify.function <- function(model, data, ...) model +#' @export fortify.default <- function(model, data, ...) { stop( "ggplot2 doesn't know how to deal with data of class ", From b73265b84df88b8ef61ccc739a23a16203d36adc Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Thu, 28 Jan 2016 15:41:14 +0100 Subject: [PATCH 02/11] Add layer_data method to Layer to get the data from the layer or resolve it if its a waiver or function --- R/layer.r | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/R/layer.r b/R/layer.r index 1734417e70..93662c34ce 100644 --- a/R/layer.r +++ b/R/layer.r @@ -101,6 +101,19 @@ Layer <- ggproto("Layer", NULL, cat(snakeize(class(self$position)[[1]]), "\n") }, + layer_data = function(self, plot_data) { + if (is.waive(self$data)) { + return(plot_data) + } else if (is.function(self$data)) { + data <- self$data(plot_data) + if (!is.data.frame(data)) { + stop("Data function must return a data.frame") + } + return(data) + } + self$data + }, + compute_aesthetics = function(self, data, plot) { # For annotation geoms, it is useful to be able to ignore the default aes if (self$inherit.aes) { From 47e6eb34cda9659ee9ac4cbf6d4e617d3865390b Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Thu, 28 Jan 2016 15:41:34 +0100 Subject: [PATCH 03/11] Don't resolve waiver - already done in layer_data --- R/panel.r | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/panel.r b/R/panel.r index e147464847..1cbf4514e3 100644 --- a/R/panel.r +++ b/R/panel.r @@ -45,10 +45,8 @@ train_layout <- function(panel, facet, data, plot_data) { # @param panel a trained panel object # @param the facetting specification # @param data list of data frames (one for each layer) -# @param plot_data default plot data frame -map_layout <- function(panel, facet, data, plot_data) { +map_layout <- function(panel, facet, data) { lapply(data, function(data) { - if (is.waive(data)) data <- plot_data facet_map_layout(facet, data, panel$layout) }) } From 6bce655fde4841ce574df35c68cdea57330aaf5e Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Thu, 28 Jan 2016 15:42:05 +0100 Subject: [PATCH 04/11] use layer_data for data extraction rather that direct --- R/plot-build.r | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/plot-build.r b/R/plot-build.r index d4ef2a2fda..17185b0f54 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -22,7 +22,7 @@ ggplot_build <- function(plot) { } layers <- plot$layers - layer_data <- lapply(layers, function(y) y$data) + layer_data <- lapply(layers, function(y) y$layer_data(plot$data)) scales <- plot$scales # Apply function to layer and matching data @@ -39,7 +39,7 @@ ggplot_build <- function(plot) { panel <- new_panel() panel <- train_layout(panel, plot$facet, layer_data, plot$data) - data <- map_layout(panel, plot$facet, layer_data, plot$data) + data <- map_layout(panel, plot$facet, layer_data) # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot)) From 304af85f252bc084cc6bf38a8a10ff9455a69af8 Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Thu, 28 Jan 2016 15:43:25 +0100 Subject: [PATCH 05/11] Add unit tests for layer data extraction --- tests/testthat/test-layer.r | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index 80887cebeb..93178b7777 100644 --- a/tests/testthat/test-layer.r +++ b/tests/testthat/test-layer.r @@ -32,3 +32,16 @@ test_that("strip_dots remove dots around calculated aesthetics", { expect_equal(strip_dots(aes(sapply(..density.., function(x) mean(x)))$x), quote(sapply(density, function(x) mean(x)))) }) + +# Data extraction --------------------------------------------------------- + +test_that("layer_data returns a data.frame", { + l <- geom_point() + expect_equal(l$layer_data(mtcars), mtcars) + l <- geom_point(data = head(mtcars)) + expect_equal(l$layer_data(mtcars), head(mtcars)) + l <- geom_point(data = head) + expect_equal(l$layer_data(mtcars), head(mtcars)) + l <- geom_point(data = nrow) + expect_error(l$layer_data(mtcars)) +}) From 4ef8d79b0a9bb30e306dbac8af83d39d96b94aaf Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 1 Feb 2016 09:43:16 +0100 Subject: [PATCH 06/11] Slight restructure of layer_data --- R/layer.r | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/layer.r b/R/layer.r index 93662c34ce..7e6a213900 100644 --- a/R/layer.r +++ b/R/layer.r @@ -103,15 +103,16 @@ Layer <- ggproto("Layer", NULL, layer_data = function(self, plot_data) { if (is.waive(self$data)) { - return(plot_data) + data <- plot_data } else if (is.function(self$data)) { data <- self$data(plot_data) if (!is.data.frame(data)) { stop("Data function must return a data.frame") } - return(data) + } else { + data <- self$data } - self$data + data }, compute_aesthetics = function(self, data, plot) { From 9338d585a946a62670bc49b2f291c60f16f1e868 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 1 Feb 2016 09:44:48 +0100 Subject: [PATCH 07/11] call. = FALSE in stop --- R/layer.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer.r b/R/layer.r index 7e6a213900..4fa2055251 100644 --- a/R/layer.r +++ b/R/layer.r @@ -107,7 +107,7 @@ Layer <- ggproto("Layer", NULL, } else if (is.function(self$data)) { data <- self$data(plot_data) if (!is.data.frame(data)) { - stop("Data function must return a data.frame") + stop("Data function must return a data.frame", call. = FALSE) } } else { data <- self$data From 259f2308e9f8d6ba9403030221867233a9a21c1e Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 1 Feb 2016 09:47:00 +0100 Subject: [PATCH 08/11] Test against error message --- tests/testthat/test-layer.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index 93178b7777..7e4e9f5744 100644 --- a/tests/testthat/test-layer.r +++ b/tests/testthat/test-layer.r @@ -43,5 +43,5 @@ test_that("layer_data returns a data.frame", { l <- geom_point(data = head) expect_equal(l$layer_data(mtcars), head(mtcars)) l <- geom_point(data = nrow) - expect_error(l$layer_data(mtcars)) + expect_error(l$layer_data(mtcars), "Data function must return a data.frame") }) From ba7501d080743f206b4bd402afc5abf2b3e6825e Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Mon, 1 Feb 2016 10:17:35 +0100 Subject: [PATCH 09/11] Add #1527 to news --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7e4f8a5718..69c6a6392f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 2.0.0.9000 +* `layer()` now accepts a function as the data argument. The function will be + applied to the data passed to the `ggplot()` function and must return a + data.frame (#1527). + * `stat_summary()` preserves sorted x order which avoids artefacts when display results with `geom_smooth()` (#1520). From 4c7b76b20bbbe339002a663b4e510d2ca0714f1d Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Mon, 1 Feb 2016 10:18:29 +0100 Subject: [PATCH 10/11] Improved layer documentation with description of different data arguments + examples of function as data --- R/layer.r | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/R/layer.r b/R/layer.r index 4fa2055251..e74283a102 100644 --- a/R/layer.r +++ b/R/layer.r @@ -1,5 +1,25 @@ #' Create a new layer #' +#' A layer is a combination of data, stat and geom with a potential position +#' adjustment. Usually layers are created using \code{geom_*} or \code{stat_*} +#' calls but it can also be created directly using the \code{layer} function. +#' +#' @details +#' The data in a layer can be specified in one of three ways: +#' +#' \itemize{ +#' \item{If the data argument is \code{NULL} (the default) the data is +#' inherited from the global plot data as specified in the call to +#' \code{\link{ggplot}}.} +#' \item{If the data argument is a function, that function is called with the +#' global data as the only argument and the return value is used as the layer +#' data. The function must return a data.frame.} +#' \item{Any other type of value passed to \code{data} will be passed through +#' \code{\link{fortify}}, and there must thus be a \code{fortify} method +#' defined for the class of the value. Passing a data.frame is a special case +#' of this as \code{fortify.data.frame} returns the data.frame untouched.} +#' } +#' #' @export #' @inheritParams geom_point #' @param geom,stat,position Geom, stat and position adjustment to use in @@ -16,6 +36,13 @@ #' layer(geom = "point", stat = "identity", position = "identity", #' params = list(na.rm = FALSE) #' ) +#' +#' # use a function as data to plot a subset of global data +#' ggplot(mpg, aes(displ, hwy)) + +#' layer(geom = "point", stat = "identity", position = "identity", +#' data = head, params = list(na.rm = FALSE) +#' ) +#' layer <- function(geom = NULL, stat = NULL, data = NULL, mapping = NULL, position = NULL, params = list(), From 6510c450d6336550bfddb775c707f1fa762f30d0 Mon Sep 17 00:00:00 2001 From: Thomas Dybdal Pedersen Date: Mon, 1 Feb 2016 10:18:42 +0100 Subject: [PATCH 11/11] Roxygenise --- NAMESPACE | 1 + man/layer.Rd | 27 ++++++++++++++++++++++++++- 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 0e961f2106..95fc9a53fd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ S3method(format,facet) S3method(format,ggproto) S3method(format,ggproto_method) S3method(fortify,"NULL") +S3method(fortify,"function") S3method(fortify,Line) S3method(fortify,Lines) S3method(fortify,Polygon) diff --git a/man/layer.Rd b/man/layer.Rd index 4896e44a9a..ce9ec223b8 100644 --- a/man/layer.Rd +++ b/man/layer.Rd @@ -37,7 +37,25 @@ layer.} \code{FALSE} never includes, and \code{TRUE} always includes.} } \description{ -Create a new layer +A layer is a combination of data, stat and geom with a potential position +adjustment. Usually layers are created using \code{geom_*} or \code{stat_*} +calls but it can also be created directly using the \code{layer} function. +} +\details{ +The data in a layer can be specified in one of three ways: + +\itemize{ + \item{If the data argument is \code{NULL} (the default) the data is + inherited from the global plot data as specified in the call to + \code{\link{ggplot}}.} + \item{If the data argument is a function, that function is called with the + global data as the only argument and the return value is used as the layer + data. The function must return a data.frame.} + \item{Any other type of value passed to \code{data} will be passed through + \code{\link{fortify}}, and there must thus be a \code{fortify} method + defined for the class of the value. Passing a data.frame is a special case + of this as \code{fortify.data.frame} returns the data.frame untouched.} +} } \examples{ # geom calls are just a short cut for layer @@ -47,5 +65,12 @@ ggplot(mpg, aes(displ, hwy)) + layer(geom = "point", stat = "identity", position = "identity", params = list(na.rm = FALSE) ) + +# use a function as data to plot a subset of global data +ggplot(mpg, aes(displ, hwy)) + + layer(geom = "point", stat = "identity", position = "identity", + data = head, params = list(na.rm = FALSE) + ) + }