This post is motivated by a recent article by Vivek Patil, where he showed various ways to generate and animate choropleth maps from R.
Get Data
Let us fetch data from Quandl, which is an excellent source of fascinating datasets. I would strongly recommend that you check it out, if you haven't already :).
library(Quandl)
vcData = Quandl("FBI_UCR/USCRIME_TYPE_VIOLENTCRIMERATE")
kable(head(vcData[,1:9]), format = 'html')
| Year | Alabama | Alaska | Arizona | Arkansas | California | Colorado | Connecticut | Delaware |
|---|---|---|---|---|---|---|---|---|
| 2010-12-31 | 377.8 | 638.8 | 408.1 | 505.3 | 440.6 | 320.8 | 281.4 | 620.9 |
| 2009-12-31 | 450.1 | 633.4 | 426.5 | 515.8 | 473.3 | 338.8 | 300.9 | 645.4 |
| 2008-12-31 | 451.3 | 650.9 | 481.2 | 504.6 | 506.2 | 347.1 | 306.5 | 706.1 |
| 2007-12-31 | 447.9 | 662.3 | 514.5 | 532.6 | 522.6 | 350.6 | 301.1 | 711.5 |
| 2006-12-31 | 425.2 | 686.8 | 545.4 | 557.2 | 533.3 | 394.8 | 298.6 | 701.0 |
| 2005-12-31 | 433.0 | 632.0 | 512.0 | 528.0 | 526.0 | 397.0 | 273.0 | 633.0 |
Reshape Data
Our dataset is in the wide-form. So let us first convert it into the long-form, as it is usually more convenient for visualization purposes. We remove data for the US as a whole, as well as for DC, so that the crime rates are comparable.
library(reshape2)
datm <- melt(vcData, 'Year',
variable.name = 'State',
value.name = 'Crime'
)
datm <- subset(na.omit(datm),
!(State %in% c("United States", "District of Columbia"))
)
kable(head(datm), format = 'html')
| Year | State | Crime |
|---|---|---|
| 2010-12-31 | Alabama | 377.8 |
| 2009-12-31 | Alabama | 450.1 |
| 2008-12-31 | Alabama | 451.3 |
| 2007-12-31 | Alabama | 447.9 |
| 2006-12-31 | Alabama | 425.2 |
| 2005-12-31 | Alabama | 433.0 |
Discretize Crime Rates
For choropleth maps, we would like to discretize crime rates. We do this by dividing crime rates into sextiles.
datm2 <- transform(datm,
State = state.abb[match(as.character(State), state.name)],
fillKey = cut(Crime, quantile(Crime, seq(0, 1, 1/5)), labels = LETTERS[1:5]),
Year = as.numeric(substr(Year, 1, 4))
))
kable(head(datm2), format = 'html')
| Year | State | Crime | fillKey |
|---|---|---|---|
| 2010 | AL | 377.8 | C |
| 2009 | AL | 450.1 | C |
| 2008 | AL | 451.3 | C |
| 2007 | AL | 447.9 | C |
| 2006 | AL | 425.2 | C |
| 2005 | AL | 433.0 | C |
Choose Fill Colors
library(RColorBrewer)
fills = as.list(setNames(rev(brewer.pal(4, 'PiYG')), LETTERS[1:4]))
Create Payload for DataMaps
library(plyr)
library(rCharts)
options(rcharts.cdn = TRUE)
dat2 <- dlply(datm2, "Year", function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', 'State')
return(y)
})
Create Simple Choropleth
map <- Datamaps$new()
map$set(
dom = 'chart_1',
scope = 'usa',
fills = fills,
data = dat2[[1]],
legend = TRUE,
labels = TRUE
)
map
Animated Choropleth
map$set(
bodyattrs = "ng-app ng-controller='rChartsCtrl'"
)
map$addAssets(
jshead = "http://cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.1/angular.min.js"
)
map$setTemplate(chartDiv = sprintf("
<div class='container'>
<input id='slider' type='range' min=1960 max=2010 ng-model='year' width=200>
<div id='chart_1' class='rChart datamaps'></div>
</div>
<script>
var newData = %s
function rChartsCtrl($scope){
$scope.year = 1960;
$scope.$watch('year', function(newYear){
mapchart_1.updateChoropleth(newData[newYear]);
})
}
</script>", rjson::toJSON(dat2)
))
map