Heat map in Shiny with rCharts

Question

I'm trying to do something similar to Ramnath's Houston crime data heat map demo, but I'm running into some issues. Namely, everything seems to be working except the whole heat map part of it.

I have a dataset of crime information in Seattle; a snippet of the data follows:

   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

I'm trying to create a Shiny application that will display a heat map based on the user's choice of a date range and a subset of offenses.

Here is my 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'))
))

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

This isn't much different than examples I've found on the internet, but what happens is that a map is displayed, and all the sidebar elements are there, but no heat map appears. I've tried playing around with radius and blur in the L.heatLayer call, but there is no effect.

One thing I've noticed in testing is that toJSONArray2 takes a long time to execute, to the point where it might be prohibitively expensive. To address this, I've tried gradually whittling the dataset from 650,000 observations to around 15,000. This does not change anything. I'm not sure if this is really the issue.

Could anyone help point me in the direction of the issue underlying my problem? Thanks in advance!

Answer 1

As it turned out, there were two issues, and then a third that arose when the first two were resolved.

Firstly, <script> in HTML(sprintf(... was unnecessary. This is what I think was causing the "Uncaught SyntaxError: Unexpected token <" error.

Once I got that figured out, it seemed that the json wasn't being treated as lat/lon pairs by L.heatLayer. I'm not sure why this worked, but changing

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)

to

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)

ie, selecting the lat and lon columns inside of toJSONArray2, fixed this.

Finally, once a heatmap showed up, I realized that every change in the state of the map re-drew the heatmap on top of existing ones, to the point where the app would freeze up after a while. This answer provides the solution to this issue.