Holed polygons (#3128)

Author: thomasp85

NEWS.md

@@ -54,6 +54,9 @@
 
 * `stat_bin()` now handles data with only one unique value (@yutannihilation #3047).
 
+* `geom_polygon()` can now draw polygons with holes using the new `subgroup` 
+  aesthetic. This functionality requires R 3.6 (@thomasp85, #3128)
+
 # ggplot2 3.1.0
 
 ## Breaking changes

R/geom-polygon.r

@@ -3,7 +3,10 @@
 #' Polygons are very similar to paths (as drawn by [geom_path()])
 #' except that the start and end points are connected and the inside is
 #' coloured by `fill`. The `group` aesthetic determines which cases
-#' are connected together into a polygon.
+#' are connected together into a polygon. From R 3.6 and onwards it is possible
+#' to draw polygons with holes by providing a subgroup aesthetic that
+#' differentiates the outer ring points from those describing holes in the
+#' polygon.
 #'
 #' @eval rd_aesthetics("geom", "polygon")
 #' @seealso
@@ -12,6 +15,10 @@
 #' @export
 #' @inheritParams layer
 #' @inheritParams geom_point
+#' @param rule Either `"evenodd"` or `"winding"`. If polygons with holes are
+#' being drawn (using the `subgroup` aesthetic) this argument defines how the
+#' hole coordinates are interpreted. See the examples in [grid::pathGrob()] for
+#' an explanation.
 #' @examples
 #' # When using geom_polygon, you will typically need two data frames:
 #' # one contains the coordinates of each polygon (positions),  and the
@@ -52,8 +59,28 @@
 #'
 #' # And if the positions are in longitude and latitude, you can use
 #' # coord_map to produce different map projections.
+#'
+#' if (packageVersion("grid") >= "3.6") {
+#'   # As of R version 3.6 geom_polygon() supports polygons with holes
+#'   # Use the subgroup aesthetic to differentiate holes from the main polygon
+#'
+#'   holes <- do.call(rbind, lapply(split(datapoly, datapoly$id), function(df) {
+#'     df$x <- df$x + 0.5 * (mean(df$x) - df$x)
+#'     df$y <- df$y + 0.5 * (mean(df$y) - df$y)
+#'     df
+#'   }))
+#'   datapoly$subid <- 1L
+#'   holes$subid <- 2L
+#'   datapoly <- rbind(datapoly, holes)
+#'
+#'   p <- ggplot(datapoly, aes(x = x, y = y)) +
+#'     geom_polygon(aes(fill = value, group = id, subgroup = subid))
+#'   p
+#' }
+#'
 geom_polygon <- function(mapping = NULL, data = NULL,
                          stat = "identity", position = "identity",
+                         rule = "evenodd",
                          ...,
                          na.rm = FALSE,
                          show.legend = NA,
@@ -68,6 +95,7 @@ geom_polygon <- function(mapping = NULL, data = NULL,
     inherit.aes = inherit.aes,
     params = list(
       na.rm = na.rm,
+      rule = rule,
       ...
     )
   )
@@ -78,35 +106,69 @@ geom_polygon <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomPolygon <- ggproto("GeomPolygon", Geom,
-  draw_panel = function(data, panel_params, coord) {
+  draw_panel = function(data, panel_params, coord, rule = "evenodd") {
     n <- nrow(data)
     if (n == 1) return(zeroGrob())
 
     munched <- coord_munch(coord, data, panel_params)
-    # Sort by group to make sure that colors, fill, etc. come in same order
-    munched <- munched[order(munched$group), ]
 
-    # For gpar(), there is one entry per polygon (not one entry per point).
-    # We'll pull the first value from each group, and assume all these values
-    # are the same within each group.
-    first_idx <- !duplicated(munched$group)
-    first_rows <- munched[first_idx, ]
+    if (is.null(munched$subgroup)) {
+      # Sort by group to make sure that colors, fill, etc. come in same order
+      munched <- munched[order(munched$group), ]
+
+      # For gpar(), there is one entry per polygon (not one entry per point).
+      # We'll pull the first value from each group, and assume all these values
+      # are the same within each group.
+      first_idx <- !duplicated(munched$group)
+      first_rows <- munched[first_idx, ]
 
-    ggname("geom_polygon",
-      polygonGrob(munched$x, munched$y, default.units = "native",
-        id = munched$group,
-        gp = gpar(
-          col = first_rows$colour,
-          fill = alpha(first_rows$fill, first_rows$alpha),
-          lwd = first_rows$size * .pt,
-          lty = first_rows$linetype
+      ggname(
+        "geom_polygon",
+        polygonGrob(
+          munched$x, munched$y, default.units = "native",
+          id = munched$group,
+          gp = gpar(
+            col = first_rows$colour,
+            fill = alpha(first_rows$fill, first_rows$alpha),
+            lwd = first_rows$size * .pt,
+            lty = first_rows$linetype
+          )
         )
       )
-    )
+    } else {
+      if (utils::packageVersion('grid') < "3.6") {
+        stop("Polygons with holes requires R 3.6 or above", call. = FALSE)
+      }
+      # Sort by group to make sure that colors, fill, etc. come in same order
+      munched <- munched[order(munched$group, munched$subgroup), ]
+      id <- match(munched$subgroup, unique(munched$subgroup))
+
+      # For gpar(), there is one entry per polygon (not one entry per point).
+      # We'll pull the first value from each group, and assume all these values
+      # are the same within each group.
+      first_idx <- !duplicated(munched$group)
+      first_rows <- munched[first_idx, ]
+
+      ggname(
+        "geom_polygon",
+        pathGrob(
+          munched$x, munched$y, default.units = "native",
+          id = id, pathId = munched$group,
+          rule = rule,
+          gp = gpar(
+            col = first_rows$colour,
+            fill = alpha(first_rows$fill, first_rows$alpha),
+            lwd = first_rows$size * .pt,
+            lty = first_rows$linetype
+          )
+        )
+      )
+    }
+
   },
 
   default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1,
-    alpha = NA),
+    alpha = NA, subgroup = NULL),
 
   handle_na = function(data, params) {
     data