Depicts changing US unemployment rates as a video (mp4) choropleth.

unemploymentVideo.R

#Warning: Messy code. 
#(It's been repurposed a few times.)
library(plyr)
library(ggplot2)

plotData <- function(date) {
  und <- c(unemp[unemp$Date==date, -1])
  und <- und[order(names(und))]
  und <- t(as.data.frame(und))
  
  und <- data.frame(State=rownames(und), Unemployment=und[,1])
  und <- join(und, state.abbr)
  
  und
}

makePlot <- function(month) {
  und <- plotData(month)
  states.w <- subset(states, region %in% und$region)
  
  year <- sub('(\\d{4})-.+', "\\1", month)
  monthnum <- sub(".+-(\\d{2})-.+", "\\1", month)
  monthnum <- as.integer(monthnum)
  monthname <- monthnames[monthnum]
  title <- paste(year, monthname, sep=", ")
  print(title)
  
  ggplot(und, aes(map_id = region)) + map_theme +
    geom_map(aes(fill = Unemployment), map = states.w) + 
    scale_fill_continuous(limits=lmts, high="#b50900", low="#fcdad9") +
    expand_limits(x = states.w$long, y = states.w$lat) +
    geom_path(data=states.w,
              aes(long,lat,group=group),
              colour="white",linetype='solid', lwd=1) +
    ggtitle(title) +
    coord_fixed()
}

savePlots <- function(months) {
  for ( x in 1:length(months)) {
    x0 <- sprintf("%04d", x)
    fname <- paste('img', x0, '.png', sep='')
    print(fname)
    png(fname, width=1920, height=1080)
    print(makePlot(months[x]))
    dev.off()
  }
}

monthnames <- c('January', 'February', 'March',
                'April', 'May', 'June',
                'July', 'August', 'September', 
                'October', 'November', 'December')

dfile <- 'unemployment.csv'
nowts <- as.integer(Sys.time())



if ( !file.exists(dfile) | 
       nowts - as.integer(file.info('unemployment.csv')$ctime) > (60*60*24*7 ) )   {
  fsource <- 'http://www.quandl.com/api/v1/datasets/USER_14Z/151.csv'
  #fsource <- 'http://www.quandl.com/api/v1/datasets/USER_14Z/150.csv'
  download.file(fsource, dfile)
}

unemp <- read.csv(dfile, stringsAsFactors=F)
colnames(unemp) <- sub('URN...Value', '', colnames(unemp))

#Set the min and max values for the plot's color scale.
lmts = c(min(unemp[, -1], na.rm=T), 
         max(unemp[, -1], na.rm=T))


mths <- setNames(as.list(unemp$Date), 
                 sub("([0-9]{4})-0?(1?[0-9])-[0-9]{2}", "\\2/\\1", unemp$Date))

for ( m in 1:12) {
  names(mths) <-sub(paste('^', m, '/', sep=''),
                    paste(monthnames[m], ' ', sep=''), 
                    names(mths))
}

state.abbr <- 'state.abbr.csv'

if ( !file.exists(state.abbr) ) {
  fsource <- 'http://www.fonz.net/blog/wp-content/uploads/2008/04/states.csv'
  download.file(fsource, state.abbr)
}

state.abbr <- read.csv(state.abbr, stringsAsFactors=F)
state.abbr$State <- tolower(state.abbr$State)
names(state.abbr) = c('region', 'State')
states <- map_data("state")

map_theme <- theme(
  line = element_blank(), 
  rect = element_blank(),
  strip.text = element_blank(),
  axis.text = element_blank(),
  axis.title = element_blank(),
  plot.title = element_text(face="bold", hjust=0, size=64))

#Remove the last two months--we don't have that data for all states yet.
months <- sort(unemp$Date[3:length(unemp$Date)])
savePlots(months)

#Ran into problems using animation::saveVideo() here.
system('ffmpeg -f image2 -r 4 -i img%04d.png unemp.mp4')