Japan sf transitions animation

japan_sf_transition_animation.r

original viz link: https://gist.github.com/thomasp85/c36ab5cfe387dec9d5e99a85a776bfa0

# try to do above but with Japan instead!

library(gganimate) 
library(cartogram)
library(geogrid) # devtools::install_github("jbaileyh/geogrid") >>> for sf support!
library(rnaturalearth)
library(sf)
library(scico)
library(jpndistrict)
library(dplyr)
library(purrr)
library(rvest)
library(stringr)
library(tidyr)

# japan polygons
sf_ja <- 1:47 %>% 
    map(~jpndistrict::jpn_pref(pref_code = ., district = FALSE)) %>% 
    reduce(rbind) %>% 
    st_simplify(dTolerance = 0.001) %>% 
    mutate(jis_code = as.numeric(jis_code))
    
# population data
url <- "https://en.wikipedia.org/wiki/List_of_Japanese_prefectures_by_population"

prefectures_raw <- url %>% 
  read_html() %>% 
  html_nodes("#mw-content-text > div > table:nth-child(16)") %>% 
  .[[1]] %>% 
  html_table()

pref_pop_hist <- prefectures_raw %>% 
  gather(key = "year", value = "population", - Prefectures) %>% 
  janitor::clean_names() %>% 
  mutate(year = year %>% str_replace_all("Oct 1,\n", "") %>% as.numeric(),
         population = population %>% str_replace_all(",", "") %>% as.numeric(),
         prefectures = prefectures %>% str_replace_all("-.*", ""),
         prefectures = prefectures %>% iconv(from = "UTF-8", to = "ASCII//TRANSLIT") %>%
           trimws()) %>% 
  arrange(year) %>% 
  left_join(geofacet::jp_prefs_grid1, by = c("prefectures" = "name")) %>% 
  select(-col, -row, -name_region, -code_pref_jis)

pref_2010_pop <- pref_pop_hist %>% 
  filter(year == 2010) %>% 
  filter(prefectures != "Japan")

# COMBINE
sf_ja_pop <- sf_ja %>% 
  left_join(pref_2010_pop, by = c("jis_code" = "code")) %>% 
  st_transform(crs = "+init=epsg:3395") %>%   
  st_cast("MULTIPOLYGON")
  
## Grids

# hexagonal
ja_hex <- calculate_grid.sf(shape = sf_ja_pop, grid_type = "hexagonal", seed = 1)
# must install github version for sf support!

sf_hex_ja <- assign_polygons.sf(sf_ja_pop, ja_hex)
  
# square
ja_sq <- calculate_grid(sf_ja_pop, grid_type = "regular", seed = 2)
sf_sq_ja <- assign_polygons.sf(sf_ja_pop, ja_sq)

# contiguous cartogram
sf_carto_jp <- sf_ja_pop %>% 
  cartogram_cont("population")
  
# Combine all into one df
types <- c(
  'Original',
  'Cartogram Weighted by Population',
  'Hexagonal Tiling',
  'Square Tiling'
)

sf_ja_pop$types <- types[1]
sf_carto_jp$types <- types[2]
sf_hex_ja$types <- types[3]
sf_sq_ja$types <- types[4]

japan_all <- rbind(sf_ja_pop, sf_carto_jp[, names(sf_ja_pop)], 
                   sf_hex_ja[, names(sf_ja_pop)], sf_sq_ja[, names(sf_ja_pop)])

japan_all <- japan_all %>% mutate(types = as.factor(types))
  

# plot and animate the sf transitions!
# change CRS to 3395 for cartogram to work, may be the reason that everything else gets screwed up though??
# tried other CRS and other projections as well...
# crs = "+proj=laea +lat_0=35 +lon_0=139"   works much better for square and hexagon maps but still many tiles bunch up next to Hokkaido instead...

ggplot(japan_all) +
  geom_sf(aes(fill = population, group = prefectures)) +
  scale_fill_scico(palette = "lapaz") +
  coord_sf(datum = NA) +
  theme_void() +
  theme(legend.position = "bottom",
        legend.text = element_text(angle = 30, hjust = 1)) +
  labs(title = "Showing {closest_state}",
       fill = "Population") +
  transition_states(types, 2, 1)

anim_save(filename = "jp_sf_transitions.gif")