union contiguous geometries example

pain.R

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)