From 6d480d82324827942a3df3d768c101cc93e62cd4 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 24 May 2020 19:16:40 +0900 Subject: [PATCH 1/2] Process upper and lower lines separately --- R/geom-ribbon.r | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index fa679ddd66..c97fccb079 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -128,19 +128,31 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, ids[missing_pos] <- NA data <- unclass(data) #for faster indexing - positions <- new_data_frame(list( - x = c(data$x, rev(data$x)), - y = c(data$ymax, rev(data$ymin)), - id = c(ids, rev(ids)) + + # The upper line and lower line need to processed separately (#4023) + positions_upper <- new_data_frame(list( + x = data$x, + y = data$ymax, + id = ids + )) + + positions_lower <- new_data_frame(list( + x = rev(data$x), + y = rev(data$ymin), + id = rev(ids) )) - positions <- flip_data(positions, flipped_aes) + positions_upper <- flip_data(positions_upper, flipped_aes) + positions_lower <- flip_data(positions_lower, flipped_aes) - munched <- coord_munch(coord, positions, panel_params) + munched_upper <- coord_munch(coord, positions_upper, panel_params) + munched_lower <- coord_munch(coord, positions_lower, panel_params) + + munched_poly <- rbind(munched_upper, munched_lower) is_full_outline <- identical(outline.type, "full") g_poly <- polygonGrob( - munched$x, munched$y, id = munched$id, + munched_poly$x, munched_poly$y, id = munched_poly$id, default.units = "native", gp = gpar( fill = alpha(aes$fill, aes$alpha), @@ -154,12 +166,13 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, 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)), - lower = munched_lines$id + rep(c(NA, 0), each = length(ids)), + # Increment the IDs of the lower line so that they will be drawn as separate lines + munched_lower$id <- munched_lower$id + max(ids, na.rm = TRUE) + + munched_lines <- switch(outline.type, + both = rbind(munched_upper, munched_lower), + upper = munched_upper, + lower = munched_lower, abort(glue("invalid outline.type: {outline.type}")) ) g_lines <- polylineGrob( From 8568317a1737ead14a93df9658f43df0f2cda471 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 24 May 2020 19:21:59 +0900 Subject: [PATCH 2/2] Update test expectations --- tests/testthat/test-geom-ribbon.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R index 9fa775fe41..535e313651 100644 --- a/tests/testthat/test-geom-ribbon.R +++ b/tests/testthat/test-geom-ribbon.R @@ -46,12 +46,12 @@ test_that("outline.type option works", { # 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)) + expect_equal(g_ribbon_upper$children[[1]]$children[[2]]$id, rep(1L, each = 4)) # lower expect_s3_class(g_ribbon_lower$children[[1]]$children[[1]], "polygon") expect_s3_class(g_ribbon_lower$children[[1]]$children[[2]], "polyline") - expect_equal(g_ribbon_lower$children[[1]]$children[[2]]$id, rep(c(NA, 1L), each = 4)) + expect_equal(g_ribbon_lower$children[[1]]$children[[2]]$id, rep(2L, each = 4)) # full expect_s3_class(g_ribbon_full$children[[1]], "polygon") @@ -59,5 +59,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_area_default$children[[1]]$children[[2]]$id, rep(c(1L, NA), each = 4)) + expect_equal(g_area_default$children[[1]]$children[[2]]$id, rep(1L, each = 4)) })