################################################################################ ### This script takes state/county shapefiles from the Census Bureau, and moves ### Alaska, Hawaii, Puerto Rico, US Virgin Islands, Guam, Samoa, and the Mariana ### Islands to be just under the continental US. This format is very useful for ### mapping data. ### ### I originally used the "state_laea" and "county_laea" maps from the ### "tidycensus" package, but kept hitting various issues: ### ### 1) The Tidycensus maps are low-resolution, so counties don't look good if ### you zoom in on a particular state ### ### 2) The "Tidycensus" maps are old and require various FIPS mods every time I ### use them, such as changing fips 46113 -> 46102 to handle Oglala Co SD, ### changing fips 02270 -> 02158 to handle Kusilvak Census Area, AK ### ### 3) The Tidycensus map lacked the smaller US territories. ### ### I took inspiration for this script from the URL below: ### ### https://rud.is/b/2014/11/16/moving-the-earth-well-alaska-hawaii-with-r/ ### ### If you find any bugs or issues with the script or with the maps it generates ### please let me know - /u/MetricT ### ### KNOWN BUGS: ### ### * Sourcing the script will cause errors at these lines near the bottom: ### ### > state_map %>% st_as_sf() %>% write_sf(mod_state_map) ### There were 50 or more warnings (use warnings() to see the first 50) ### > county_map %>% st_as_sf() %>% write_sf(mod_county_map) ### There were 50 or more warnings (use warnings() to see the first 50) ### ### Just run them manually at that point and it should work fine. ################################################################################ library(tidyverse) library(maptools) library(mapproj) library(rgeos) library(rgdal) library(RColorBrewer) library(ggplot2) library(sf) ### Path/filename to save modified shapefiles at when we're done mod_state_map <- "../Shapefiles/us_state/us_state.shp" mod_county_map <- "../Shapefiles/us_county/us_county.shp" ### We want our map to use the Albers projection map_crs <- "+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs" #map_crs <- "epsg:5070" state_map <- read_sf("../Shapefiles/cb_2018_us_state_500k/cb_2018_us_state_500k.shp") %>% st_transform(map_crs) %>% as(Class = "Spatial") county_map <- read_sf("../Shapefiles/cb_2018_us_county_500k/cb_2018_us_county_500k.shp") %>% st_transform(map_crs) %>% as(Class = "Spatial") state_map@data$id <- rownames(state_map@data) county_map@data$id <- rownames(county_map@data) ### We want to strip out states/territories that aren't in the continental US ### and move them around to make a more convenient map non_conus_fips <- c("02", "11", "15", "60", "66", "69", "72", "78") ################################################################################ ### Adjust the state-level map ################################################################################ ### Alaska alaska_state <- state_map[state_map$STATEFP=="02",] alaska_state <- elide(alaska_state, rotate=-50) alaska_state <- elide(alaska_state, scale=max(apply(bbox(alaska_state), 1, diff)) / 1.8) alaska_state <- elide(alaska_state, shift=c(-2400000, -2800000)) proj4string(alaska_state) <- proj4string(state_map) ### Hawaii hawaii_state <- state_map[state_map$STATEFP=="15",] hawaii_state <- elide(hawaii_state, rotate=-35) hawaii_state <- elide(hawaii_state, shift=c(5800000, -1900000)) proj4string(hawaii_state) <- proj4string(state_map) ### Puerto Rico puertorico_state <- state_map[state_map$STATEFP=="72",] puertorico_state <- elide(puertorico_state, rotate=+13) puertorico_state <- elide(puertorico_state, scale=max(apply(bbox(puertorico_state), 1, diff)) / 0.5) puertorico_state <- elide(puertorico_state, shift=c(+600000, -2600000)) proj4string(puertorico_state) <- proj4string(state_map) ### US Virgin Islands usvi_state <- state_map[state_map$STATEFP=="78",] usvi_state <- elide(usvi_state, rotate=+13) usvi_state <- elide(usvi_state, scale=max(apply(bbox(usvi_state), 1, diff)) / 0.25) usvi_state <- elide(usvi_state, shift=c(+1500000, -2600000)) proj4string(usvi_state) <- proj4string(state_map) ### Guam guam_state <- state_map[state_map$STATEFP=="66",] guam_state <- elide(guam_state, rotate=-65) guam_state <- elide(guam_state, scale=max(apply(bbox(guam_state), 1, diff)) / 0.15) guam_state <- elide(guam_state, shift=c(+1200000, -3200000)) proj4string(guam_state) <- proj4string(state_map) ### Northern Mariana Islands noma_state <- state_map[state_map$STATEFP=="69",] noma_state <- elide(noma_state, rotate=-55) noma_state <- elide(noma_state, scale=max(apply(bbox(noma_state), 1, diff)) / 0.85) noma_state <- elide(noma_state, shift=c(+300000, -3400000)) proj4string(noma_state) <- proj4string(state_map) ### American Samoa amsam_state <- state_map[state_map$STATEFP=="60",] amsam_state <- elide(amsam_state, rotate=-55) amsam_state <- elide(amsam_state, scale=max(apply(bbox(amsam_state), 1, diff)) / 0.25) amsam_state <- elide(amsam_state, shift=c(-2300000, -3400000)) proj4string(amsam_state) <- proj4string(state_map) ### Add the moved states/territories back to the CONUS map state_map <- state_map[!state_map$STATEFP %in% non_conus_fips,] state_map <- rbind(state_map, alaska_state, hawaii_state, puertorico_state, usvi_state, noma_state, guam_state, amsam_state ) ################################################################################ ### Adjust the county-level map ################################################################################ ### Alaska alaska_county <- county_map[county_map$STATEFP=="02",] alaska_county <- elide(alaska_county, rotate=-50) alaska_county <- elide(alaska_county, scale=max(apply(bbox(alaska_county), 1, diff)) / 1.8) alaska_county <- elide(alaska_county, shift=c(-2400000, -2800000)) proj4string(alaska_county) <- proj4string(county_map) ### Hawaii hawaii_county <- county_map[county_map$STATEFP=="15",] hawaii_county <- elide(hawaii_county, rotate=-35) hawaii_county <- elide(hawaii_county, shift=c(5800000, -1900000)) proj4string(hawaii_county) <- proj4string(county_map) ### Puerto Rico puertorico_county <- county_map[county_map$STATEFP=="72",] puertorico_county <- elide(puertorico_county, rotate=+13) puertorico_county <- elide(puertorico_county, scale=max(apply(bbox(puertorico_county), 1, diff)) / 0.5) puertorico_county <- elide(puertorico_county, shift=c(+600000, -2600000)) proj4string(puertorico_county) <- proj4string(county_map) ### US Virgin Islands usvi_county <- county_map[county_map$STATEFP=="78",] usvi_county <- elide(usvi_county, rotate=+13) usvi_county <- elide(usvi_county, scale=max(apply(bbox(usvi_county), 1, diff)) / 0.25) usvi_county <- elide(usvi_county, shift=c(+1500000, -2600000)) proj4string(usvi_county) <- proj4string(county_map) ### Guam guam_county <- county_map[county_map$STATEFP=="66",] guam_county <- elide(guam_county, rotate=-65) guam_county <- elide(guam_county, scale=max(apply(bbox(guam_county), 1, diff)) / 0.15) guam_county <- elide(guam_county, shift=c(+1200000, -3200000)) proj4string(guam_county) <- proj4string(county_map) ### Northern Mariana Islands noma_county <- county_map[county_map$STATEFP=="69",] noma_county <- elide(noma_county, rotate=-55) noma_county <- elide(noma_county, scale=max(apply(bbox(noma_county), 1, diff)) / 0.85) noma_county <- elide(noma_county, shift=c(+300000, -3400000)) proj4string(noma_county) <- proj4string(county_map) ### American Samoa amsam_county <- county_map[county_map$STATEFP=="60",] amsam_county <- elide(amsam_county, rotate=-55) amsam_county <- elide(amsam_county, scale=max(apply(bbox(amsam_county), 1, diff)) / 0.25) amsam_county <- elide(amsam_county, shift=c(-2300000, -3400000)) proj4string(amsam_county) <- proj4string(county_map) ### Add the moved states/territories back to the CONUS map county_map <- county_map[!county_map$STATEFP %in% non_conus_fips,] county_map <- rbind(county_map, alaska_county, hawaii_county, puertorico_county, usvi_county, noma_county, guam_county, amsam_county ) ################################################################################ ### Save maps, reload, and graph to make sure it worked ok ############################################################################### ### Save modified maps to new shapefile state_map %>% st_as_sf() %>% write_sf(mod_state_map) county_map %>% st_as_sf() %>% write_sf(mod_county_map) ### Load our newly created maps state_map <- read_sf(mod_state_map) county_map <- read_sf(mod_county_map) ### Overlay the state/county maps so we can verify that the map looks correct ggplot() + theme_void() + geom_sf(data = county_map, size = 0.1) + geom_sf(data = state_map, size = 0.6, fill = NA)