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

Question

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

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 代码可以做到这一点，但我希望有一个干净的方法来做到这一点。我正在寻找的是一种从 R 中定义看起来像 addPolygon(onClick = "alert('hello there')").

的东西的方法

明确地说，我不希望它通过服务器，我希望一切都在浏览器中发生。

它适用于以下 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 中构建传单时定义的内容来说，这似乎过于复杂：

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

在 R 中构建应用程序时，有没有办法在本地执行此操作？

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

谢谢，

科林

Answer 1

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

借助eachLayer method we can add an on-click function to each polygon layer (also see this related answer):

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)

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

R & Leaflet: how to bind a client-side event to a polygon

javascript

r

leaflet

shiny

r-leaflet