diff --git a/NEWS.md b/NEWS.md
index 03ccc23d88..2dfafce942 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
diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r
index 07dfbc882a..f63199f6a4 100644
--- a/R/geom-ribbon.r
+++ b/R/geom-ribbon.r
@@ -21,6 +21,9 @@
#' [geom_polygon()] for general polygons
#' @inheritParams layer
#' @inheritParams geom_bar
+#' @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
@@ -44,7 +47,10 @@ geom_ribbon <- function(mapping = NULL, data = NULL,
na.rm = FALSE,
orientation = NA,
show.legend = NA,
- inherit.aes = TRUE) {
+ inherit.aes = TRUE,
+ outline.type = "both") {
+ outline.type <- match.arg(outline.type, c("both", "upper", "legacy"))
+
layer(
data = data,
mapping = mapping,
@@ -56,6 +62,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL,
params = list(
na.rm = na.rm,
orientation = orientation,
+ outline.type = outline.type,
...
)
)
@@ -97,7 +104,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
data
},
- draw_group = function(data, panel_params, coord, na.rm = FALSE, flipped_aes = FALSE) {
+ draw_group = function(data, panel_params, coord, na.rm = FALSE, flipped_aes = FALSE, outline.type = "both") {
data <- flip_data(data, flipped_aes)
if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
data <- data[order(data$group), ]
@@ -131,23 +138,50 @@ 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 = if (identical(outline.type, "legacy")) aes$colour else NA
+ )
+ )
+
+ 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))
+ }
+
+ munched_lines <- munched
+ # increment the IDs of the lower line
+ 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(glue("invalid outline.type: {outline.type}"))
+ )
+ 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))
}
+
)
#' @rdname geom_ribbon
#' @export
geom_area <- function(mapping = NULL, data = NULL, stat = "identity",
position = "stack", na.rm = FALSE, orientation = NA,
- show.legend = NA, inherit.aes = TRUE, ...) {
+ show.legend = NA, inherit.aes = TRUE, ...,
+ outline.type = "upper") {
+ outline.type <- match.arg(outline.type, c("both", "upper", "legacy"))
+
layer(
data = data,
mapping = mapping,
@@ -159,6 +193,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity",
params = list(
na.rm = na.rm,
orientation = orientation,
+ outline.type = outline.type,
...
)
)
diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd
index 863a223b8b..65f0b91021 100644
--- a/man/geom_ribbon.Rd
+++ b/man/geom_ribbon.Rd
@@ -14,7 +14,8 @@ geom_ribbon(
na.rm = FALSE,
orientation = NA,
show.legend = NA,
- inherit.aes = TRUE
+ inherit.aes = TRUE,
+ outline.type = "both"
)
geom_area(
@@ -26,7 +27,8 @@ geom_area(
orientation = NA,
show.legend = NA,
inherit.aes = TRUE,
- ...
+ ...,
+ outline.type = "upper"
)
}
\arguments{
@@ -79,6 +81,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
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 @@
-
+
+
+
-
+
+
+
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 @@
-
-
+
+
+
+
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")
})
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")
)
diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R
index b8e01b7484..918724e84c 100644
--- a/tests/testthat/test-geom-ribbon.R
+++ b/tests/testthat/test-geom-ribbon.R
@@ -26,3 +26,36 @@ 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 <- 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
+ 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_area_default$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4))
+})