Fix geom_ribbon() on non-cartesian Coords (#4025)

* Process upper and lower lines separately

* Update test expectations

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(

tests/testthat/test-geom-ribbon.R

@@ -46,18 +46,18 @@ 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")
 
  # 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))
 })