us-popest-animation/R/02_population-animations.R

## ----setup, include=FALSE------------------------------------------------
knitr::opts_chunk$set(echo=FALSE)

## ----library-------------------------------------------------------------
library(dplyr)
library(purrr)
library(tidyr)
library(stringr)
library(readr)
library(forcats)
library(gganimate)

DATA_DIR <- "data-raw"
ANIM_OUT <- "anim"
fs::dir_create(here::here(ANIM_OUT))

pop <- readRDS(here::here("data", "pop_estimates_by_age.rds"))

## ------------------------------------------------------------------------
ga <-
  pop %>%
  bind_rows() %>%
  mutate(age_group_int = as.integer(Age) %/% 5) %>%
  group_by(age_group_int) %>%
  mutate(
    # age_group = paste(min(Age), max(Age), sep = " - "),
    age_group = paste(min(Age)),
    age_group = ifelse(Age >= 100, "100+", age_group)
  ) %>%
  ungroup() %>%
  arrange(age_group_int, Year) %>%
  mutate(age_group = fct_inorder(age_group)) %>%
  select(-age_group_int) %>%
  group_by(Year, age_group) %>%
  summarize(Total = sum(Total)) %>%
  group_by(Year) %>%
  mutate(GrandTotal  = sum(Total)) %>%
  ungroup() %>%
  mutate(Total = Total/GrandTotal) %>%
  arrange(Year, age_group) %>%
  # complete(Year, age_group, fill = list(Total = 0)) %>%
  # filter(Year > 2000) %>%
  {
    ggplot(.) +
      # aes(age_group, Total) +
      # geom_vline(xintercept = c(1980, 1990), color = "grey50") +
      # geom_line(aes(group = age_group)) +
      # geom_point(size = 0.2) +
      # geom_col(fill = "grey40") +
      # facet_wrap(~ Year) +
      # coord_flip() +
      # scale_y_continuous(labels = function(x) {grkmisc::pretty_num(x, decimal_digits = 0)}) +
      geom_segment(aes(yend = age_group, y = age_group, xend = Total), x = 0, size = 5) +
      geom_segment(aes(yend = age_group, y = age_group, xend = Total),
                   x = 0,
                   size = 5,
                   color = "grey40",
                   alpha = 0.25,
                   data = filter(., Year == min(Year)) %>% select(-Year)
      ) +
      # annotate("text", label = "{closest_state}", x = max(.$Total) * 0.8, y = 20, size = 12) +
      theme_minimal(base_size = 16, base_family = "Fira Sans Condensed") +
      theme(panel.grid.major.y = element_blank()) +
      scale_x_continuous(labels = scales::percent, expand = c(0, 0, 0.05, 0)) +
      # labs(x = "Percent of Population", y = NULL) +
      theme(axis.title.x = element_text(hjust = 0.5, size = 30)) +
      labs(x = "{closest_state}", y = NULL) +
      gganimate::transition_time(Year) +
      gganimate::transition_states(Year, 1, 0, wrap = FALSE) +
      gganimate::ease_aes("linear") +
      gganimate::enter_fade()
  }

grkmisc::logger(msg = "Creating pop bar frames")
ga_files <-
  animate(ga,
        width = 2080, height = 960, res = 144, fps = 25, nframes = 161,
        renderer = file_renderer(here::here(ANIM_OUT, "frames"), "pop-anim", overwrite = TRUE))

first_last <- first_last_new <- ga_files[c(1, length(ga_files))]
first_last_new[1] <- sub("\\d+\\.png", "_first.png", first_last[1])
first_last_new[2] <- sub("\\d+\\.png", "_last.png", first_last[2])
fs::file_copy(first_last, fs::path(ANIM_OUT, fs::path_file(first_last_new)), overwrite = TRUE)

grkmisc::logger(msg = "Writing MP4 population bar animation")
av::av_encode_video(
  ga_files,
  here::here(ANIM_OUT, "pop-anim.mp4"),
  verbose = TRUE
)

grkmisc::logger(msg = "Writing gif population bar animation")
gifski::gifski(
  ga_files,
  here::here(ANIM_OUT, "pop-anim.gif"),
  width = 2080, height = 960, delay = 1/18, loop = FALSE
)

unlink(ga_files)

pop %>%
  bind_rows() %>%
  mutate(age_group_int = as.integer(Age) %/% 5) %>%
  select(1:3, age_group_int) %>%
  filter(age_group_int > 5) %>%
  mutate(
    old = age_group_int >= 13,
    old = c("Adult", "Older Adult")[old + 1]
  ) %>%
  group_by(Year, old) %>%
  summarize(n = sum(Total)) %>%
  spread(old, n) %>%
  {
    ggplot(.) +
      aes(x = Year) +
      geom_segment(aes(xend = Year, y = Adult, yend = `Older Adult`)) +
      geom_point(aes(y = Adult), color = grkmisc::moffitt_colors$blue) +
      geom_point(aes(y = `Older Adult`), color = grkmisc::moffitt_colors$orange, size = 2)
  } %>%
  invisible()

elder_dependency <-
  pop %>%
  bind_rows() %>%
  mutate(age_group_int = as.integer(Age) %/% 5) %>%
  select(1:3, age_group_int) %>%
  mutate(
    old = case_when(
      age_group_int < 3 ~ "Children",
      age_group_int >= 13 ~ "Older Adult",
      TRUE ~ "Adult"
    )
  ) %>%
  group_by(Year, old) %>%
  summarize(n = sum(Total)) %>%
  spread(old, n) %>%
  mutate(
    dependency_elder = `Older Adult` / Adult,
    dependency_all = (`Older Adult` + Children) / Adult
  )

ga_elder_dep <-
  ggplot(elder_dependency) +
  aes(Year, dependency_elder) +
  geom_point(color = "#00589a") +
  geom_point(data = filter(elder_dependency, Year == 2018), size = 4, color = "#eb1455") +
  labs(y = "Dependency Ratio", x = NULL) +
  theme_minimal(base_size = 24, base_family = "Fira Sans Condensed") +
  scale_y_continuous(labels = scales::percent) +
  gganimate::transition_states(Year, 1, 0, FALSE) +
  gganimate::shadow_mark()

grkmisc::logger(msg = "Creating elder dep frames")
ga_elder_dep_files <-
  animate(ga_elder_dep,
        width = 2080, height = 960, res = 144, fps = 25, nframes = 161,
        renderer = file_renderer(here::here(ANIM_OUT, "frames"), "pop-dependency", overwrite = TRUE))

first_last <- first_last_new <- ga_elder_dep_files[c(1, length(ga_elder_dep_files))]
first_last_new[1] <- sub("\\d+\\.png", "_first.png", first_last[1])
first_last_new[2] <- sub("\\d+\\.png", "_last.png", first_last[2])
fs::file_copy(first_last, fs::path(ANIM_OUT, fs::path_file(first_last_new)), overwrite = TRUE)

grkmisc::logger(msg = "Writing mp4 elder dependency animation")
av::av_encode_video(
  ga_elder_dep_files,
  output = here::here(ANIM_OUT, "pop-dependency.mp4"),
  verbose = TRUE
)

grkmisc::logger(msg = "Writing gif elder dependency animation")
gifski::gifski(
  ga_elder_dep_files,
  here::here(ANIM_OUT, "pop-dependency.gif"),
  width = 2080, height = 960, delay = 1/25, loop = FALSE
)
unlink(ga_elder_dep_files)

elder_dep_together <-
  elder_dependency %>%
  ungroup() %>%
  gather(timeseries, ratio, starts_with("depend")) %>%
  select(-Adult:-`Older Adult`) %>%
  mutate(timeseries = ifelse(timeseries == "dependency_elder", 0, 1))

ga_dep_together <-
  ggplot(elder_dep_together) +
  aes(Year, ratio, group = Year) +
  geom_point(aes(color = paste(timeseries)), show.legend = FALSE) +
  scale_color_manual(values = c("#00589a", "#82c878")) +
  labs(y = "Dependency Ratio", x = NULL) +
  theme_minimal(base_size = 24, base_family = "Fira Sans Condensed") +
  scale_y_continuous(labels = scales::percent) +
  gganimate::transition_states(timeseries, 1, 0, FALSE) +
  gganimate::view_follow(fixed_x = TRUE) +
  gganimate::ease_aes("sine-in-out")+
  gganimate::shadow_mark()

grkmisc::logger(msg = "Creating all dependency frames")
ga_dep_together_files <-
  animate(ga_dep_together,
        width = 2080, height = 960, res = 144, fps = 25, nframes = 161,
        renderer = file_renderer(here::here(ANIM_OUT, "frames"), "pop-dependency-both", overwrite = TRUE))

first_last <- first_last_new <- ga_dep_together_files[c(1, length(ga_dep_together_files))]
first_last_new[1] <- sub("\\d+\\.png", "_first.png", first_last[1])
first_last_new[2] <- sub("\\d+\\.png", "_last.png", first_last[2])
fs::file_copy(first_last, fs::path(ANIM_OUT, fs::path_file(first_last_new)), overwrite = TRUE)

grkmisc::logger(msg = "Writing mp4 all dependency animation")
av::av_encode_video(
  ga_dep_together_files,
  output = here::here(ANIM_OUT, "pop-dependency-both.mp4"),
  verbose = TRUE
)

grkmisc::logger(msg = "Writing gif all dependency animation")
gifski::gifski(
  ga_dep_together_files,
  here::here(ANIM_OUT, "pop-dependency-both.gif"),
  width = 2080, height = 960, delay = 1/25, loop = FALSE
)

unlink(ga_dep_together_files)