Je vais essayer de faire un exemple de code entièrement reproductible, y compris les bits de votre question ci-dessus.
Commencez par définir les données selon vos besoins.
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")
Ces données ne contient que 6 lignes, toutes avec le même mois, donc je fait des données fausses en utilisant les niveaux que vous avez fournis pour iso (Code ISO pays) et month. Je vais juste l'appeler dt2. Pour référence future, il est très utile de fournir des données utilisables.
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)
)
Si vous avez besoin factors me le faire savoir, mais il est généralement sage de convertir des facteurs en numeric ou character valeurs lors de l'utilisation rCharts et rMaps ou JSON en général.
# no reason to have factors
# so I suggest converting to character
dt2$iso <- as.character(dt2$iso)
dt2$month <- as.character(dt2$month)
Vous avez raison en ce que les résultats des enjeux de l'utilisation de facteurs, mais plus précisément, la fonction ichorolpleth attend des nombres non caractères. Il existe plusieurs façons de résoudre les problèmes. J'ai choisi cette 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)
}
Pour isoler le bit qui est important, je vais le coller ci-dessous afin que je puisse parler à travers. range_ résumé utilisé qui ne fonctionne pas sur les personnages, donc je l'ai changé pour
range_ = sort(unique(data[[animate]]))
Nous pourrions éliminer effectivement, mais qui est un autre sujet. Alors $scope.month += 1 ne fonctionnera pas puisque nous utilisons des caractères, donc je boucle les clés de nos données avec un index. Nous commençons avec $scope.keynum = %s que nous avons mis à 0 et ensuite ajouter 1 $scope.keynum += 1 jusqu'à ce que nous atteignions la fin $scope.keynum === Object.keys(chartParams.newData).length. Ces R + Javascipt + Angular peuvent être très difficiles à déboguer, donc j'espère que cela aidera. Je suppose que vous avez vu ce post explaining some of what is happening, mais je vais poster au cas où vous ne l'avez pas.
Voici l'intégralité du code reproductible.
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
Lorsque j'utilise les données fournies, j'obtiens un data.frame de 6 lignes toutes avec le mois 2013-03. Je vais essayer de faire quelques fausses données à reproduire. – timelyportfolio