Motion Piramid

library(idbr)
library(dplyr)
library(purrr)
library(highcharter)
rm(list = ls())

idb_api_key("35f116582d5a89d11a47c7ffbfc2ba309133f09d")

yrs <-  seq(1980, 2030, by = 1)

df <- map_df(c("male", "female"), function(sex){
  idb1("US", yrs, sex = sex) %>%
    mutate(sex_label = sex)
})

names(df) <- tolower(names(df))

str(df)

## Classes 'tbl_df', 'tbl' and 'data.frame':    10302 obs. of  8 variables:
##  $ age      : num  0 1 2 3 4 5 6 7 8 9 ...
##  $ area_km2 : num  9147593 9147593 9147593 9147593 9147593 ...
##  $ name     : chr  "United States" "United States" "United States" "United States" ...
##  $ pop      : num  1819959 1697003 1641032 1656800 1599421 ...
##  $ fips     : chr  "US" "US" "US" "US" ...
##  $ time     : num  1980 1980 1980 1980 1980 1980 1980 1980 1980 1980 ...
##  $ sex      : num  1 1 1 1 1 1 1 1 1 1 ...
##  $ sex_label: chr  "male" "male" "male" "male" ...

head(df) 

## Source: local data frame [6 x 8]
## 
##     age area_km2          name     pop  fips  time   sex sex_label
##   (dbl)    (dbl)         (chr)   (dbl) (chr) (dbl) (dbl)     (chr)
## 1     0  9147593 United States 1819959    US  1980     1      male
## 2     1  9147593 United States 1697003    US  1980     1      male
## 3     2  9147593 United States 1641032    US  1980     1      male
## 4     3  9147593 United States 1656800    US  1980     1      male
## 5     4  9147593 United States 1599421    US  1980     1      male
## 6     5  9147593 United States 1627209    US  1980     1      male

df <- df %>%
  mutate(population = pop*ifelse(sex_label == "male", -1, 1))

series <- df %>% 
  group_by(sex_label, age) %>% 
  do(data = list(sequence = .$population)) %>% 
  ungroup() %>% 
  group_by(sex_label) %>% 
  do(data = .$data) %>%
  mutate(name = sex_label) %>% 
  list.parse3()

maxpop <- max(abs(df$population))

xaxis <- list(categories = sort(unique(df$age)),
              reversed = FALSE, tickInterval = 5,
              labels = list(step = 5))

highchart() %>%
  hc_chart(type = "bar") %>%
  hc_motion(enabled = TRUE, labels = yrs, series = c(0,1), autoplay = TRUE, updateInterval = 1) %>% 
  hc_add_series_list(series) %>% 
  hc_plotOptions(
    series = list(stacking = "normal"),
    bar = list(groupPadding = 0, pointPadding =  0, borderWidth = 0)
  ) %>% 
  hc_tooltip(shared = TRUE) %>% 
  hc_yAxis(
    labels = list(
      formatter = JS("function(){ return Math.abs(this.value) / 1000000 + 'M'; }") 
    ),
    tickInterval = 0.5e6,
    min = -maxpop,
    max = maxpop) %>% 
  hc_xAxis(
    xaxis,
    rlist::list.merge(xaxis, list(opposite = TRUE, linkedTo = 0))
  ) %>% 
  hc_tooltip(shared = FALSE,
             formatter = JS("function () { return '<b>' + this.series.name + ', age ' + this.point.category + '</b><br/>' + 'Population: ' + Highcharts.numberFormat(Math.abs(this.point.y), 0);}")
  ) %>% 
  hc_add_theme(hc_theme_smpl())