Skip to content
Merged
20 changes: 16 additions & 4 deletions R/plot-build.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,9 @@
#' layer. These are useful for tests.
#'
#' @param plot ggplot object
#' @param i An integer. In `get_layer_data()`, the data to return (in the order added to the
#' @param i An integer or a name of a layer. In `get_layer_data()`, the data to return (in the order added to the
#' plot). In `get_layer_grob()`, the grob to return (in the order added to the
#' plot). In `get_panel_scales()`, the row of a facet to return scales for.
#' plot). In `get_panel_scales()` (only integers allowed), the row of a facet to return scales for.
#' @param j An integer. In `get_panel_scales()`, the column of a facet to return
#' scales for.
#' @param ... Not currently in use.
Expand Down Expand Up @@ -142,8 +142,15 @@ build_ggplot <- S7::method(ggplot_build, class_ggplot) <- function(plot, ...) {
#' @export
#' @rdname ggplot_build
get_layer_data <- function(plot = get_last_plot(), i = 1L) {
ggplot_build(plot)@data[[i]]
b <- ggplot_build(plot)
idx <- vec_as_location2(
i = i,
n = vec_size(b@plot@layers),
names = names(b@plot@layers)
)
b@data[[idx]]
}

#' @export
#' @rdname ggplot_build
layer_data <- get_layer_data
Expand Down Expand Up @@ -171,7 +178,12 @@ layer_scales <- get_panel_scales
get_layer_grob <- function(plot = get_last_plot(), i = 1L) {
b <- ggplot_build(plot)

b@plot@layers[[i]]$draw_geom(b@data[[i]], b@layout)
idx <- vec_as_location2(
i = i,
n = vec_size(b@plot@layers),
names = names(b@plot@layers)
)
b@plot@layers[[idx]]$draw_geom(b@data[[idx]], b@layout)
}

#' @export
Expand Down
4 changes: 2 additions & 2 deletions man/ggplot_build.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

22 changes: 22 additions & 0 deletions tests/testthat/_snaps/layer.md
Original file line number Diff line number Diff line change
Expand Up @@ -145,3 +145,25 @@

`layer_data()` must return a <data.frame>.

# get_layer_data works with layer names

Can't extract elements that don't exist.
x Element `none` doesn't exist.

---

Can't extract elements past the end.
i Location 4 doesn't exist.
i There are only 2 elements.

# get_layer_grob works with layer names

Can't extract elements that don't exist.
x Element `none` doesn't exist.

---

Can't extract elements past the end.
i Location 4 doesn't exist.
i There are only 2 elements.

36 changes: 36 additions & 0 deletions tests/testthat/test-layer.R
Original file line number Diff line number Diff line change
Expand Up @@ -226,6 +226,42 @@ test_that("layer_data returns a data.frame", {
expect_snapshot_error(l$layer_data(mtcars))
})

test_that("get_layer_data works with layer names", {
p <- ggplot() + geom_point(name = "foo") + geom_point(name = "bar")

# name has higher precedence than index
expect_identical(
get_layer_data(p, i = "bar"),
get_layer_data(p, i = 2L)
)

# name falls back to index
expect_snapshot_error(
get_layer_data(p, i ="none")
)
expect_snapshot_error(
get_layer_data(p, i = 4L)
)
})

test_that("get_layer_grob works with layer names", {
p <- ggplot() + geom_point(name = "foo") + geom_point(name = "bar")

# name has higher precedence than index
expect_identical(
get_layer_grob(p, i = "bar"),
get_layer_grob(p, i = 2L)
)

# name falls back to index
expect_snapshot_error(
get_layer_grob(p, i ="none")
)
expect_snapshot_error(
get_layer_grob(p, i = 4L)
)
})

test_that("data.frames and matrix aesthetics survive the build stage", {
df <- data_frame0(
x = 1:2,
Expand Down