Alaska_Hawaii_animation.R

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)
  )