diff --git a/NEWS.md b/NEWS.md
index dc43b0f7e0..9e8d26f28b 100644
--- a/NEWS.md
+++ b/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
diff --git a/R/annotation-map.R b/R/annotation-map.R
index 5f11edb69e..d92195170c 100644
--- a/R/annotation-map.R
+++ b/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))
diff --git a/R/coord-munch.R b/R/coord-munch.R
index 5ba5951da0..6f2bbb2afb 100644
--- a/R/coord-munch.R
+++ b/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])
+}
diff --git a/R/geom-map.R b/R/geom-map.R
index a1085fd75d..987ee864b4 100644
--- a/R/geom-map.R
+++ b/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))
diff --git a/R/geom-polygon.R b/R/geom-polygon.R
index 0558a64efe..cfeefa1d12 100644
--- a/R/geom-polygon.R
+++ b/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
diff --git a/R/geom-rect.R b/R/geom-rect.R
index 00eee5fb48..1d4108345d 100644
--- a/R/geom-rect.R
+++ b/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)
- )
-}
diff --git a/man/coord_munch.Rd b/man/coord_munch.Rd
index c09cd1658d..9be68514d3 100644
--- a/man/coord_munch.Rd
+++ b/man/coord_munch.Rd
@@ -4,7 +4,7 @@
\alias{coord_munch}
\title{Munch coordinates data}
\usage{
-coord_munch(coord, data, range, segment_length = 0.01)
+coord_munch(coord, data, range, segment_length = 0.01, is_closed = FALSE)
}
\arguments{
\item{coord}{Coordinate system definition.}
@@ -16,6 +16,8 @@ All other variables are duplicated as needed.}
\item{range}{Panel range specification.}
\item{segment_length}{Target segment length}
+
+\item{is_closed}{Whether data should be considered as a closed polygon.}
}
\description{
This function "munches" lines, dividing each line into many small pieces
diff --git a/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-has-center-hole.svg b/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-has-center-hole.svg
index d5a1760e83..8bf3cc6ec2 100644
--- a/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-has-center-hole.svg
+++ b/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-has-center-hole.svg
@@ -44,9 +44,9 @@
-
-
-
+
+
+
1
2
0/3
diff --git a/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-no-center-hole.svg b/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-no-center-hole.svg
index 56a632f253..d145a1e446 100644
--- a/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-no-center-hole.svg
+++ b/tests/testthat/_snaps/coord-polar/racetrack-plot-closed-and-no-center-hole.svg
@@ -44,9 +44,9 @@
-
-
-
+
+
+
1
2
0/3
diff --git a/tests/testthat/_snaps/coord-polar/rose-plot-with-has-equal-spacing.svg b/tests/testthat/_snaps/coord-polar/rose-plot-with-has-equal-spacing.svg
index c9b4539265..b9d09b1835 100644
--- a/tests/testthat/_snaps/coord-polar/rose-plot-with-has-equal-spacing.svg
+++ b/tests/testthat/_snaps/coord-polar/rose-plot-with-has-equal-spacing.svg
@@ -44,9 +44,9 @@
-
-
-
+
+
+
A
B
C
diff --git a/tests/testthat/_snaps/geom-hline-vline-abline/polar-lines-intersect-mid-bars.svg b/tests/testthat/_snaps/geom-hline-vline-abline/polar-lines-intersect-mid-bars.svg
index 66a7e87a17..c6f3b60763 100644
--- a/tests/testthat/_snaps/geom-hline-vline-abline/polar-lines-intersect-mid-bars.svg
+++ b/tests/testthat/_snaps/geom-hline-vline-abline/polar-lines-intersect-mid-bars.svg
@@ -36,11 +36,11 @@
-
-
-
-
-
+
+
+
+
+
diff --git a/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg
new file mode 100644
index 0000000000..74816059df
--- /dev/null
+++ b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg
@@ -0,0 +1,43 @@
+
+
diff --git a/tests/testthat/test-geom-polygon.R b/tests/testthat/test-geom-polygon.R
index 334e62043f..3cf3636655 100644
--- a/tests/testthat/test-geom-polygon.R
+++ b/tests/testthat/test-geom-polygon.R
@@ -24,3 +24,33 @@ test_that("geom_polygon draws correctly", {
expect_doppelganger("basic polygon plot", p)
})
+
+test_that("geom_polygon is closed before munching", {
+
+ df <- data_frame0(
+ x = c(1, 1, 4, 4, 2, 2, 3, 3),
+ y = c(1, 4, 4, 1, 2, 3, 3, 2),
+ sub = c(1, 1, 1, 1, 2, 2, 2, 2)
+ )
+
+ p <- ggplot(df, aes(x, y, subgroup = sub)) +
+ geom_polygon() +
+ xlim(c(0.5, 4.5)) +
+ ylim(c(0, 5)) +
+ coord_polar()
+
+ built <- ggplot_build(p)
+ coord <- built$plot$coordinates
+ data <- built$data[[1]]
+ param <- built$layout$panel_params[[1]]
+
+ closed <- coord_munch(coord, data, param, is_closed = TRUE)
+ open <- coord_munch(coord, data, param, is_closed = FALSE)
+
+ p <- ggplot(mapping = aes(x = x, y = y, group = subgroup)) +
+ geom_polygon(aes(colour = "closed"), data = closed, fill = NA) +
+ geom_polygon(aes(colour = "open"), data = open, fill = NA) +
+ theme_void()
+
+ expect_doppelganger("open and closed munched polygons", p)
+})