删除带有 rCharts 和闪亮的传单热图层 [英] remove leaflet heatmap layer with rCharts and shiny

问题描述

我希望能够让用户使用 rCharts 和 Leaflet 让用户看到基于参数选择的不同热图.

I want to be able to let users see different heatmaps based on a parameter's choice in shiny, using rCharts and Leaflet.

热图第一次显示时看起来很棒.
其他所有时间，热图都显示为第一个之上的层.

The first time the heatmap is displayed it looks great.
All the other times the heat map is displayed as layers on top of the first one.

如何重置叶子图，只显示当前图层/热图?

How to reset the leaf map so that only the current layer / heat map is displayed?

此示例代码基于臭名昭著的 Ramnath 的休斯顿犯罪演示.

This sample code is based on the notorious Ramnath's Houston crime demo.

library(shiny)
library(rCharts)
library(rjson)
library(data.table)
##   
crimedt <- as.data.table(na.omit(ggmap::crime[,c("address","offense","lon","lat")]))
crimedt <- crimedt[,offense:=as.character(offense)]
setkey(crimedt, lat,lon,offense)
crime_cdt <- crimedt[, .(count = length(address))
                          , by = .(lat,lon,offense)]
setkey(crime_cdt,offense)
seLabels <- unique(crime_cdt$offense)

#
runApp(list(
  ui =   tabPanel("main", fluidPage(
    h4("Crime hotmap"),
    column(3,
    selectInput("slCrime", "Choose Crime Type:",
                                            seLabels, seLabels[1])
    ),
    column(9,
           chartOutput('baseMap','leaflet'),
           tags$style('.leaflet {height: 500px;}'),
           tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js"))
            , uiOutput('datamap')
    )
  )),
server = function(input, output, session) {
output$baseMap<-renderMap({
baseMap <- Leaflet$new()
mlon <- mean(crime_cdt$lon)
mlat <- mean(crime_cdt$lat)
baseMap$setView(c(mlat,mlon),9)
baseMap$tileLayer(provider="OpenStreetMap")
baseMap
 })
output$datamap<-renderUI({ 
    if(is.null(input$slCrime)) { return() }
    q = quote(input$slCrime)
    crime_cdt <- crime_cdt[eval(q), .(lat, lon, count)]
    maxdat <- max(crime_cdt$count)
  arrdat <- toJSONArray2(crime_cdt, json=F, names=F)
  jsdat <- rjson::toJSON(arrdat)

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

推荐答案

paulyeno 出色地给出了我的问题的答案.

The answer to my problem has been given brilliantly by paulyeno.

这段 javascript 替换了上面的行:

This piece of javascript substitute the lines above:

tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
if (typeof heat === typeof undefined) {
            heat = L.heatLayer(addressPoints, {maxZoom: 9, radius: 20, blur: 40})
            heat.addTo(map)
          } else {
            heat.setOptions({maxZoom: 9, radius: 20, blur: 40})
            heat.setLatLngs(addressPoints)
          }
 </script>",  jsdat

请注意，目前上述代码在闪亮的 0.10.1 中运行，但不在 0.10.2.1 中(向闪亮的 & rCharts 报告了错误)

Please note that currently the above code runs in shiny 0.10.1 but not in 0.10.2.1 (bug reported to shiny & rCharts)

这篇关于删除带有 rCharts 和闪亮的传单热图层的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！