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。例如，我想在用户单击时发送警报在多边形上。

我有一些黑客代码可以做到这一点，但我希望有一种干净的方法来做到这一点。我正在寻找一种从 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中

$(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);
    }
}

但这对于您在纯 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方法，我们可以向每个多边形层添加点击功能（另请参阅此相关答案）：

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)