Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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)
)
Comment on lines +233 to +236
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think the intent of this test is good. However, I think the test would also pass if the index was mismatched because the layer data of both layers would be the same.


# name falls back to index
expect_snapshot_error(
get_layer_data(p, i ="none")
)
expect_snapshot_error(
get_layer_data(p, i = 4L)
)
Comment on lines +238 to +244
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is good that these errors are thrown, but I don't think ggplot2 needs to test for them. They are outside ggplot2's control as they are thrown by the vctrs package. If the message changes, that doesn't imply that ggplot2 needs to change.

})

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)
)
Comment on lines +257 to +262
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Likewise, I think we don't need these tests.

})

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