From f46805349d6ca8ca7a99f8966cfa0f29279c2f6c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 13 Nov 2024 09:24:11 +0100 Subject: [PATCH] `annotation_raster()/_custom()` respond to scale transformations (#6182) * helper for annotation ranges * use helper * update snapshots * use vctrs rules to preserve AsIs * add test * add news bullet * allow mixing AsIs and numeric * clarify AsIs change in news --- NEWS.md | 3 +++ R/annotation-custom.R | 37 +++++++++++++++++++------------ R/annotation-raster.R | 22 ++++++------------ tests/testthat/_snaps/annotate.md | 4 ++-- tests/testthat/test-annotate.R | 29 ++++++++++++++++++++++++ 5 files changed, 64 insertions(+), 31 deletions(-) diff --git a/NEWS.md b/NEWS.md index 081504c782..0c493a8f58 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* Custom and raster annotation now respond to scale transformations, and can + use AsIs variables for relative placement (@teunbrand based on + @yutannihilation's prior work, #3120) * When discrete breaks have names, they'll be used as labels by default (@teunbrand, #6147). * The helper function `is.waiver()` is now exported to help extensions to work diff --git a/R/annotation-custom.R b/R/annotation-custom.R index 4261526b89..76cb26ac2c 100644 --- a/R/annotation-custom.R +++ b/R/annotation-custom.R @@ -70,21 +70,12 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, draw_panel = function(data, panel_params, coord, grob, xmin, xmax, ymin, ymax) { - if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}.") - } - corners <- data_frame0( - x = c(xmin, xmax), - y = c(ymin, ymax), - .size = 2 + range <- ranges_annotation( + coord, panel_params, xmin, xmax, ymin, ymax, + fun = "annotation_custom" ) - data <- coord$transform(corners, panel_params) - - x_rng <- range(data$x, na.rm = TRUE) - y_rng <- range(data$y, na.rm = TRUE) - - vp <- viewport(x = mean(x_rng), y = mean(y_rng), - width = diff(x_rng), height = diff(y_rng), + vp <- viewport(x = mean(range$x), y = mean(range$y), + width = diff(range$x), height = diff(range$y), just = c("center","center")) editGrob(grob, vp = vp, name = paste(grob$name, annotation_id())) }, @@ -99,3 +90,21 @@ annotation_id <- local({ i } }) + +ranges_annotation <- function(coord, panel_params, xmin, xmax, ymin, ymax, fun) { + if (!inherits(coord, "CoordCartesian")) { + cli::cli_abort("{.fn {fun}} only works with {.fn coord_cartesian}.") + } + data <- data_frame0(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax) + data <- .ignore_data(data)[[1]] + x <- panel_params$x$scale$transform_df(data) + data[names(x)] <- x + y <- panel_params$y$scale$transform_df(data) + data[names(y)] <- y + data <- .expose_data(data)[[1]] + data <- coord$transform(data, panel_params) + list( + x = range(data$xmin, data$xmax, na.rm = TRUE), + y = range(data$ymin, data$ymax, na.rm = TRUE) + ) +} diff --git a/R/annotation-raster.R b/R/annotation-raster.R index 8eb8685883..2635cf05de 100644 --- a/R/annotation-raster.R +++ b/R/annotation-raster.R @@ -73,21 +73,13 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, draw_panel = function(data, panel_params, coord, raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { - if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}.") - } - corners <- data_frame0( - x = c(xmin, xmax), - y = c(ymin, ymax), - .size = 2 + range <- ranges_annotation( + coord, panel_params, xmin, xmax, ymin, ymax, + fun = "annotation_raster" + ) + rasterGrob(raster, range$x[1], range$y[1], + diff(range$x), diff(range$y), default.units = "native", + just = c("left","bottom"), interpolate = interpolate ) - data <- coord$transform(corners, panel_params) - - x_rng <- range(data$x, na.rm = TRUE) - y_rng <- range(data$y, na.rm = TRUE) - - rasterGrob(raster, x_rng[1], y_rng[1], - diff(x_rng), diff(y_rng), default.units = "native", - just = c("left","bottom"), interpolate = interpolate) } ) diff --git a/tests/testthat/_snaps/annotate.md b/tests/testthat/_snaps/annotate.md index 23c8e0df43..abf4bb83e7 100644 --- a/tests/testthat/_snaps/annotate.md +++ b/tests/testthat/_snaps/annotate.md @@ -2,14 +2,14 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. - Caused by error in `draw_panel()`: + Caused by error in `ranges_annotation()`: ! `annotation_raster()` only works with `coord_cartesian()`. --- Problem while converting geom to grob. i Error occurred in the 1st layer. - Caused by error in `draw_panel()`: + Caused by error in `ranges_annotation()`: ! `annotation_custom()` only works with `coord_cartesian()`. # annotation_map() checks the input data diff --git a/tests/testthat/test-annotate.R b/tests/testthat/test-annotate.R index 129b5b6720..a0200a82d3 100644 --- a/tests/testthat/test-annotate.R +++ b/tests/testthat/test-annotate.R @@ -86,3 +86,32 @@ test_that("annotate() warns about `stat` or `position` arguments", { annotate("point", 1:3, 1:3, stat = "density", position = "dodge") ) }) + +test_that("annotation_custom() and annotation_raster() adhere to scale transforms", { + rast <- matrix(rainbow(10), nrow = 1) + + p <- ggplot() + + annotation_raster(rast, 1, 10, 1, 9) + + scale_x_continuous(transform = "log10", limits = c(0.1, 100), expand = FALSE) + + scale_y_continuous(limits = c(0, 10), expand = FALSE) + ann <- get_layer_grob(p)[[1]] + + expect_equal(as.numeric(ann$x), 1/3) + expect_equal(as.numeric(ann$y), 1/10) + expect_equal(as.numeric(ann$width), 1/3) + expect_equal(as.numeric(ann$height), 8/10) + + rast <- rasterGrob(rast, width = 1, height = 1) + + p <- ggplot() + + annotation_custom(rast, 1, 10, 1, 9) + + scale_x_continuous(transform = "log10", limits = c(0.1, 100), expand = FALSE) + + scale_y_continuous(limits = c(0, 10), expand = FALSE) + ann <- get_layer_grob(p)[[1]]$vp + + expect_equal(as.numeric(ann$x), 1/2) + expect_equal(as.numeric(ann$y), 1/2) + expect_equal(as.numeric(ann$width), 1/3) + expect_equal(as.numeric(ann$height), 8/10) + +})