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

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