From 017992b8cf94d4ed10c81defc32133c2763dda44 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Mon, 2 Sep 2019 16:47:04 +0900 Subject: [PATCH 01/15] Make geom_ribbon() draw lines separately from polygons --- R/geom-ribbon.r | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 17df0ed118..d7912dc8eb 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -108,15 +108,29 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, )) munched <- coord_munch(coord, positions, panel_params) - ggname("geom_ribbon", polygonGrob( + g_poly <- polygonGrob( munched$x, munched$y, id = munched$id, default.units = "native", gp = gpar( fill = alpha(aes$fill, aes$alpha), + col = NA + ) + ) + + munched_lines <- munched + # increment the IDs of the lower line + munched_lines$id <- munched_lines$id <- rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)) + + g_lines <- polylineGrob( + munched_lines$x, munched_lines$y, id = munched_lines$id, + default.units = "native", + gp = gpar( col = aes$colour, lwd = aes$size * .pt, lty = aes$linetype) - )) + ) + + ggname("geom_ribbon", grobTree(g_poly, g_lines)) } ) From 43d12b1b406aa3bf8bafa654969d39b81ba3ea7f Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 11 Sep 2019 21:35:06 +0900 Subject: [PATCH 02/15] Update a visual case --- .../figs/geom-smooth/ribbon-turned-on-in-geom-smooth.svg | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/figs/geom-smooth/ribbon-turned-on-in-geom-smooth.svg b/tests/figs/geom-smooth/ribbon-turned-on-in-geom-smooth.svg index ce94b22ac2..62fde62163 100644 --- a/tests/figs/geom-smooth/ribbon-turned-on-in-geom-smooth.svg +++ b/tests/figs/geom-smooth/ribbon-turned-on-in-geom-smooth.svg @@ -19,9 +19,13 @@ - + + + - + + + From b871f0dee3e4dbb82e8ee3f57337285410fe2665 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 11 Sep 2019 21:41:17 +0900 Subject: [PATCH 03/15] Fix a test expectation --- tests/testthat/test-aes-setting.r | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-aes-setting.r b/tests/testthat/test-aes-setting.r index cae65767e3..6ec4771273 100644 --- a/tests/testthat/test-aes-setting.r +++ b/tests/testthat/test-aes-setting.r @@ -32,14 +32,15 @@ test_that("alpha affects only fill colour of solid geoms", { geom_polygon(fill = "red", colour = "red", alpha = 0.5) rect <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = 1, ymax = y + 1)) + geom_rect(fill = "red", colour = "red", alpha = 0.5) + # geom_ribbon() consists of polygonGrob and polylineGrob ribb <- ggplot(df, aes(x = x, ymin = 1, ymax = y + 1)) + geom_ribbon(fill = "red", colour = "red", alpha = 0.5) expect_equal(layer_grob(poly)[[1]]$gp$col[[1]], "red") expect_equal(layer_grob(rect)[[1]]$gp$col[[1]], "red") - expect_equal(layer_grob(ribb)[[1]]$children[[1]]$gp$col[[1]], "red") + expect_equal(layer_grob(ribb)[[1]]$children[[1]]$children[[2]]$gp$col[[1]], "red") expect_equal(layer_grob(poly)[[1]]$gp$fill[[1]], "#FF000080") expect_equal(layer_grob(rect)[[1]]$gp$fill[[1]], "#FF000080") - expect_equal(layer_grob(ribb)[[1]]$children[[1]]$gp$fill[[1]], "#FF000080") + expect_equal(layer_grob(ribb)[[1]]$children[[1]]$children[[1]]$gp$fill[[1]], "#FF000080") }) From 2b7b26c3f70b54a11785ac91484ab637a68e4959 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Tue, 8 Oct 2019 19:51:36 +0900 Subject: [PATCH 04/15] Fix a typo --- R/geom-ribbon.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index d7912dc8eb..d82a7372a6 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -119,7 +119,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, munched_lines <- munched # increment the IDs of the lower line - munched_lines$id <- munched_lines$id <- rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)) + munched_lines$id <- munched_lines$id + rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)) g_lines <- polylineGrob( munched_lines$x, munched_lines$y, id = munched_lines$id, From 1cab6a82afce19ca66b68eba6c19df6b8d41e369 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 17:42:51 +0900 Subject: [PATCH 05/15] Add option outline.type --- R/geom-ribbon.r | 31 +++++++++++++++++++++++++------ man/geom_ribbon.Rd | 8 ++++++-- 2 files changed, 31 insertions(+), 8 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index d82a7372a6..3011d94838 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -19,6 +19,9 @@ #' [geom_polygon()] for general polygons #' @inheritParams layer #' @inheritParams geom_point +#' @param outline.type Type of the outline of the area; `"both"` draws both the +#' upper and lower lines, `"upper"` draws the upper lines only. `"legacy"` +#' draws a closed polygon around the area. #' @export #' @examples #' # Generate data @@ -37,7 +40,10 @@ geom_ribbon <- function(mapping = NULL, data = NULL, ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) { + inherit.aes = TRUE, + outline.type = c("both", "upper", "legacy")) { + outline.type <- match.arg(outline.type) + layer( data = data, mapping = mapping, @@ -48,6 +54,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + outline.type = outline.type, ... ) ) @@ -78,7 +85,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, data }, - draw_group = function(data, panel_params, coord, na.rm = FALSE) { + draw_group = function(data, panel_params, coord, na.rm = FALSE, outline.type = "both") { if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ] data <- data[order(data$group), ] @@ -113,14 +120,21 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, default.units = "native", gp = gpar( fill = alpha(aes$fill, aes$alpha), - col = NA + col = if (identical(outline.type, "legacy")) aes$colour else NA ) ) + if (identical(outline.type, "legacy")) { + return(ggname("geom_ribbon", g_poly)) + } + munched_lines <- munched # increment the IDs of the lower line - munched_lines$id <- munched_lines$id + rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)) - + munched_lines$id <- switch(outline.type, + both = munched_lines$id + rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)), + upper = munched_lines$id + rep(c(0, NA), each = length(ids)), + abort(paste("inlvaid outline.type:", outline.type)) + ) g_lines <- polylineGrob( munched_lines$x, munched_lines$y, id = munched_lines$id, default.units = "native", @@ -132,13 +146,17 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, ggname("geom_ribbon", grobTree(g_poly, g_lines)) } + ) #' @rdname geom_ribbon #' @export geom_area <- function(mapping = NULL, data = NULL, stat = "identity", position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) { + inherit.aes = TRUE, ..., + outline.type = c("upper", "both", "legacy")) { + outline.type <- match.arg(outline.type) + layer( data = data, mapping = mapping, @@ -149,6 +167,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", inherit.aes = inherit.aes, params = list( na.rm = na.rm, + outline.type = outline.type, ... ) ) diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index f5142578ec..daf28f8daa 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -7,11 +7,11 @@ \usage{ geom_ribbon(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + inherit.aes = TRUE, outline.type = c("both", "upper", "legacy")) geom_area(mapping = NULL, data = NULL, stat = "identity", position = "stack", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, ...) + inherit.aes = TRUE, ..., outline.type = c("upper", "both", "legacy")) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -58,6 +58,10 @@ display.} rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} + +\item{outline.type}{Type of the outline of the area; \code{"both"} draws both the +upper and lower lines, \code{"upper"} draws the upper lines only. \code{"legacy"} +draws a closed polygon around the area.} } \description{ For each x value, \code{geom_ribbon()} displays a y interval defined From 1a5c22562440772c2aeac7d945ddf87ff099c76f Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 18:09:35 +0900 Subject: [PATCH 06/15] Fix argument of geom_ribbon() and geom_area() to match with GeomRibbon --- R/geom-ribbon.r | 8 ++++---- man/geom_ribbon.Rd | 6 ++---- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index fb8fd56ef0..9c153f1f0d 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -48,8 +48,8 @@ geom_ribbon <- function(mapping = NULL, data = NULL, orientation = NA, show.legend = NA, inherit.aes = TRUE, - outline.type = c("both", "upper", "legacy")) { - outline.type <- match.arg(outline.type) + outline.type = "both") { + outline.type <- match.arg(outline.type, c("both", "upper", "legacy")) layer( data = data, @@ -177,8 +177,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, geom_area <- function(mapping = NULL, data = NULL, stat = "identity", position = "stack", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ..., - outline.type = c("upper", "both", "legacy")) { - outline.type <- match.arg(outline.type) + outline.type = "upper") { + outline.type <- match.arg(outline.type, c("both", "upper", "legacy")) layer( data = data, diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index 3fbbedbc89..3f4a1c9e63 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -7,13 +7,11 @@ \usage{ geom_ribbon(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, orientation = NA, - show.legend = NA, inherit.aes = TRUE, outline.type = c("both", - "upper", "legacy")) + show.legend = NA, inherit.aes = TRUE, outline.type = "both") geom_area(mapping = NULL, data = NULL, stat = "identity", position = "stack", na.rm = FALSE, orientation = NA, - show.legend = NA, inherit.aes = TRUE, ..., - outline.type = c("upper", "both", "legacy")) + show.legend = NA, inherit.aes = TRUE, ..., outline.type = "upper") } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or From f6f67e29370f0e33ac6931338e10eca17a857e1c Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 18:21:45 +0900 Subject: [PATCH 07/15] Add a test for outline.type --- tests/testthat/test-geom-ribbon.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index b8e01b7484..ccadaac3f1 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -26,3 +26,32 @@ test_that("geom_ribbon works in both directions", { y$flipped_aes <- NULL expect_identical(x, flip_data(y, TRUE)[,names(x)]) }) + +test_that("outline.type option works", { + df <- data_frame(x = 1:4, y = c(1, 1, 1, 1)) + + p <- ggplot(df, aes(x, ymin = -y, ymax = y)) + + g_ribbon_default <- layer_grob(p + geom_ribbon())[[1]] + g_ribbon_upper <- layer_grob(p + geom_ribbon(outline.type = "upper"))[[1]] + g_ribbon_legacy <- layer_grob(p + geom_ribbon(outline.type = "legacy"))[[1]] + g_area_default <- layer_grob(ggplot(df, aes(x, y)) + geom_area())[[1]] + + # default + expect_s3_class(g_ribbon_default$children[[1]]$children[[1]], "polygon") + expect_s3_class(g_ribbon_default$children[[1]]$children[[2]], "polyline") + expect_equal(g_ribbon_default$children[[1]]$children[[2]]$id, rep(c(1L, 2L), each = 4)) + + # upper + expect_s3_class(g_ribbon_upper$children[[1]]$children[[1]], "polygon") + expect_s3_class(g_ribbon_upper$children[[1]]$children[[2]], "polyline") + expect_equal(g_ribbon_upper$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4)) + + # legacy + expect_s3_class(g_ribbon_legacy$children[[1]], "polygon") + + # geom_area()'s default is upper + expect_s3_class(g_area_default$children[[1]]$children[[1]], "polygon") + expect_s3_class(g_area_default$children[[1]]$children[[2]], "polyline") + expect_equal(g_ribbon_default$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4)) +}) From 0cff7cdcdf422db55c0a4017a2c21f857717bfc8 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 18:22:36 +0900 Subject: [PATCH 08/15] Remove whitespaces --- tests/testthat/test-geom-ribbon.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index ccadaac3f1..5a310d40ab 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -31,7 +31,7 @@ test_that("outline.type option works", { df <- data_frame(x = 1:4, y = c(1, 1, 1, 1)) p <- ggplot(df, aes(x, ymin = -y, ymax = y)) - + g_ribbon_default <- layer_grob(p + geom_ribbon())[[1]] g_ribbon_upper <- layer_grob(p + geom_ribbon(outline.type = "upper"))[[1]] g_ribbon_legacy <- layer_grob(p + geom_ribbon(outline.type = "legacy"))[[1]] From 9c21ed72db8acaefc4f04db021a438cccc636ef5 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 18:31:07 +0900 Subject: [PATCH 09/15] Ignore argument checks on geom_area() --- tests/testthat/test-function-args.r | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-function-args.r b/tests/testthat/test-function-args.r index 4af370ab6d..b84aa029f9 100644 --- a/tests/testthat/test-function-args.r +++ b/tests/testthat/test-function-args.r @@ -13,7 +13,8 @@ test_that("geom_xxx and GeomXxx$draw arg defaults match", { # These aren't actually geoms, or need special parameters and can't be tested this way. geom_fun_names <- setdiff( geom_fun_names, - c("geom_map", "geom_sf", "geom_smooth", "geom_column", "annotation_custom", "annotation_map", + c("geom_map", "geom_sf", "geom_smooth", "geom_column", "geom_area", + "annotation_custom", "annotation_map", "annotation_raster", "annotation_id") ) From 69a762d7ef4e4b6f4daa400a323167c4763d8e0f Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 13 Oct 2019 18:45:24 +0900 Subject: [PATCH 10/15] Fix test --- tests/testthat/test-geom-ribbon.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index 5a310d40ab..d805a8e66b 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -53,5 +53,5 @@ test_that("outline.type option works", { # geom_area()'s default is upper expect_s3_class(g_area_default$children[[1]]$children[[1]], "polygon") expect_s3_class(g_area_default$children[[1]]$children[[2]], "polyline") - expect_equal(g_ribbon_default$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4)) + expect_equal(g_area_default$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4)) }) From 7d8554a3bd1b883a0a652da24642415fefc13a5e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 18 Dec 2019 12:09:10 +0900 Subject: [PATCH 11/15] Update R/geom-ribbon.r Co-Authored-By: Thomas Lin Pedersen --- R/geom-ribbon.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 9c153f1f0d..accac6f25a 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -156,7 +156,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, munched_lines$id <- switch(outline.type, both = munched_lines$id + rep(c(0, max(ids, na.rm = TRUE)), each = length(ids)), upper = munched_lines$id + rep(c(0, NA), each = length(ids)), - abort(paste("inlvaid outline.type:", outline.type)) + abort(glue("invalid outline.type: {outline.type}")) ) g_lines <- polylineGrob( munched_lines$x, munched_lines$y, id = munched_lines$id, From 5f2c106a2d03743a995e925e1224b61ebf4feb09 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 19 Dec 2019 20:35:24 +0900 Subject: [PATCH 12/15] Add a NEWS bullet --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 96a5333c06..8760b81d12 100644 --- a/NEWS.md +++ b/NEWS.md @@ -122,6 +122,11 @@ * `stat_summary()` and related functions now support rlang-style lambda functions (#3568, @dkahle). +* `geom_ribbon()` now draws separate lines for the upper and lower intervals if + `colour` is mapped by default. Similarly, `geom_area()` now draws lines for + the upper in the same case by default. If you want old-style full stroking, use + `outlier.type = "legacy"` (#3503, @yutannihilation). + # ggplot2 3.2.1 From f761f3a8dfc72465b4e8a74be2ea1211a198fea7 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 19 Dec 2019 20:50:21 +0900 Subject: [PATCH 13/15] Remove suspicious diff --- R/geom-ribbon.r | 1 - 1 file changed, 1 deletion(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index a8bfb3adcd..653228c7a0 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -21,7 +21,6 @@ #' [geom_polygon()] for general polygons #' @inheritParams layer #' @inheritParams geom_bar -#' @inheritParams geom_point #' @param outline.type Type of the outline of the area; `"both"` draws both the #' upper and lower lines, `"upper"` draws the upper lines only. `"legacy"` #' draws a closed polygon around the area. From 6c485e2a705a66cc08fbfdc2f82cf35f8d6b27e9 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sat, 4 Jan 2020 22:08:44 +0900 Subject: [PATCH 14/15] Warn on `outline = "legacy"` --- R/geom-ribbon.r | 2 ++ tests/testthat/test-geom-ribbon.R | 6 +++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 653228c7a0..f63199f6a4 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -148,6 +148,8 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, ) if (identical(outline.type, "legacy")) { + warn(glue('outline.type = "legacy" is only for backward-compatibility ', + 'and might be removed eventually')) return(ggname("geom_ribbon", g_poly)) } diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index d805a8e66b..918724e84c 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -34,7 +34,11 @@ test_that("outline.type option works", { g_ribbon_default <- layer_grob(p + geom_ribbon())[[1]] g_ribbon_upper <- layer_grob(p + geom_ribbon(outline.type = "upper"))[[1]] - g_ribbon_legacy <- layer_grob(p + geom_ribbon(outline.type = "legacy"))[[1]] + g_ribbon_legacy <- expect_warning( + layer_grob(p + geom_ribbon(outline.type = "legacy"))[[1]], + 'outline.type = "legacy" is only for backward-compatibility and might be removed eventually', + fixed = TRUE + ) g_area_default <- layer_grob(ggplot(df, aes(x, y)) + geom_area())[[1]] # default From d827fd33280c236f8b822bf8ddff2e6a79eb77d0 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sat, 4 Jan 2020 22:22:33 +0900 Subject: [PATCH 15/15] Update a visual case --- tests/figs/position-stack/area-stacking.svg | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/figs/position-stack/area-stacking.svg b/tests/figs/position-stack/area-stacking.svg index 8d5b1cf323..d74f6ff306 100644 --- a/tests/figs/position-stack/area-stacking.svg +++ b/tests/figs/position-stack/area-stacking.svg @@ -19,8 +19,10 @@ - - + + + +