R和Leaflet：如何将客户端事件绑定到多边形

Question

R和Leaflet：如何将客户端事件绑定到多边形

6

这是一个简单的闪亮应用程序：

library(shiny)
library(leaflet)
nc = sf::st_read(system.file("shape/nc.shp", package="sf"))

ui <- function(request){
  tagList(
    selectInput("color", "color", c("blue", "red", "green")),
    leafletOutput("map")
  )
}

server <- function(
  input, 
  output, 
  session
){

  output$map <- renderLeaflet({
    leaflet(nc) %>%
      addPolygons(color = input$color)
  })
}

shinyApp(ui, server)

我想在每个多边形上单击时绑定一个事件，但我希望它仅从客户端发生，不想通过 R 连接。例如，当用户单击多边形时，我想发送警报。

我有一些hacky代码可以实现这个功能，但我想要一种更简洁的方法。我要找的是一种定义方式，看起来像 addPolygon(onClick = "alert('hello there')")，并且可以从 R 中定义。

明确一点，我不希望这个过程经过服务器，我想要所有操作都在浏览器中进行。

下面是可行的 JS 代码（位于 ext/script.js）。

$(document).ready(function() {
    Shiny.addCustomMessageHandler('bindleaflet', function(arg) {
        $("#" + arg).find("path").remove();
        wait_for_path(arg);
    })
});

var wait_for_path = function(id) {
    if ($("#" + id).find("path").length !== 0) {
        $("#" + id).find(".leaflet-interactive").on("click", function(x) {
            alert("hey")
        })
    } else {
        setTimeout(function() {
            wait_for_path(id);
        }, 500);
    }
}

然后在R中

library(shiny)
library(leaflet)
nc = sf::st_read(system.file("shape/nc.shp", package="sf"))

ui <- function(request){
    tagList(
        tags$script(src = "ext/script.js"),
        selectInput("color", "color", c("blue", "red", "green")),
        leafletOutput("map")
    )
}

server <- function(
    input,
    output,
    session
){
    addResourcePath("ext", "ext")
    
    output$map <- renderLeaflet({
        session$sendCustomMessage("bindleaflet", "map")
        leaflet(nc) %>%
            addPolygons(color = input$color)
    })

}

shinyApp(ui, server)

但是，对于使用纯JS构建leaflet时，您将定义为此类内容似乎过于复杂：

onEachFeature: function(feature, layer) {
    layer.on({
        click: (function(ev) { alert('hey') } )

在 R 应用程序构建时是否有本地化的方法可以实现这一点？

我已经在这里构建了我的当前代码的 reprex：https://github.com/ColinFay/leaflet-shiny-click-event

谢谢，

Colin

- Colin FAY

也许你可以使用 htmlwidgets::onRender 来传递 JS - 这里是一些例子：这里和这里。 - ismirsehregal

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ismirsehregal · Accepted Answer

如评论中所述，我们可以使用htmlwidgets::onRender来传递自定义JS代码。

借助eachLayer方法，我们可以为每个多边形图层添加一个单击函数（也可以参考此相关答案）。

library(shiny)
library(leaflet)
nc = sf::st_read(system.file("shape/nc.shp", package="sf"))

ui <- function(request){
  tagList(
    selectInput("color", "color", c("blue", "red", "green")),
    leafletOutput("map")
  )
}

server <- function(
  input, 
  output, 
  session
){
  
  output$map <- renderLeaflet({
    leaflet(nc) %>%
      addPolygons(color = input$color) %>%
      htmlwidgets::onRender("
                            function(el, x) {
                              var map = this;
                              map.eachLayer(function(layer) {
                                if(layer instanceof L.Polygon && !(layer instanceof L.Rectangle) ){
                                  layer.on('click', function(e){
                                    alert('hey - you clicked on layer._leaflet_id: ' + layer._leaflet_id);
                                  })
                                  .addTo(map)
                                }
                              });
                            }
                            ")
  })
}

shinyApp(ui, server)