Shiny中的热图与rCharts

时间:2015-10-18 02:01:24

标签: r shiny rcharts

我试图做类似Ramnath的休斯顿犯罪数据热图演示,但我遇到了一些问题。也就是说,除了整个热图之外,一切似乎都在起作用。

我在西雅图有犯罪信息数据集;下面是一小段数据:

   Offense       Date Longitude Latitude
3  Assault 2015-10-02 -122.3809 47.66796
5  Assault 2015-10-03 -122.3269 47.63436
6  Assault 2015-10-04 -122.3342 47.57665
7   Weapon 2015-04-12 -122.2984 47.71930
8  Assault 2015-06-30 -122.3044 47.60616
9 Burglary 2015-09-04 -122.2754 47.55392

我正在尝试创建一个Shiny应用程序,该应用程序将根据用户对日期范围和一部分攻击的选择显示热图。

这是我的ui.R:

library(shiny)
library(rCharts)
library(rjson)

shinyUI(fluidPage(
  headerPanel("Crime in Seattle"), 

  sidebarPanel(
    uiOutput("select.date.ran"), 
    uiOutput("select.crime")
  ), 

  mainPanel(chartOutput("my.map", "leaflet"),
            tags$style('.leaflet {height: 500px;}'),
            tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
            uiOutput('spd.map'))
))

和server.R:

library(shiny)
library(rCharts)
library(rjson)

spd <- readRDS("data/spd.rds")

shinyServer(function(input, output, session) {

  output$select.date.ran <- renderUI({
    dateRangeInput("sel.date", "Choose date range:", 
                   start = "2014/01/01", end = "2015/10/05", 
                   separator = "to", format = "yyyy/mm/dd",
                   startview = "month", weekstart = 0, 
                   language = "en")
  })

  output$select.crime <- renderUI({
    checkboxGroupInput(inputId = "sel.crime", "Select crimes:", 
                  choices = c("Theft", "Fraud", "Drugs/Alcohol", 
                              "Weapon", "Assault", "Disturbance", 
                              "Robbery", "Homicide", "Prostitution"), 
                  selected = "Theft")
  })

  output$my.map <- renderMap({

    my.map <- Leaflet$new() 
      my.map$setView(c(47.5982623,-122.3415519) ,12) 
      my.map$tileLayer(provider="Esri.WorldStreetMap")
    my.map
  })

  output$spd.map <- renderUI({
    spd.dat <- spd[spd$Offense %in% input$sel.crime & 
                       (spd$Date >= input$sel.date[1] &
                          spd$Date <= input$sel.date[2]), c(3, 4)]
    spd.json <- toJSONArray2(spd.dat, json = FALSE, names = FALSE)

    tags$body(tags$script(HTML(sprintf("
                      <script>
                      var addressPoints = %s
                      var heat = L.heatLayer(addressPoints, {maxZoom: 9, radius: 20, blur: 40}).addTo(map)
                      </script>", rjson::toJSON(spd.json)
              ))))
  })
})

这与我在互联网上找到的示例大不相同,但会发生的是显示地图,并且所有侧边栏元素都在那里,但没有出现热图。我已经尝试过在L.heatLayer调用中玩半径和模糊,但是没有效果。

我在测试中注意到的一件事是,toJSONArray2需要很长时间才能执行,以至于它可能非常昂贵。为了解决这个问题,我尝试逐渐将数据集从650,000个观测值削减到大约15,000个。这不会改变任何事情。我不确定这是不是真的是问题。

任何人都可以帮我指出我的问题背后的问题吗?提前谢谢!

1 个答案:

答案 0 :(得分:2)

事实证明,有两个问题,然后在前两个问题得到解决时出现了第三个问题。

首先,HTML中的3,(sprintf(...是不必要的。这就是我认为导致&#34;未捕获的SyntaxError:意外的令牌&lt;&#34;错误。

一旦我弄清楚了,似乎json并没有被L.heatLayer视为lat / lon对。我不确定为什么会这样,但改变

<script>

spd.dat <- spd[spd$Offense %in% input$sel.crime & 
                   (spd$Date >= input$sel.date[1] &
                      spd$Date <= input$sel.date[2]), c(3, 4)]
spd.json <- toJSONArray2(spd.dat, json = FALSE, names = FALSE)

即,选择toJSONArray2中的lat和lon列,修复此问题。

最后,一旦热图出现,我意识到地图状态的每次变化都会将热图重新绘制在现有热图之上,以至于应用程序会在一段时间后冻结。 This回答提供了此问题的解决方案。