删除带有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的Houston犯罪演示.

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

推荐答案

我的问题的答案已经由鲍里埃诺(Baulyeno)给予了精彩.

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屋！