rmaps одушевленный хороплет по месяцам

Question

rmaps одушевленный хороплет по месяцам

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

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

1

r rcharts rmaps

Источник

user2543140 11 сен '14 в 08:31

1 ответ

Решение

Другие вопросы по тегам r rcharts rmaps

user1552388 11 сен '14 в 15:52 2014-09-11 15:52 · Accepted Answer · 2014-09-11 15:52

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

Во-первых, установите данные, как вы предоставляете.

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 (Код страны ИСО) и 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 могут быть очень сложными для отладки, поэтому я надеюсь, что это поможет. Я предполагаю, что вы видели этот пост, объясняющий кое-что из того, что происходит, но я отправлю пост, если вы этого не сделали.

Вот весь воспроизводимый код.

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