feat: mark_sf(merge = TRUE) dissolves adjacent same-fill regions

NEWS.md

@@ -1,5 +1,12 @@
 # vellumplot (development version)
 
+* **Merged choropleth regions.** `mark_sf(merge = TRUE)` dissolves adjacent
+  features that share a fill into one region, so the internal borders between
+  same-valued features disappear and each region is a single crisp path — no
+  double-stroked seams, and exact in PDF. The union is real boolean geometry
+  (`vellum::vl_path_op()`), holes and multipart features preserved. It is ignored
+  on an interactive layer, where per-feature keys must survive.
+
 * **Rotated and wrapping axis tick labels.** `axis.text.x` / `axis.text.y` now
   honour an `angle` — `theme(axis.text.x = element_text(angle = 45))` slants the
   labels and the gutter reserves the rotated height (an explicit `hjust`/`vjust`

R/compile-marks.R

@@ -3671,6 +3671,47 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
     list(x = unlist(px, use.names = FALSE), y = unlist(py, use.names = FALSE))
   }
 
+  # Dissolve a style group's polygon features into ONE region: union each
+  # feature's rings (interpreted even-odd, so holes and multipart features stay
+  # correct) with `vl_path_op`, so the shared borders between same-valued
+  # features vanish and the fill is a single crisp path (exact in PDF). Raw
+  # coordinates are unioned, then the result is mapped once -- the same map-once
+  # discipline as `gather_poly`. Returns a mapped `path_grob`, or NULL when there
+  # is nothing to merge (< 2 non-empty features) so the caller falls back to the
+  # ordinary batched emit.
+  merge_poly <- function(idx, gpp) {
+    operand <- function(i) {
+      fp <- gather_poly(i)
+      if (is.null(fp)) {
+        return(NULL)
+      }
+      list(x = fp$x, y = fp$y, nper = rle(fp$id)$lengths)
+    }
+    ops <- Filter(Negate(is.null), lapply(idx, operand))
+    if (length(ops) < 2L) {
+      return(NULL)
+    }
+    acc <- ops[[1L]]
+    for (j in seq_along(ops)[-1L]) {
+      acc <- vellum::vl_path_op(acc, ops[[j]], op = "union", rule = "evenodd")
+    }
+    rx <- as.numeric(vctrs::field(acc@x, "value"))
+    ry <- as.numeric(vctrs::field(acc@y, "value"))
+    if (!length(rx)) {
+      return(NULL)
+    }
+    nper <- acc@nper %||% length(rx)
+    xy <- .xy_units(scales, scales$x$map(rx), scales$y$map(ry))
+    vellum::path_grob(
+      xy$x,
+      xy$y,
+      id = rep(seq_along(nper), nper),
+      rule = "winding",
+      sketch = sk,
+      gp = gpp
+    )
+  }
+
   # Iterate style groups of the features that carry kind `k`, calling `draw`.
   by_style <- function(scene, k, colvec, draw) {
     sub <- which(has_kind(k))
@@ -3690,7 +3731,10 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
   # polygons: batched into one path_grob per style group (its features' rings are
   # `evenodd` sub-paths) -- unless the layer is interactive, when each feature is
   # its own grob so `.draw()` can key it (`rows = i`) with the feature's data_id /
-  # tooltip. See the EXCEPTION / CAVEAT notes on `.emit_sf`.
+  # tooltip. See the EXCEPTION / CAVEAT notes on `.emit_sf`. With `merge = TRUE`
+  # (and non-interactive) the group's features are instead dissolved into one
+  # unioned region so their shared borders disappear.
+  do_merge <- isTRUE(L$stat_params$merge) && !interactive
   scene <- by_style(
     scene,
     "poly",
@@ -3702,6 +3746,10 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
         lwd = lwd,
         alpha = gp_alpha(a)
       )
+      merged <- if (do_merge) merge_poly(idx, gpp) else NULL
+      if (!is.null(merged)) {
+        return(.draw(scene, merged, rows = NULL))
+      }
       emit <- function(scene, g, rows) {
         if (is.null(g)) {
           return(scene)
@@ -4207,8 +4255,18 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
 # radius (mm); the engine blurs the whole group once (cheaper, smoother, and it
 # works on text, unlike stroking N glyph copies). `widen` optionally fattens the
 # stroke/point first so the halo has body before the blur spreads it.
-.emit_soft <- function(scene, L, scales, blur, alpha, colour, blend = "normal",
-                       xoff = 0, yoff = 0, widen = 0) {
+.emit_soft <- function(
+  scene,
+  L,
+  scales,
+  blur,
+  alpha,
+  colour,
+  blend = "normal",
+  xoff = 0,
+  yoff = 0,
+  widen = 0
+) {
   is_point <- L$mark %in% c("point", "nodes")
   base <- .glow_base(L)
   rng <- .panel_scale_range(scales)
@@ -4252,7 +4310,9 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
   # opacity so brightness is comparable; `blend` (screen by default) keeps the
   # additive neon look over a dark backdrop.
   .emit_soft(
-    scene, L, scales,
+    scene,
+    L,
+    scales,
     blur = g@size * 0.6,
     alpha = min(1, g@alpha * g@layers),
     colour = g@color,
@@ -4271,7 +4331,9 @@ gp_alpha <- function(a) if (is.na(a)) NULL else a
   # A real drop shadow: one blurred, offset copy in the shadow colour, instead of
   # the old stack of widened copies.
   .emit_soft(
-    scene, L, scales,
+    scene,
+    L,
+    scales,
     blur = s@spread,
     alpha = min(1, s@alpha * s@layers),
     colour = s@color,

R/marks.R

@@ -547,6 +547,11 @@ mark_line <- function(
 #'   constant or a mapped expression.
 #' @param na_value Fill colour for features whose mapped `fill`/`color` value is
 #'   `NA` (drawn as a distinct legend swatch). Default `"grey80"`.
+#' @param merge Dissolve adjacent features that share a fill into one region, so
+#'   the internal borders between same-valued features disappear and each region
+#'   is a single crisp path (no seam artefacts, and exact in PDF). The union is
+#'   real boolean geometry via [vellum::vl_path_op()]. Default `FALSE`. Ignored
+#'   when the layer is interactive (merging would drop the per-feature keys).
 #' @param blend Optional blend mode (see [mark_point()]).
 #' @param data Optional layer data (an `sf` object); overrides the plot data.
 #' @return The modified [PlotSpec].
@@ -568,6 +573,7 @@ mark_sf <- function(
   linewidth = NULL,
   size = NULL,
   na_value = "grey80",
+  merge = FALSE,
   blend = NULL,
   sketch = NULL,
   data = NULL
@@ -585,7 +591,7 @@ mark_sf <- function(
       linewidth = linewidth,
       size = size
     ),
-    stat_params = list(na_value = na_value),
+    stat_params = list(na_value = na_value, merge = isTRUE(merge)),
     blend = blend,
     sketch = sketch,
     data = data

inst/examples/33-merged-regions.R

@@ -0,0 +1,38 @@
+# Merged choropleth regions: mark_sf(merge = TRUE) dissolves adjacent features
+# that share a fill into one crisp region (no internal seams, exact in PDF).
+
+library(vellumplot)
+if (!requireNamespace("sf", quietly = TRUE)) {
+  stop("this example needs the 'sf' package")
+}
+outdir <- "figures"
+dir.create(outdir, showWarnings = FALSE)
+
+nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
+# group the counties into four east-west regions, so adjacent counties share a
+# fill value
+nc$region <- cut(
+  sf::st_coordinates(sf::st_centroid(sf::st_geometry(nc)))[, 1],
+  4,
+  labels = c("west", "midwest", "mideast", "east")
+)
+
+# Plain: every county border is drawn, subdividing each colour block.
+render_plot(
+  vplot(nc) |>
+    mark_sf(fill = region) |>
+    coord_sf() |>
+    labs(title = "Counties (internal borders)"),
+  file.path(outdir, "33-plain.png")
+)
+
+# Merged: each region dissolves to one outline.
+render_plot(
+  vplot(nc) |>
+    mark_sf(fill = region, merge = TRUE, color = "white") |>
+    coord_sf() |>
+    labs(title = "Merged regions"),
+  file.path(outdir, "33-merged.png")
+)
+
+message("33-merged-regions: wrote plain + merged choropleths to ", outdir)

tests/testthat/test-sf-merge.R

@@ -0,0 +1,80 @@
+# mark_sf(merge = TRUE): dissolve adjacent same-fill features into one region.
+
+# Two unit squares sharing the edge x = 1, light grey fill and the default border.
+# Plain: the shared edge is stroked (drawn once per square). Merged: the two
+# squares union into one 2x1 rectangle, so that interior edge is gone.
+two_squares <- function() {
+  skip_if_not_installed("sf")
+  sq <- function(x0) {
+    sf::st_polygon(list(rbind(
+      c(x0, 0),
+      c(x0 + 1, 0),
+      c(x0 + 1, 1),
+      c(x0, 1),
+      c(x0, 0)
+    )))
+  }
+  sf::st_sf(id = c("a", "b"), geometry = sf::st_sfc(sq(0), sq(1)))
+}
+
+# Count the mid-grey border pixels (the polygon stroke) across the image. The
+# fills are either light grey (excluded, too pale) or saturated palette colours
+# (excluded, not grey), so this isolates the borders. A dissolved region strokes
+# only its outer perimeter, so it has fewer.
+border_px <- function(p) {
+  img <- render_px(p)
+  g <- img[,, 1]
+  sum(
+    g > 0.25 &
+      g < 0.55 &
+      abs(img[,, 1] - img[,, 2]) < 0.04 &
+      abs(img[,, 2] - img[,, 3]) < 0.04
+  )
+}
+
+sfmap <- function(d, m, ...) {
+  vplot(d, width = 4, height = 3) |>
+    mark_sf(merge = m, linewidth = 1, ...) |>
+    coord_sf() |>
+    theme_void()
+}
+
+test_that("merge dissolves the shared border between same-fill features", {
+  d <- two_squares()
+  plain <- border_px(sfmap(d, FALSE, fill = "grey90"))
+  merged <- border_px(sfmap(d, TRUE, fill = "grey90"))
+  expect_gt(plain, 0)
+  expect_lt(merged, 0.75 * plain) # the interior edge is gone
+})
+
+test_that("merge leaves features of different fill untouched", {
+  d <- two_squares()
+  # distinct fills => two style groups => nothing to union either way
+  kept <- border_px(sfmap(d, TRUE, fill = id))
+  same <- border_px(sfmap(d, FALSE, fill = id))
+  expect_equal(kept, same)
+})
+
+test_that("merge is a no-op on a single feature (nothing to union)", {
+  skip_if_not_installed("sf")
+  d <- two_squares()[1, ]
+  # one feature => merge_poly() returns NULL => identical batched emit
+  expect_identical(
+    vellum::scene_raster(sfmap(d, TRUE, fill = "grey90")),
+    vellum::scene_raster(sfmap(d, FALSE, fill = "grey90"))
+  )
+})
+
+test_that("a merged choropleth renders to PNG, PDF, and a scene", {
+  skip_if_not_installed("sf")
+  nc <- sf::st_read(
+    system.file("shape/nc.shp", package = "sf"),
+    quiet = TRUE
+  )
+  nc$region <- factor(nc$CNTY_ID %% 3L)
+  p <- vplot(nc) |> mark_sf(fill = region, merge = TRUE) |> coord_sf()
+  expect_no_error(vellum::as_vellum_scene(p))
+  f <- withr::local_tempfile(fileext = ".pdf")
+  expect_no_error(render_plot(p, f))
+  expect_identical(rawToChar(readBin(f, "raw", 5L)), "%PDF-")
+})

vignettes/articles/spatial-and-networks.qmd

@@ -49,6 +49,29 @@ Because `mark_sf()` is an ordinary layer, you can stack it: draw a base layer
 of boundaries, then a second `mark_sf()` for highlighted features or point
 locations on top, and every layer reprojects together.
 
+### Merging regions
+
+When several small features share a value — counties grouped into a region, or
+tracts into a district — the borders *between* them are usually noise: you want
+one clean outline per group, not a mesh of internal seams. `merge = TRUE`
+dissolves each same-fill group into a single region with real boolean geometry
+(`vellum::vl_path_op()`), so the shared edges vanish and each region is one crisp
+path that stays exact in PDF (no double-stroked seams, no hairline gaps).
+
+```{r}
+#| eval: !expr have_sf
+nc$region <- cut(sf::st_coordinates(sf::st_centroid(sf::st_geometry(nc)))[, 1],
+  4,
+  labels = c("west", "midwest", "mideast", "east")
+)
+vplot(nc) |>
+  mark_sf(fill = region, merge = TRUE, color = "white") |>
+  coord_sf()
+```
+
+Merging is for static choropleths; on an interactive layer it is ignored, since
+dissolving the features would drop the per-feature keys a tooltip needs.
+
 ### Cartographic furniture
 
 A map usually wants more than the polygons: a graticule to place it on the