rmaps aimate choropleth by month

Я использую функцию ichoropleth в rmaps [https://github.com/ramnathv/rMaps/blob/master/R/Datamaps.R#L43] для создания анимированного choropleth. Я хочу анимировать месяц, а не год. Чтобы достичь этого, я изменил все экземпляры термина года в коде за месяц. Данные первого месяца отображаются, но анимация не будет воспроизводиться. Если мои изменения кода верны, я подозреваю, что проблема может иметь месяц как фактор, но я не могу преобразовать ее в числовую или дату, сохраняя при этом правильный формат. Может ли кто-нибудь предложить решение? Образец моих данных нижеrmaps aimate choropleth by month

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_ = 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) 
}

источник

2014-09-11 Dr.B

, когда я использую предоставленные данные. Я получаю data.frame из 6 строк с месяцем 2013-03. Я попытаюсь воспроизвести некоторые поддельные данные. – timelyportfolio

Я попытаюсь сделать полностью воспроизводимый пример кода, в том числе битов из вашего вопроса выше.

Сначала задайте данные по мере их предоставления.

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, дайте мне знать, но это, как правило, целесообразно, чтобы преобразовать факторы в numeric или character значений при использовании rCharts и rMaps или JSON в целом.

# 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

источник

2014-09-11 15:52:07 timelyportfolio

Спасибо за этот ответ, и я отмечаю вашу точку зрения на данные –

rmaps aimate choropleth by month

ответ

Смежные вопросы