Created
June 3, 2023 01:11
-
-
Save ryanscharf/6c834c9640e893c387cbe0551a661d21 to your computer and use it in GitHub Desktop.
union contiguous geometries example
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
library(tigris) | |
library(tidyverse) | |
library(sf) | |
# get the states | |
test_states <- tigris::states() %>% | |
filter( | |
STUSPS %in% c( | |
'FL', | |
'GA', | |
'SC', | |
'NC', | |
'IL', | |
'IA', | |
'NB', | |
'MO', | |
'NV', | |
'UT', | |
'AZ', | |
'WA', | |
'NH', | |
'CT', | |
'NJ' | |
) | |
) | |
# example states. i'm looking to union the contiguous | |
# polygons. but nicely.... | |
plot(test_states$geometry) | |
touchy <- st_touches(test_states) | |
solo_geoms <- test_states[which(lengths(touchy) == 0),] | |
touchys_deliverance <- solo_geoms | |
touchy_char <- touchy %>% map(paste) | |
tdf <- list() | |
#get indicies of polygons that touch | |
d_vals <- flatten(touchy_char) %>% unlist() %>% unique() | |
# going on a character hunt through some stupid loops | |
# will be building lists of cooccurring indicies | |
for(i in seq_along(d_vals)){ | |
finders <- grep(paste0('\\b',d_vals[i],'\\b'), touchy_char) | |
fids <- unlist(touchy_char[finders]) %>% | |
unique() %>% | |
sort() | |
tdf[[i]] <- fids | |
} | |
tdf <- unique(tdf) | |
ttdf <- list() | |
# some of the index combos don't include themselves | |
# we can ignore strings that are found in other | |
# strings in the list and just extract the longer ones | |
for(i in 1:length(tdf)){ | |
x <- grep( | |
paste0(unlist(tdf[i]), collapse = ''), | |
map(tdf, paste0, collapse = '')) | |
if(length(x) > 1){ | |
next | |
} else { | |
ttdf <- rbind(ttdf, tdf[i]) | |
} | |
} | |
# create a function that eats the list of the touching | |
# geometry indicies and union them. | |
dowork <- function(x,y){ | |
x <- as.numeric(x) | |
y %>% slice(x) %>% | |
st_union() | |
} | |
ffff <- map(ttdf, ~dowork(.x, y = test_states)) | |
#cleanup work | |
ffff <- do.call(rbind, ffff) %>% as_tibble() | |
names(ffff) <- 'geometry' | |
ffff <- ffff %>% st_sf() | |
st_crs(ffff) <- st_crs(test_states) | |
touchys_deliverance <- ffff %>% bind_rows(touchys_deliverance) | |
#oh god this was painful | |
plot(touchys_deliverance$geometry) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment