clauswilke · August 5, 2018 21:05 · Aug 5, 2018
diff --git a/Alaska_Hawaii_animation.R b/Alaska_Hawaii_animation.R
@@ -0,0 +1,122 @@
+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)
+  )