I am using the ichoropleth function in rmaps [https://github.com/ramnathv/rMaps/blob/master/R/Datamaps.R#L43] to build an animated choropleth. I want to animated by month rather than by year. To achieve this I have changed all instances of the term year in the code to month. The first month's data is displayed but the animation will not play. If my code changes are correct, I suspect that the problem may be having month as a factor, but I cannot convert it to numeric or date while retaining the correct format. Can anyone offer a solution? A sample of my data is below
structure(list(month = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("2013-03",
"2013-04", "2013-05", "2013-06", "2013-07", "2013-08", "2013-09",
"2013-10", "2013-11", "2013-12", "2014-01", "2014-02", "2014-03",
"2014-04", "2014-05", "2014-06", "2014-07", "2014-08"), class = "factor"),
iso = structure(c(2L, 5L, 6L, 7L, 8L, 15L), .Label = c("ABW",
"AFG", "AGO", "AIA", "ALB", "ARE", "ARG", "AUS", "AUT", "AZE",
"BEL", "BEN", "BFA", "BGD", "BGR", "BHR", "BHS", "BIH", "BLR",
"BLZ", "BMU", "BRA", "BRB", "BWA", "CAF", "CAN", "CHE", "CHL",
"CHN", "CMR", "COL", "COM", "CRI", "CUB", "CYM", "CYP", "CZE",
"DEU", "DJI", "DMA", "DNK", "DOM", "DZA", "ECU", "EGY", "ERI",
"ESP", "EST", "ETH", "FIN", "FJI", "FRA", "FRO", "GAB", "GBR",
"GEO", "GGY", "GHA", "GIB", "GIN", "GLP", "GMB", "GNQ", "GRC",
"GRD", "GTM", "GUF", "GUM", "GUY", "HKG", "HND", "HRV", "HTI",
"HUN", "IDN", "IMN", "IND", "IRL", "IRQ", "ISL", "ISR", "ITA",
"JAM", "JEY", "JOR", "JPN", "KAZ", "KEN", "KGZ", "KHM", "KWT",
"LBN", "LBR", "LBY", "LCA", "LKA", "LSO", "LTU", "LUX", "LVA",
"MAR", "MCO", "MDV", "MEX", "MLI", "MLT", "MMR", "MNG", "MOZ",
"MRT", "MUS", "MWI", "MYS", "NAM", "NCL", "NER", "NGA", "NIC",
"NLD", "NOR", "NPL", "NZL", "OMN", "PAK", "PAN", "PER", "PHL",
"PNG", "POL", "PRI", "PRT", "PRY", "QAT", "ROU", "RWA", "SAU",
"SDN", "SEN", "SGP", "SLB", "SLE", "SLV", "SOM", "SRB", "SSD",
"SUR", "SVK", "SVN", "SWE", "SYC", "TGO", "THA", "TJK", "TKM",
"TON", "TTO", "TUN", "TUR", "UGA", "UKR", "URY", "USA", "UZB",
"VNM", "VUT", "WSM", "YEM", "ZAF", "ZMB", "ZWE"), class = "factor"),
volume = c(1L, 1L, 5L, 4L, 12L, 10L)), .Names = c("month",
"iso", "volume"), row.names = c(NA, 6L), class = "data.frame")
Code:
Mchoropleth <- function(x, data, pal = "Blues", ncuts = 5, animate = NULL, play = F, map =
'world', legend = TRUE, labels = TRUE, ...){
d <- Datamaps$new()
fml = lattice::latticeParseFormula(x, data = data)
data = transform(data,
fillKey = cut(
fml$left,
unique(quantile(fml$left, seq(0, 1, 1/ncuts))),
ordered_result = TRUE
)
)
fillColors = RColorBrewer::brewer.pal(ncuts, pal)
d$set(
scope = map,
fills = as.list(setNames(fillColors, levels(data$fillKey))),
legend = legend,
labels = labels,
...
)
if (!is.null(animate)){
range_ = summary(data[[animate]])
data = dlply(data, animate, function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', fml$right.name)
return(y)
})
d$set(
bodyattrs = "ng-app ng-controller='rChartsCtrl'"
)
d$addAssets(
jshead = "http://cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.1/angular.min.js"
)
if (play == T){
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<button ng-click='animateMap()'>Play</button>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope, $timeout){
$scope.month = %s;
$scope.animateMap = function(){
if ($scope.month > %s){
return;
}
map{{chartId}}.updateChoropleth(chartParams.newData[$scope.month]);
$scope.month += 1
$timeout($scope.animateMap, 1000)
}
}
</script>", range_[1], range_[6])
)
} else {
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<input id='slider' type='range' min=%s max=%s ng-model='value' width=200>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope){
$scope.month = %s;
$scope.$watch('month', function(newMonth){
map{{chartId}}.updateChoropleth(chartParams.newData[newMonth]);
})
}
</script>", range_[1], range_[6], range_[1])
)
}
d$set(newData = data, data = data[[1]])
} else {
d$set(data = dlply(data, fml$right.name))
}
return(d)
}
I will try to make a fully reproducible code sample including the bits from your question above.
First, set the data as you provide.
dt <- structure(list(month = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("2013-03",
"2013-04", "2013-05", "2013-06", "2013-07", "2013-08", "2013-09",
"2013-10", "2013-11", "2013-12", "2014-01", "2014-02", "2014-03",
"2014-04", "2014-05", "2014-06", "2014-07", "2014-08"), class = "factor"),
iso = structure(c(2L, 5L, 6L, 7L, 8L, 15L), .Label = c("ABW",
"AFG", "AGO", "AIA", "ALB", "ARE", "ARG", "AUS", "AUT", "AZE",
"BEL", "BEN", "BFA", "BGD", "BGR", "BHR", "BHS", "BIH", "BLR",
"BLZ", "BMU", "BRA", "BRB", "BWA", "CAF", "CAN", "CHE", "CHL",
"CHN", "CMR", "COL", "COM", "CRI", "CUB", "CYM", "CYP", "CZE",
"DEU", "DJI", "DMA", "DNK", "DOM", "DZA", "ECU", "EGY", "ERI",
"ESP", "EST", "ETH", "FIN", "FJI", "FRA", "FRO", "GAB", "GBR",
"GEO", "GGY", "GHA", "GIB", "GIN", "GLP", "GMB", "GNQ", "GRC",
"GRD", "GTM", "GUF", "GUM", "GUY", "HKG", "HND", "HRV", "HTI",
"HUN", "IDN", "IMN", "IND", "IRL", "IRQ", "ISL", "ISR", "ITA",
"JAM", "JEY", "JOR", "JPN", "KAZ", "KEN", "KGZ", "KHM", "KWT",
"LBN", "LBR", "LBY", "LCA", "LKA", "LSO", "LTU", "LUX", "LVA",
"MAR", "MCO", "MDV", "MEX", "MLI", "MLT", "MMR", "MNG", "MOZ",
"MRT", "MUS", "MWI", "MYS", "NAM", "NCL", "NER", "NGA", "NIC",
"NLD", "NOR", "NPL", "NZL", "OMN", "PAK", "PAN", "PER", "PHL",
"PNG", "POL", "PRI", "PRT", "PRY", "QAT", "ROU", "RWA", "SAU",
"SDN", "SEN", "SGP", "SLB", "SLE", "SLV", "SOM", "SRB", "SSD",
"SUR", "SVK", "SVN", "SWE", "SYC", "TGO", "THA", "TJK", "TKM",
"TON", "TTO", "TUN", "TUR", "UGA", "UKR", "URY", "USA", "UZB",
"VNM", "VUT", "WSM", "YEM", "ZAF", "ZMB", "ZWE"), class = "factor"),
volume = c(1L, 1L, 5L, 4L, 12L, 10L)), .Names = c("month",
"iso", "volume"), row.names = c(NA, 6L), class = "data.frame")
This data though only contains 6 rows all with the same month, so I made some fake data using the levels you provided for iso (ISO Country Code) and month. I'll just call it dt2. For future reference, it is very helpful to provide usable data.
dt2 <- data.frame(
iso = as.factor(rep(levels(dt$iso),length(levels(dt$month))))
,month = unlist(lapply(1:length(levels(dt$month)),function(m){
rep(levels(dt$month)[m],length(levels(dt$iso)))
}))
,volume = runif(length(levels(dt$month))*length(levels(dt$iso)),0,100)
)
If you need factors let me know, but it is generally wise to convert factors into numeric or character values when using rCharts and rMaps or JSON in general.
# no reason to have factors
# so I suggest converting to character
dt2$iso <- as.character(dt2$iso)
dt2$month <- as.character(dt2$month)
You are correct in that the issues results from the use of factors, but more specifically, the ichorolpleth function expects numbers not characters. There are multiple ways to fix the issues. I chose this route
Mchoropleth <- function(x, data, pal = "Blues", ncuts = 5, animate = NULL, play = F, map =
'world', legend = TRUE, labels = TRUE, ...){
d <- Datamaps$new()
fml = lattice::latticeParseFormula(x, data = data)
data = transform(data,
fillKey = cut(
fml$left,
unique(quantile(fml$left, seq(0, 1, 1/ncuts))),
ordered_result = TRUE
)
)
fillColors = RColorBrewer::brewer.pal(ncuts, pal)
d$set(
scope = map,
fills = as.list(setNames(fillColors, levels(data$fillKey))),
legend = legend,
labels = labels,
...
)
if (!is.null(animate)){
range_ = sort(unique(data[[animate]]))
data = dlply(data, animate, function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', fml$right.name)
return(y)
})
d$set(
bodyattrs = "ng-app ng-controller='rChartsCtrl'"
)
d$addAssets(
jshead = "http://cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.1/angular.min.js"
)
if (play == T){
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<button ng-click='animateMap()'>Play</button>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope, $timeout){
$scope.keynum = %s;
$scope.animateMap = function(){
if ($scope.keynum === Object.keys(chartParams.newData).length){
return;
}
map{{chartId}}.updateChoropleth(chartParams.newData[Object.keys(chartParams.newData)[$scope.keynum]]);
$scope.keynum += 1
$timeout($scope.animateMap, 1000)
}
}
</script>", 0 )
)
} else {
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<input id='slider' type='range' min=%s max=%s ng-model='value' width=200>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope){
$scope.month = %s;
$scope.$watch('month', function(newMonth){
map{{chartId}}.updateChoropleth(chartParams.newData[newMonth]);
})
}
</script>", range_[1], range_[6], range_[1])
)
}
d$set(newData = data, data = data[[1]])
} else {
d$set(data = dlply(data, fml$right.name))
}
return(d)
}
To isolate the bit that is important, I'll paste it below so that I can talk through it. range_ used summary which does not work on characters, so I changed it to
range_ = sort(unique(data[[animate]]))
We could actually eliminate this, but that is another topic. Then $scope.month += 1 will not work since we are using characters, so I loop through the keys of our data with an index. We start with $scope.keynum = %s which we set to 0 and then add 1 $scope.keynum += 1 until we reach the end $scope.keynum === Object.keys(chartParams.newData).length.
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<button ng-click='animateMap()'>Play</button>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope, $timeout){
$scope.keynum = %s;
$scope.animateMap = function(){
if ($scope.keynum === Object.keys(chartParams.newData).length){
return;
}
map{{chartId}}.updateChoropleth(chartParams.newData[Object.keys(chartParams.newData)[$scope.keynum]]);
$scope.keynum += 1
$timeout($scope.animateMap, 1000)
}
}
</script>", 0 )
)
These R+Javascipt+Angular can be very difficult to debug, so I hope this helps. I assume you saw this post explaining some of what is happening, but I'll post in case you have not.
Here is the entire reproducible code.
library(rCharts)
library(rMaps)
library(plyr)
dt <- structure(list(month = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("2013-03",
"2013-04", "2013-05", "2013-06", "2013-07", "2013-08", "2013-09",
"2013-10", "2013-11", "2013-12", "2014-01", "2014-02", "2014-03",
"2014-04", "2014-05", "2014-06", "2014-07", "2014-08"), class = "factor"),
iso = structure(c(2L, 5L, 6L, 7L, 8L, 15L), .Label = c("ABW",
"AFG", "AGO", "AIA", "ALB", "ARE", "ARG", "AUS", "AUT", "AZE",
"BEL", "BEN", "BFA", "BGD", "BGR", "BHR", "BHS", "BIH", "BLR",
"BLZ", "BMU", "BRA", "BRB", "BWA", "CAF", "CAN", "CHE", "CHL",
"CHN", "CMR", "COL", "COM", "CRI", "CUB", "CYM", "CYP", "CZE",
"DEU", "DJI", "DMA", "DNK", "DOM", "DZA", "ECU", "EGY", "ERI",
"ESP", "EST", "ETH", "FIN", "FJI", "FRA", "FRO", "GAB", "GBR",
"GEO", "GGY", "GHA", "GIB", "GIN", "GLP", "GMB", "GNQ", "GRC",
"GRD", "GTM", "GUF", "GUM", "GUY", "HKG", "HND", "HRV", "HTI",
"HUN", "IDN", "IMN", "IND", "IRL", "IRQ", "ISL", "ISR", "ITA",
"JAM", "JEY", "JOR", "JPN", "KAZ", "KEN", "KGZ", "KHM", "KWT",
"LBN", "LBR", "LBY", "LCA", "LKA", "LSO", "LTU", "LUX", "LVA",
"MAR", "MCO", "MDV", "MEX", "MLI", "MLT", "MMR", "MNG", "MOZ",
"MRT", "MUS", "MWI", "MYS", "NAM", "NCL", "NER", "NGA", "NIC",
"NLD", "NOR", "NPL", "NZL", "OMN", "PAK", "PAN", "PER", "PHL",
"PNG", "POL", "PRI", "PRT", "PRY", "QAT", "ROU", "RWA", "SAU",
"SDN", "SEN", "SGP", "SLB", "SLE", "SLV", "SOM", "SRB", "SSD",
"SUR", "SVK", "SVN", "SWE", "SYC", "TGO", "THA", "TJK", "TKM",
"TON", "TTO", "TUN", "TUR", "UGA", "UKR", "URY", "USA", "UZB",
"VNM", "VUT", "WSM", "YEM", "ZAF", "ZMB", "ZWE"), class = "factor"),
volume = c(1L, 1L, 5L, 4L, 12L, 10L)), .Names = c("month",
"iso", "volume"), row.names = c(NA, 6L), class = "data.frame")
Mchoropleth <- function(x, data, pal = "Blues", ncuts = 5, animate = NULL, play = F, map =
'world', legend = TRUE, labels = TRUE, ...){
d <- Datamaps$new()
fml = lattice::latticeParseFormula(x, data = data)
data = transform(data,
fillKey = cut(
fml$left,
unique(quantile(fml$left, seq(0, 1, 1/ncuts))),
ordered_result = TRUE
)
)
fillColors = RColorBrewer::brewer.pal(ncuts, pal)
d$set(
scope = map,
fills = as.list(setNames(fillColors, levels(data$fillKey))),
legend = legend,
labels = labels,
...
)
if (!is.null(animate)){
range_ = sort(unique(data[[animate]]))
data = dlply(data, animate, function(x){
y = toJSONArray2(x, json = F)
names(y) = lapply(y, '[[', fml$right.name)
return(y)
})
d$set(
bodyattrs = "ng-app ng-controller='rChartsCtrl'"
)
d$addAssets(
jshead = "http://cdnjs.cloudflare.com/ajax/libs/angular.js/1.2.1/angular.min.js"
)
if (play == T){
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<button ng-click='animateMap()'>Play</button>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope, $timeout){
$scope.keynum = %s;
$scope.animateMap = function(){
if ($scope.keynum === Object.keys(chartParams.newData).length){
return;
}
map{{chartId}}.updateChoropleth(chartParams.newData[Object.keys(chartParams.newData)[$scope.keynum]]);
$scope.keynum += 1
$timeout($scope.animateMap, 1000)
}
}
</script>", 0 )
)
} else {
d$setTemplate(chartDiv = sprintf("
<div class='container'>
<input id='slider' type='range' min=%s max=%s ng-model='value' width=200>
<div id='{{chartId}}' class='rChart datamaps'></div>
</div>
<script>
function rChartsCtrl($scope){
$scope.month = %s;
$scope.$watch('month', function(newMonth){
map{{chartId}}.updateChoropleth(chartParams.newData[newMonth]);
})
}
</script>", range_[1], range_[6], range_[1])
)
}
d$set(newData = data, data = data[[1]])
} else {
d$set(data = dlply(data, fml$right.name))
}
return(d)
}
dt2 <- data.frame(
iso = as.factor(rep(levels(dt$iso),length(levels(dt$month))))
,month = unlist(lapply(1:length(levels(dt$month)),function(m){
rep(levels(dt$month)[m],length(levels(dt$iso)))
}))
,volume = runif(length(levels(dt$month))*length(levels(dt$iso)),0,100)
)
# no reason to have factors
# so I suggest converting to character
dt2$iso <- as.character(dt2$iso)
dt2$month <- as.character(dt2$month)
mChoro <- Mchoropleth(
volume ~ iso
, data = dt2
, pal = 'PuRd'
, cuts = 3
, animate = "month"
, play = T
)
mChoro