Last active
July 15, 2018 01:34
-
-
Save thomasp85/cd60f9f99abc0dc1336d1a2fce1c1f05 to your computer and use it in GitHub Desktop.
An algorithm for closing erroneous polygons in sf
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| st_close <- function(x) { | |
| UseMethod('st_close') | |
| } | |
| st_close.sfg <- function(x) x | |
| st_close.POLYGON <- function(x) { | |
| if (st_is_empty(x)) return(x) | |
| x[] <- lapply(x[], close_mat) | |
| x[vapply(x[], nrow, integer(1)) > 3] | |
| } | |
| st_close.MULTIPOLYGON <- function(x) { | |
| if (st_is_empty(x)) return(x) | |
| x[] <- lapply(x[], function(p) { | |
| p[] <- lapply(p[], close_mat) | |
| p[vapply(p[], nrow, integer(1)) > 3] | |
| }) | |
| st_multipolygon(x[lengths(x) != 0]) | |
| } | |
| st_close.sfc <- function(x) { | |
| x[] <- lapply(x[], st_close) | |
| x | |
| } | |
| st_close.sf <- function(x) { | |
| st_geometry(x) <- st_close(st_geometry(x)) | |
| x | |
| } | |
| close_mat <- function(x) { | |
| if (any(x[1,] != x[nrow(x), ])) { | |
| x <- x[c(seq_len(nrow(x)), 1), ] | |
| } | |
| x | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment