我會盡力做一個完全可重複的代碼示例包括以上你的問題位。
首先,設置您提供的數據。
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")
這個數據雖然只包含了所有同月6行,所以我用你iso
(ISO國家代碼)和month
提供的水平做了一些假數據。我會把它叫做dt2
。爲了將來的參考,提供可用數據是非常有用的。
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)
)
如果你需要factors
讓我知道,但它使用普通rCharts
和rMaps
或JSON
時一般是明智的因素轉化爲numeric
或character
值。
# no reason to have factors
# so I suggest converting to character
dt2$iso <- as.character(dt2$iso)
dt2$month <- as.character(dt2$month)
你是從使用的因素,這些問題的結果是正確的,但更具體地講,ichorolpleth
功能預計數字而不是字符。有多種方法可以解決這些問題。我選擇了這條路
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)
}
要隔離位是重要的,我將在下面貼吧,這樣我可以通過它說話。 range_
不上字符工作總結使用的,所以我把它改成
range_ = sort(unique(data[[animate]]))
我們實際上可以消除這種,但那是另一個話題。然後$scope.month += 1
將不起作用,因爲我們正在使用字符,所以我通過索引來遍歷數據的關鍵字。我們從$scope.keynum = %s
開始,我們將其設置爲0,然後添加1 $scope.keynum += 1
,直到我們到達末尾$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 )
)
這些R + Javascipt + Angular可能很難調試,所以我希望這有助於。我假設你看到這個post explaining some of what is happening,但我會張貼,如果你沒有。
這裏是整個可重複的代碼。
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
當我使用提供的數據我得到一個data.frame的6行所有月份2013-03。我會盡力讓一些假數據重現。 – timelyportfolio 2014-09-11 15:02:26