coord_munch can convert closed shapes to closed form (#5081)

* `coord_munch()` can close polygons

* Polygon-like Geoms use the `make_closed` argument

* Speed up rectangles to polygons

* Accept invisible visual changes

* Add NEWS bullet

* Document `make_closed` argument

* Fix order issue

* make_closed -> is_closed

* improve `close_poly()`

* Remove closing point after munching

* Accept snapshots

* Add munching test

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `coord_munch()` can now close polygon shapes (@teunbrand, #3271)
+
 * You can now omit either `xend` or `yend` from `geom_segment()` as only one
   of these is now required. If one is missing, it will be filled from the `x`
   and `y` aesthetics respectively. This makes drawing horizontal or vertical

R/annotation-map.R

@@ -89,7 +89,7 @@ GeomAnnotationMap <- ggproto("GeomAnnotationMap", GeomMap,
   draw_panel = function(data, panel_params, coord, map) {
     # Munch, then set up id variable for polygonGrob -
     # must be sequential integers
-    coords <- coord_munch(coord, map, panel_params)
+    coords <- coord_munch(coord, map, panel_params, is_closed = TRUE)
     coords$group <- coords$group %||% coords$id
     grob_id <- match(coords$group, unique0(coords$group))
 

R/coord-munch.R

@@ -9,11 +9,16 @@
 #'   All other variables are duplicated as needed.
 #' @param range Panel range specification.
 #' @param segment_length Target segment length
+#' @param is_closed Whether data should be considered as a closed polygon.
 #' @keywords internal
 #' @export
-coord_munch <- function(coord, data, range, segment_length = 0.01) {
+coord_munch <- function(coord, data, range, segment_length = 0.01, is_closed = FALSE) {
   if (coord$is_linear()) return(coord$transform(data, range))
 
+  if (is_closed) {
+    data <- close_poly(data)
+  }
+
   # range has theta and r values; get corresponding x and y values
   ranges <- coord$backtransform_range(range)
 
@@ -34,6 +39,11 @@ coord_munch <- function(coord, data, range, segment_length = 0.01) {
 
   # Munch and then transform result
   munched <- munch_data(data, dist, segment_length)
+  if (is_closed) {
+    group_cols <- intersect(c("group", "subgroup"), names(munched))
+    runs <- vec_run_sizes(munched[, group_cols, drop = FALSE])
+    munched <- vec_slice(munched, -(cumsum(runs)))
+  }
   coord$transform(munched, range)
 }
 
@@ -204,3 +214,25 @@ spiral_arc_length <- function(a, theta1, theta2) {
     (theta1 * sqrt(1 + theta1 * theta1) + asinh(theta1)) -
     (theta2 * sqrt(1 + theta2 * theta2) + asinh(theta2)))
 }
+
+# Closes a polygon type data structure by repeating the first-in-group after
+# the last-in-group
+close_poly <- function(data) {
+  # Sort by group
+  groups <- data[, intersect(c("group", "subgroup"), names(data)), drop = FALSE]
+  ord <- vec_order(groups)
+
+  # Run length encoding stats
+  runs <- vec_run_sizes(vec_slice(groups, ord))
+  ends <- cumsum(runs)
+  starts <- ends - runs + 1
+
+  # Repeat 1st row of group after every group
+  index <- seq_len(nrow(data))
+  insert <- ends + seq_along(ends)
+  new_index <- integer(length(index) + length(runs))
+  new_index[-insert] <- index
+  new_index[insert] <- starts
+
+  vec_slice(data, ord[new_index])
+}

R/geom-map.R

@@ -135,7 +135,7 @@ GeomMap <- ggproto("GeomMap", GeomPolygon,
 
     # Munch, then set up id variable for polygonGrob -
     # must be sequential integers
-    coords <- coord_munch(coord, map, panel_params)
+    coords <- coord_munch(coord, map, panel_params, is_closed = TRUE)
     coords$group <- coords$group %||% coords$id
     grob_id <- match(coords$group, unique0(coords$group))
 

R/geom-polygon.R

@@ -113,7 +113,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
     n <- nrow(data)
     if (n == 1) return(zeroGrob())
 
-    munched <- coord_munch(coord, data, panel_params)
+    munched <- coord_munch(coord, data, panel_params, is_closed = TRUE)
 
     if (is.null(munched$subgroup)) {
       # Sort by group to make sure that colors, fill, etc. come in same order

R/geom-rect.R

@@ -39,15 +39,16 @@ GeomRect <- ggproto("GeomRect", Geom,
       aesthetics <- setdiff(
         names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax")
       )
+      index <- rep(seq_len(nrow(data)), each = 4)
 
-      polys <- lapply(split(data, seq_len(nrow(data))), function(row) {
-        poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)
-        aes <- row[rep(1,5), aesthetics]
+      new <- data[index, aesthetics, drop = FALSE]
+      new$x <- vec_interleave(data$xmin, data$xmax, data$xmax, data$xmin)
+      new$y <- vec_interleave(data$ymax, data$ymax, data$ymin, data$ymin)
+      new$group <- index
 
-        GeomPolygon$draw_panel(vec_cbind(poly, aes), panel_params, coord, lineend = lineend, linejoin = linejoin)
-      })
-
-      ggname("geom_rect", inject(grobTree(!!!polys)))
+      ggname("geom_rect", GeomPolygon$draw_panel(
+        new, panel_params, coord, lineend = lineend, linejoin = linejoin
+      ))
     } else {
       coords <- coord$transform(data, panel_params)
       ggname("geom_rect", rectGrob(
@@ -72,18 +73,3 @@ GeomRect <- ggproto("GeomRect", Geom,
 
   rename_size = TRUE
 )
-
-
-# Convert rectangle to polygon
-# Useful for non-Cartesian coordinate systems where it's easy to work purely in
-# terms of locations, rather than locations and dimensions. Note that, though
-# `polygonGrob()` expects an open form, closed form is needed for correct
-# munching (c.f. https://github.com/tidyverse/ggplot2/issues/3037#issuecomment-458406857).
-#
-# @keyword internal
-rect_to_poly <- function(xmin, xmax, ymin, ymax) {
-  data_frame0(
-    y = c(ymax, ymax, ymin, ymin, ymax),
-    x = c(xmin, xmax, xmax, xmin, xmin)
-  )
-}