2015-10-18 73 views
2

我正在尝试类似Ramnath的休斯顿犯罪数据热图演示,但我遇到了一些问题。也就是说,除了整个热图部分外,所有东西似乎都在工作。ShCharts的热图

我有一个在西雅图的犯罪信息的数据集;该数据的一个片段如下:

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 

我试图创建一个应用程序有光泽,将显示基于用户选择的日期范围和罪行的一个子集的热图。

这里是我的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调用中玩弄半径和模糊,但没有任何效果。

我在测试中注意到的一件事情是,JSONArray2需要很长时间来执行,直到它可能会非常昂贵。为了解决这个问题,我试着将数据集从650,000个观察点逐渐削减到15,000个左右。这不会改变任何东西。我不确定这是否真的是问题。

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

+0

什么错误(如果有的话)显示在浏览器开发人员工具的JavaScript控制台? – hrbrmstr

+0

有两个“未捕获的SyntaxError:意外的令牌<”错误,还有一个“无法加载资源:服务器响应的状态为404(未找到)”错误。还有一个警告,称“主线程上的同步XMLHttpRequest已被弃用,因为它对最终用户的体验有不利影响。”我不确定这些是什么意思。 – user4601931

+0

@hrbrmstr我认为您的评论正在成为问题的核心......我相信在server.R文件中的HTML(sprintf(...))位中出现问题。它是不是正确地认识到Javascript? – user4601931

回答

2

事实证明,有两个问题,然后在前两个问题解决时出现三分之一。

首先,<script>在HTML(sprintf的(...是不必要的这是我认为是什么原因导致的“未捕获的SyntaxError:意外的标记<”。错误

一旦我得到了想通了,它似乎是JSON的没有被视为由L.heatLayer经/纬度对。我不知道为什么这个工作,但改变

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) 

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

即,选择toJSONArray2内部的lat和lon列,解决了这个问题。

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

+0

您使用的是什么版本的闪亮? – tospig

+0

我使用的是最新版本,0.12.2。 – user4601931