Skip to content

Instantly share code, notes, and snippets.

@clauswilke
Created August 5, 2018 21:05
Show Gist options
  • Save clauswilke/09413cb1faa3489cf7d35cd523a0cfdc to your computer and use it in GitHub Desktop.
Save clauswilke/09413cb1faa3489cf7d35cd523a0cfdc to your computer and use it in GitHub Desktop.
library(sf)
library(dplyr)
library(ggplot2)
library(gganimate) # needs development version from github
# helper function to place a geometric object at a desired position
# and scale
place_geometry <- function(geometry, position, scale = 1) {
(geometry - st_centroid(geometry)) * scale +
st_sfc(st_point(position))
}
# projections
# ESRI:102003
crs_lower48 <- "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs"
# EPSG:3338
crs_alaska <- "+proj=aea +lat_1=55 +lat_2=65 +lat_0=50 +lon_0=-154 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs "
# ESRI:
crs_hawaii <- "+proj=aea +lat_1=8 +lat_2=18 +lat_0=13 +lon_0=-157 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs"
# download shapefiles from:
# https://www.census.gov/geo/maps-data/data/cbf/cbf_counties.html
# then unzip in folder "US_shapes"
us_counties_sp <- rgdal::readOGR(dsn = "US_shapes", layer = "cb_2017_us_county_20m")
# aggregate individual counties into states
us_states_sp <- rgeos::gUnaryUnion(us_counties_sp, us_counties_sp$STATEFP)
# collect fips codes; they are the names of the objects after aggregation
us_states_sp$fips_state <- names(us_states_sp)
# convert to sf
us_states <- as(us_states_sp, "sf") %>%
st_transform(crs_lower48) %>%
filter(fips_state != "72") # remove Puerto Rico
# remove Alaska and Hawaii for lower 48
us_lower48 <- filter(us_states, !fips_state %in% c("02", "15"))
bb <- st_bbox(us_lower48)
# scale and move Alaska
us_alaska <- filter(us_states, fips_state == "02")
us_alaska2 <- st_transform(us_alaska, crs_alaska)
st_geometry(us_alaska2) <- place_geometry(
st_geometry(us_alaska2),
c(bb$xmin + 0.08*(bb$xmax - bb$xmin),
bb$ymin + 0.07*(bb$ymax - bb$ymin)),
scale = 0.35
)
st_crs(us_alaska2) <- crs_lower48
# scale and move Hawaii
us_hawaii <- filter(us_states, fips_state == "15")
us_hawaii2 <- st_transform(us_hawaii, crs_hawaii)
st_geometry(us_hawaii2) <- place_geometry(
st_geometry(us_hawaii2),
c(bb$xmin + 0.3*(bb$xmax - bb$xmin),
bb$ymin + 0.*(bb$ymax - bb$ymin))
)
st_crs(us_hawaii2) <- crs_lower48
us_albers <- rbind(us_lower48, us_alaska2, us_hawaii2)
# make animation
x1 <- us_states
x1$type = "a_original"
x2 <- rbind(us_lower48, us_alaska, us_hawaii2)
x2$type = "b_hawaii"
x3 <- us_albers
x3$type = "c_final"
x4 <- x3
x4$type = "d_final"
x <- rbind(x1, x2, x3, x4)
bb1 <- st_bbox(x1)
bb2 <- st_bbox(x3)
ggplot(x, aes(group = fips_state)) +
geom_sf(fill = "#56B4E9", color = "grey30", size = 0.3, alpha = 0.5) +
transition_states(type, 2, 1) +
view_zoom_manual(
2, 1, pause_first = FALSE,
xmin = c(bb1$xmin, bb1$xmin, bb1$xmin, bb2$xmin),
ymin = c(bb1$ymin, bb1$ymin, bb1$ymin, bb2$ymin),
xmax = c(bb1$xmax, bb1$xmax, bb1$xmax, bb2$xmax),
ymax = c(bb1$ymax, bb1$ymax, bb1$ymax, bb2$ymax)
)
# revised animation that keeps Alaska at its size
us_alaska3 <- st_transform(us_alaska, crs_alaska)
st_geometry(us_alaska3) <- place_geometry(
st_geometry(us_alaska3),
c(bb$xmin - 0*(bb$xmax - bb$xmin),
bb$ymin - 0*(bb$ymax - bb$ymin))
)
st_crs(us_alaska3) <- crs_lower48
x1 <- us_states
x1$type = "a_original"
x2 <- rbind(us_lower48, us_alaska, us_hawaii2)
x2$type = "b_hawaii"
x3 <- rbind(us_lower48, us_alaska3, us_hawaii2)
x3$type = "c_final"
x4 <- x3
x4$type = "d_final"
x <- rbind(x1, x2, x3, x4)
bb1 <- st_bbox(x1)
bb2 <- st_bbox(x3)
ggplot(x, aes(group = fips_state)) +
geom_sf(fill = "#56B4E9", color = "grey30", size = 0.3, alpha = 0.5) +
transition_states(type, 2, 1) +
view_zoom_manual(
2, 1, pause_first = FALSE,
xmin = c(bb1$xmin, bb1$xmin, bb1$xmin, bb2$xmin),
ymin = c(bb2$ymin, bb2$ymin, bb2$ymin, bb2$ymin),
xmax = c(bb1$xmax, bb1$xmax, bb1$xmax, bb2$xmax),
ymax = c(bb1$ymax, bb1$ymax, bb1$ymax, bb2$ymax)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment