Skip to content

Instantly share code, notes, and snippets.

@dholstius
Last active August 29, 2015 14:17
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save dholstius/37c0ff01109e28ff817a to your computer and use it in GitHub Desktop.
Merging polygons without dissolving adjacent boundaries
# See http://stackoverflow.com/questions/29310962/variant-of-rgeosgunion-that-wont-dissolve-adjacent-polygons
# for the relevant problem formulation.
library(sp)
unit_rect <- cbind(
x = c(0, 0, 1, 1, 0),
y = c(0, 1, 1, 0, 0))
translate <- function (spobj, delta = c(0, 0)) {
Polygon(t(t(coordinates(spobj)) + delta))
}
ring1 <- Polygon(coords = unit_rect)
hole1 <- Polygon(coords = t(0.25 + 0.5 * t(unit_rect)), hole = TRUE)
poly1 <- Polygons(list("ring" = ring1, "hole" = hole1), ID = "poly1")
ring2 <- translate(ring1, delta = c(1, 0))
hole2 <- translate(hole1, delta = c(1, 0))
poly2 <- Polygons(list("ring" = ring2, "hole" = hole2), ID = "poly2")
ring3 <- translate(ring1, delta = c(0, 1))
hole3 <- translate(hole1, delta = c(0, 1))
poly3 <- Polygons(list("ring" = ring3, "hole" = hole3), ID = "poly3")
spobj_A <- SpatialPolygons(list(poly1, poly2))
spobj_B <- SpatialPolygons(list(poly3))
# Have a peek.
plot(spobj_A)
plot(spobj_B, add = TRUE)
# Not the desired outcome! Shared boundaries are dissolved.
unioned <- rgeos::gUnion(spobj_A, spobj_B)
plot(unioned)
# First case: merging two Polygons objects.
setMethod(
merge,
signature = c("Polygons", "Polygons"),
definition = function (x, y, ID, ...) {
# TODO: better automatic ID renaming.
if (missing(ID)) ID <- paste(x@ID, y@ID, ".")
Polygons(append(x@Polygons, y@Polygons), ID)
})
test1 <- SpatialPolygons(list(merge(poly1, poly2, ID = "A")))
plot(test1)
# Second case: merging two SpatialPolygons objects.
setMethod(
merge,
signature = c("SpatialPolygons", "SpatialPolygons"),
definition = function (x, y, IDs, ...) {
SpatialPolygons(append(
Reduce(merge, x@polygons),
Reduce(merge, y@polygons)))
})
test2 <- merge(
spChFIDs(spobj_A, c("A.1", "A.2")), # TODO: better automatic ID renaming.
spChFIDs(spobj_B, "B.1"))
plot(test2)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment