From 886112f9ff5490863393ef91905e8efcf99d6a0e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 10 Feb 2019 16:45:20 +0900 Subject: [PATCH 1/5] Pass actual data to GeomCustomAnn in order to support scale transformations --- R/annotation-custom.r | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/R/annotation-custom.r b/R/annotation-custom.r index c27f7c7d61..76a4d57f4f 100644 --- a/R/annotation-custom.r +++ b/R/annotation-custom.r @@ -42,18 +42,17 @@ NULL #' base + #' annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) { + data <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) + layer( - data = dummy_data(), + data = data, + mapping = aes(x = x, y = y), stat = StatIdentity, position = PositionIdentity, geom = GeomCustomAnn, inherit.aes = FALSE, params = list( - grob = grob, - xmin = xmin, - xmax = xmax, - ymin = ymin, - ymax = ymax + grob = grob ) ) } @@ -64,18 +63,19 @@ annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = #' @export GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, extra_params = "", + + required_aes = c("x", "y"), + handle_na = function(data, params) { data }, - draw_panel = function(data, panel_params, coord, grob, xmin, xmax, - ymin, ymax) { + draw_panel = function(data, panel_params, coord, grob) { if (!inherits(coord, "CoordCartesian")) { stop("annotation_custom only works with Cartesian coordinates", call. = FALSE) } - corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) - data <- coord$transform(corners, panel_params) + data <- coord$transform(data, panel_params) x_rng <- range(data$x, na.rm = TRUE) y_rng <- range(data$y, na.rm = TRUE) @@ -84,9 +84,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, width = diff(x_rng), height = diff(y_rng), just = c("center","center")) editGrob(grob, vp = vp, name = paste(grob$name, annotation_id())) - }, - - default_aes = aes_(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) + } ) annotation_id <- local({ From 7413a2cc30517b97cb4a74881ae22827bfb32ee7 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 10 Feb 2019 17:06:58 +0900 Subject: [PATCH 2/5] Use xmin, xmax, ymin, and ymax --- R/annotation-custom.r | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/annotation-custom.r b/R/annotation-custom.r index 76a4d57f4f..4ecf964577 100644 --- a/R/annotation-custom.r +++ b/R/annotation-custom.r @@ -42,11 +42,11 @@ NULL #' base + #' annotation_custom(grob = g, xmin = 1, xmax = 10, ymin = 8, ymax = 10) annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) { - data <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) + data <- new_data_frame(list(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), n = 1) layer( data = data, - mapping = aes(x = x, y = y), + mapping = aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), stat = StatIdentity, position = PositionIdentity, geom = GeomCustomAnn, @@ -64,8 +64,6 @@ annotation_custom <- function(grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, extra_params = "", - required_aes = c("x", "y"), - handle_na = function(data, params) { data }, @@ -75,6 +73,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, stop("annotation_custom only works with Cartesian coordinates", call. = FALSE) } + data <- new_data_frame(list(x = c(data$xmin, data$xmax), y = c(data$ymin, data$ymax)), n = 2) data <- coord$transform(data, panel_params) x_rng <- range(data$x, na.rm = TRUE) @@ -84,7 +83,9 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, width = diff(x_rng), height = diff(y_rng), just = c("center","center")) editGrob(grob, vp = vp, name = paste(grob$name, annotation_id())) - } + }, + + required_aes = c("xmin", "xmax", "ymin", "ymax") ) annotation_id <- local({ From f51dbbdf3d703c61b00dbbb0dcdcaeb49976d872 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 14 Feb 2019 12:09:54 +0900 Subject: [PATCH 3/5] Reform tests --- tests/testthat/test-annotate.r | 39 ++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-annotate.r b/tests/testthat/test-annotate.r index b510c3ced2..3a2e73d2da 100644 --- a/tests/testthat/test-annotate.r +++ b/tests/testthat/test-annotate.r @@ -30,22 +30,35 @@ test_that("segment annotations transform with scales", { expect_doppelganger("line matches points", plot) }) -test_that("annotation_* has dummy data assigned and don't inherit aes", { - custom <- annotation_custom(zeroGrob()) - logtick <- annotation_logticks() +test_that("annotation_custom() has data and don't inherit aes", { + custom <- annotation_custom(zeroGrob(), xmin = -1, xmax = 1, ymin = -1, ymax = 1) + + expect_equal(custom$data, data_frame(xmin = -1, xmax = 1, ymin = -1, ymax = 1)) + # can be transformed + expect_equal(layer_data(ggplot() + custom + scale_x_reverse() + scale_y_reverse())[, c("xmin", "xmax", "ymin", "ymax")], + data_frame(xmin = 1, xmax = -1, ymin = 1, ymax = -1)) + + expect_false(custom$inherit.aes) +}) + +test_that("annotation_raster() has data and don't inherit aes", { + rainbow <- matrix(hcl(seq(0, 360, length.out = 50 * 50), 80, 70), nrow = 50) + raster <- annotation_raster(rainbow, 15, 20, 3, 4) + expect_equal(raster$data, dummy_data()) + expect_false(raster$inherit.aes) +}) + +test_that("annotation_map() has data and don't inherit aes", { library(maps) usamap <- map_data("state") map <- annotation_map(usamap) - rainbow <- matrix(hcl(seq(0, 360, length.out = 50 * 50), 80, 70), nrow = 50) - raster <- annotation_raster(rainbow, 15, 20, 3, 4) - dummy <- dummy_data() - expect_equal(custom$data, dummy) - expect_equal(logtick$data, dummy) - expect_equal(map$data, dummy) - expect_equal(raster$data, dummy) + expect_equal(map$data, dummy_data()) + expect_false(map$inherit.aes) +}) + +test_that("annotation_logstick() has dummy data assigned and don't inherit aes", { + logtick <- annotation_logticks() + expect_equal(logtick$data, dummy_data()) - expect_false(custom$inherit.aes) expect_false(logtick$inherit.aes) - expect_false(map$inherit.aes) - expect_false(raster$inherit.aes) }) From 65914b6af1c6701fe3a0ba5b097e11d225a7d558 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 14 Feb 2019 12:21:21 +0900 Subject: [PATCH 4/5] Make annotation_raster() have data --- R/annotation-raster.r | 17 ++++++++--------- tests/testthat/test-annotate.r | 7 ++++++- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/R/annotation-raster.r b/R/annotation-raster.r index 1851831299..7a70c4d939 100644 --- a/R/annotation-raster.r +++ b/R/annotation-raster.r @@ -40,20 +40,17 @@ NULL annotation_raster <- function(raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { raster <- grDevices::as.raster(raster) + data <- new_data_frame(list(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), n = 1) layer( - data = dummy_data(), - mapping = NULL, + data = data, + mapping = aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax), stat = StatIdentity, position = PositionIdentity, geom = GeomRasterAnn, inherit.aes = FALSE, params = list( raster = raster, - xmin = xmin, - xmax = xmax, - ymin = ymin, - ymax = ymax, interpolate = interpolate ) ) @@ -76,8 +73,8 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, stop("annotation_raster only works with Cartesian coordinates", call. = FALSE) } - corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) - data <- coord$transform(corners, panel_params) + data <- new_data_frame(list(x = c(data$xmin, data$xmax), y = c(data$ymin, data$ymax)), n = 2) + data <- coord$transform(data, panel_params) x_rng <- range(data$x, na.rm = TRUE) y_rng <- range(data$y, na.rm = TRUE) @@ -85,5 +82,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, rasterGrob(raster, x_rng[1], y_rng[1], diff(x_rng), diff(y_rng), default.units = "native", just = c("left","bottom"), interpolate = interpolate) - } + }, + + required_aes = c("xmin", "xmax", "ymin", "ymax") ) diff --git a/tests/testthat/test-annotate.r b/tests/testthat/test-annotate.r index 3a2e73d2da..e50b9784a0 100644 --- a/tests/testthat/test-annotate.r +++ b/tests/testthat/test-annotate.r @@ -44,7 +44,12 @@ test_that("annotation_custom() has data and don't inherit aes", { test_that("annotation_raster() has data and don't inherit aes", { rainbow <- matrix(hcl(seq(0, 360, length.out = 50 * 50), 80, 70), nrow = 50) raster <- annotation_raster(rainbow, 15, 20, 3, 4) - expect_equal(raster$data, dummy_data()) + + expect_equal(raster$data, data_frame(xmin = 15, xmax = 20, ymin = 3, ymax = 4)) + # can be transformed + expect_equal(layer_data(ggplot() + raster + scale_x_reverse() + scale_y_reverse())[, c("xmin", "xmax", "ymin", "ymax")], + data_frame(xmin = -15, xmax = -20, ymin = -3, ymax = -4)) + expect_false(raster$inherit.aes) }) From 5a655fa06e1453c4da53df186e54e29ee8509f67 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 14 Feb 2019 12:27:41 +0900 Subject: [PATCH 5/5] Revert map test --- tests/testthat/test-annotate.r | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-annotate.r b/tests/testthat/test-annotate.r index e50b9784a0..a4423ec8b0 100644 --- a/tests/testthat/test-annotate.r +++ b/tests/testthat/test-annotate.r @@ -53,17 +53,15 @@ test_that("annotation_raster() has data and don't inherit aes", { expect_false(raster$inherit.aes) }) -test_that("annotation_map() has data and don't inherit aes", { +test_that("annotation_map() and annotation_logstick() has dummy data assigned and don't inherit aes", { library(maps) usamap <- map_data("state") map <- annotation_map(usamap) - expect_equal(map$data, dummy_data()) - expect_false(map$inherit.aes) -}) - -test_that("annotation_logstick() has dummy data assigned and don't inherit aes", { logtick <- annotation_logticks() + + expect_equal(map$data, dummy_data()) expect_equal(logtick$data, dummy_data()) + expect_false(map$inherit.aes) expect_false(logtick$inherit.aes) })