data-raw/build_maps.R

In jaytimm/uspoliticalextras:

library(tidyverse)


#DailyKos equal-area shapefiles
base <- 'https://drive.google.com/uc?authuser=0&id='

#Tile map
dailyvos_tile_outer <- paste0(base, '0B2X3Bx1aCHsJdGF4ZWRTQmVyV2s&export=download/TileOutv10.zip')
dailyvos_tile_inner <- paste0(base, '0B2X3Bx1aCHsJR1c0SzNyWlAtZjA&export=download/TileInv10.zip')
#Hex map
dailyvos_hex_cd <- paste0(base, '1E_P0r1Uv438fZsvKsvidIR02Nb5Ju9zf&export=download/HexCDv12.zip')
dailyvos_hex_st <- paste0(base, '0B2X3Bx1aCHsJVWxYZGtxMGhrMEE&export=download/HexSTv11.zip')



#Simple function for online shapefile download/unzip/to sf
get_url_shape <- function (url) {
  temp <- tempdir()
  zip_name <- paste0(temp, '\\', basename(url))
  download.file(url, zip_name,
                quiet = TRUE)
  unzip(zip_name, exdir = temp)
  x <- sf::st_read(dsn = gsub('\\.zip', '', zip_name),
                   layer = gsub('\\.zip','', basename(url)),
                   quiet = TRUE)
  unlink(temp)
  x}


uspol_dkos_equalarea_sf <- lapply (c(dailyvos_tile_inner,
                                     dailyvos_tile_outer,
                                     dailyvos_hex_cd,
                                     dailyvos_hex_st),
                                   get_url_shape)

names(uspol_dkos_equalarea_sf) <- c('tile_inner', 'tile_outer', 'hex_cds', 'hex_states')


#State hex shapefile is slightly broken.
uspol_dkos_equalarea_sf$hex_states <- lwgeom::st_make_valid(uspol_dkos_equalarea_sf$hex_states)


uspol_dkos_equalarea_sf$tile_inner <- uspol_dkos_equalarea_sf$tile_inner %>%
  select(State:StateName) %>%
  rename(state_abbrev = State,
         GEOID = FIPS,
         state = StateName)

uspol_dkos_equalarea_sf$tile_outer <- uspol_dkos_equalarea_sf$tile_outer %>%
  select(State:StateName) %>%
  rename(state_abbrev = State,
         GEOID = FIPS,
         state = StateName)

uspol_dkos_equalarea_sf$hex_cds <- uspol_dkos_equalarea_sf$hex_cds %>%
  select(GEOID:CDLABEL) %>%
  rename(state_abbrev = STATEAB,
         state = STATENAME,
         district_code = CDLABEL) %>%
  mutate(district_code = gsub('[A-Z][A-Z]', 0, district_code)) %>%
  mutate(district_code = as.integer(district_code))

uspol_dkos_equalarea_sf$hex_states <- uspol_dkos_equalarea_sf$hex_states %>%
  select(STATE) %>%
  rename(state = STATE)

setwd("/home/jtimm/jt_work/GitHub/packages/uspoliticalextras/data")
#Output
usethis::use_data(uspol_dkos_equalarea_sf, overwrite=TRUE)