# Modified to use `sf` from this article:
# https://rud.is/b/2014/11/16/moving-the-earth-well-alaska-hawaii-with-r/
library(sf)
#> Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
library(tigris)
#> To enable caching of data, set `options(tigris_use_cache = TRUE)`
#> in your R script or .Rprofile.
library(rmapshaper)
library(ggplot2)
albers_crs <- st_crs("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs")
# albers_crs <- st_crs("EPSG:5070")
# https://www.census.gov/geo/maps-data/data/cbf/cbf_counties.html
us <- tigris::counties(cb = TRUE) |>
# Remove unneeded detail
rmapshaper::ms_simplify(keep = 0.05) |>
# Remove Territoriess
subset(!(STATEFP %in% c("60", "66", "69", "72", "78", "74"))) |>
# convert it to Albers equal area
st_transform(albers_crs)
#> Retrieving data for the year 2022
#> | | | 0% | | | 1% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 16% | |============= | 18% | |============== | 20% | |=============== | 21% | |================ | 22% | |================ | 23% | |================= | 24% | |================= | 25% | |================== | 25% | |================== | 26% | |=================== | 27% | |==================== | 29% | |===================== | 29% | |====================== | 31% | |======================= | 32% | |======================== | 34% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |=========================== | 39% | |============================ | 40% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================== | 48% | |================================== | 49% | |=================================== | 50% | |==================================== | 52% | |===================================== | 53% | |====================================== | 54% | |======================================= | 56% | |======================================== | 57% | |========================================= | 58% | |========================================= | 59% | |========================================== | 60% | |========================================== | 61% | |=========================================== | 62% | |============================================ | 63% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 67% | |=============================================== | 68% | |================================================ | 69% | |================================================= | 70% | |================================================= | 71% | |================================================== | 72% | |=================================================== | 73% | |==================================================== | 74% | |===================================================== | 75% | |===================================================== | 76% | |====================================================== | 77% | |======================================================= | 78% | |======================================================== | 80% | |========================================================= | 81% | |========================================================== | 83% | |========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 86% | |============================================================= | 87% | |============================================================== | 88% | |=============================================================== | 90% | |================================================================ | 91% | |================================================================= | 92% | |================================================================= | 93% | |================================================================== | 94% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 100%
rot <- function(a) {
matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2)
}
# Manually tweek these to look the best
alaska <- us[us$STATEFP == "02", ]
alaska$geometry <- alaska$geometry * rot(-40 * pi / 180)
alaska$geometry <- alaska$geometry / 2.8
alaska$geometry <- alaska$geometry + c(-0050000, -2100000)
st_crs(alaska) <- albers_crs
hawaii <- us[us$STATEFP == "15", ]
hawaii$geometry <- hawaii$geometry * rot(-35 * pi / 180)
hawaii$geometry <- hawaii$geometry + c(3600000, 1800000)
st_crs(hawaii) <- albers_crs
us_new <- us[!us$STATEFP %in% c("02", "15"), ]
us_new <- rbind(us_new, alaska, hawaii)
us_new |>
dplyr::summarize(.by = STATEFP, across(geometry, st_union)) |>
ggplot() +
geom_sf() +
kfbmisc::theme_kyle() +
kfbmisc::theme_map()
Created on 2024-09-16 with reprex v2.1.0