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

* Process upper and lower lines separately

* Update test expectations

Author: yutannihilation

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))
 })