R Shiny Leaflet javascript插件-热图 [英] R shiny leaflet javascript addons - heatmap

查看:151
本文介绍了R Shiny Leaflet javascript插件-热图的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

尝试对单张使用JavaScript插件之一-特别是热图功能- https://github.com. com/Leaflet/Leaflet.heat 问题是-我想将其合并到Shiny中,但是R的传单似乎没有默认包含此插件,因此我必须以某种方式手动包含此JS.我最想知道如何执行此操作的方法是通过rCharts上的帖子显示以下内容:

Trying to use one of the javascript addons for leaflet - specifically the heatmap functionality - https://github.com/Leaflet/Leaflet.heat Thing is - I want to incorporate this into Shiny, but leaflet for R doesn't seem to have this addon included by default, so I would have to somehow include this JS manually. The closest I got to figuring out how to do this is through a post on rCharts that showed this:

server.R.

 HeatMap$addAssets(jshead = c("http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js"))
 HeatMap$setTemplate(afterScript = sprintf("<script>
      var addressPoints = %s
      var heat = L.heatLayer(addressPoints).addTo(map)           
      </script>",
      rjson::toJSON(dt)))

(摘自: https://github.com/ramnathv/rCharts/issues/498 )

但是对JS不太熟悉,并且是新手,因此尚不清楚如何从头到尾进行合并-即从github上获取此JS,最后使用在数据集"quakes"上使用小叶创建的热图'.

But being not too familiar with JS, and new to leaflet it's still not quite clear how it can be incorporated from beginning to end - i.e. taking this JS from github and ending up with a heatmap created using leaflet on the dataset 'quakes'.

我的服务器端代码如下:

My server side code is something like the following:

library(leaflet)
output$mymap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("OpenMapSurfer.Roads",
                       options = providerTileOptions(noWrap = TRUE))
 %>% addMarkers(clusterOptions = markerClusterOptions(), data = quakes))

我想在这里代替clusterOptions添加一个地震震级的热图(R中包含数据集"quakes",所以您可以自己查看).

Where instead of clusterOptions I would like to add a heatmap of the magnitude of the earthquakes (the dataset 'quakes' is included in R so you can see it for yourself).

在解决这个问题上的任何帮助将不胜感激! :)

Any help on figuring this out would be very much appreciated! :)

推荐答案

setTemplate(afterscript...)位无法正常工作.相反,您需要使用tags$()并将热图输出单独呈现到地图上.

The setTemplate(afterscript...) bit doesn't work in shiny. Instead you need to use tags$() and render the heatmap output separately to the map.

这是一个使用热图的基本应用程序(受此SO答案启发)

Here is a basic app that uses heatmaps (inspired by this SO answer )

server.R

library(shiny)
library(rCharts)

dat <- data.frame(Offence =  c("Assault","Assault","Assault","Weapon","Assault","Burglary"),
                  Date = c("2015-10-02","2015-10-03","2015-10-04","2015-04-12","2015-06-30","2015-09-04"),
                  Longitude = c(-122.3809, -122.3269, -122.3342, -122.2984, -122.3044, -122.2754),
                  Latitude = c(47.66796,47.63436,47.57665,47.71930,47.60616,47.55392),
                  intensity = c(10,20,30,40,50,30000))


shinyServer(function(input, output, session) {

  output$baseMap <- renderMap({
    baseMap <- Leaflet$new() 
    baseMap$setView(c(47.5982623,-122.3415519) ,12) 
    baseMap$tileLayer(provider="Esri.WorldStreetMap")
    baseMap
  })

  output$heatMap <- renderUI({

    ## here I'm creating the JSON through 'paste0()'.
    ## you can also use jsonlite::toJSON or RJSONIO::toJSON

    j <- paste0("[",dat[,"Latitude"], ",", dat[,"Longitude"], ",", dat[,"intensity"], "]", collapse=",")
    j <- paste0("[",j,"]")
    j

    tags$body(tags$script(HTML(sprintf("
                      var addressPoints = %s
                      var heat = L.heatLayer(addressPoints).addTo(map)"
                                       , j
    ))))
  })

})

ui.R

library(shiny)
library(rCharts)

shinyUI(fluidPage(

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


编辑-使用Google Maps

googleway 的开发版本中,还有一种方法可以做到这一点.为此,您需要一个有效的Google API密钥,目前它仅在浏览器中有效


Edit - Using Google Maps

There is also a way to do this in the development version of googleway. For this you'll need a valid Google API key, and currently it only works in a browser

## devtools::install_github("googleway")
library(googleway)
library(magrittr)
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    actionButton(inputId = "traffic", label = "traffic"),
    box(width = 10,
        height = 600,
      google_mapOutput("myMap")
    )
  )
)


server <- function(input, output){

map_key <- "your_valid_api_key"
## https://developers.google.com/maps/documentation/javascript/get-api-key

## set up some data-------
pl <- "~s|dF}{~rZnNoExBq@|@SfAIjA@~Et@fBBp@Iv@QxCoArNqGfA_@dB]`KgAfVkC|Gu@rAYf@Q|@i@p@m@n@{@^u@`@kAR_ALiADuACiAIeAOy@_@qA{@uB{@sB]gAUmAOaB?oCTkKr@kZZiN?s@Cq@EQDOLILFn@A\\CpI_A|AQjB[BGPOX@LHz@CpAKT?v@KpHu@vD]LGt@Ix@I\\QBGLOVCPJd@Dj@GnFq@`PaBp@KfBQzA[zAq@nAaAx@aA~ByDp@yAXe@VSVO@EVWPCRDJLBF@Hd@TrDj@rK`ADEJGJ@JFBFrSxBJOPCNHHPdBLnCb@bBb@lAf@zA~@lAbApAzAt@nAxA|C~BhHrAxD~AtEb@|@xAtBpBlBzCbB`AZhIhBrFpA|AZl@HRDLENGXORe@DKJSf@wD`@cDt@}INq@ZuEt@mHfBsN~BkS`CmR\\eDnAiKzAcM`CePNmAhAsGXmArAgFtDsM|DaOh@sC^kCf@kDb@uDl@kI\\sHn@yM?gDEoAOsA[}BUiBUsC@qCNuBViBrCcPp@oGHW|@oPBuDI_DKqAy@wD{Ja^}@oFY_CWoDIqBGqEBsENqE`C{^JuA\\aDj@oDn@cDxAcFz@yBtC{Fp@eAn@_An@s@t@}@j@g@bCaBtCsA`GiAzBm@`C}@jBmA~CiC~DcDjCwAfAa@bBe@nBa@pCYlCArDBlCHhCGnC_@~A]vBk@hAa@lF_CnMaGbDeArD}@vB[zEe@jFS`GFfBFxBJzO\\zZfAfCJdEPbDNvDRnEHvD?tEE~BQhC[zAYnCu@bA]dBm@bIkDtBy@bAYhB[rDYxJ[nB@vAHfBLbCf@|C~@vAp@nCdB|A`A`CzApAr@|Al@rBl@bBZbUbCZBzBDvBEtAMnF_AvB[vBOlCAlBFnBXbDr@~Bv@z@`@bBfAdD~BtB`Bv@f@nAn@x@ZZJ~A\\dBTdADtBEbAGnEg@dFi@`DYdDQdF?|DNfCV`BTlCl@dNvD`HnBdLvClAZn@DzB^hCRd@?fA?|@Ih@O`@Ud@a@h@w@\\u@Pm@Lw@HoBq@qK]eLUcIE{DC{AD}Fn@eSLeCJs@RwFRkDf@sCj@aE`AsFhAuGh@gDt@wEp@}En@_FPeBRkDByBCgBEgAS}B{@oEsA}Dy@eCi@yBGq@?s@Ds@V}@Rg@r@u@ZOj@Ml@Az@PrA^fBb@j@HV@f@e@`B}AbB_B]Ie@KeASiO}CmH_B{L}Bk@QTqBTgCAm@g@kCSaAs@V{CdAmDrAuAh@{@Ra@H{@D{Af@wBt@gAb@]ReBl@"
df_line <- decode_pl(pl)
set.seed(123)
df_line$weight <- runif(nrow(df_line), min = 1, max = 100)

## ------------

## plot the map
output$myMap <- renderGoogle_map({

google_map(key = map_key, data = df_line, search_box = F) %>%
  add_heatmap(weight = "weight") %>%
    add_traffic()

  })

}

shinyApp(ui, server)

这篇关于R Shiny Leaflet javascript插件-热图的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆