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

Posted 2023-03-24

【中文标题】R & Leaflet：如何将客户端事件绑定到多边形

【英文标题】：R & Leaflet: how to bind a client-side event to a polygon

【发布时间】：2022-01-14 01:19:57

【问题描述】：

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

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

谢谢，

科林

【问题讨论】：

也许您可以使用htmlwidgets::onRender 传递JS - here 和here 是一些示例。

【参考方案1】：

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

借助eachLayer 方法，我们可以为每个多边形图层添加点击功能（另见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)

【讨论】：

非常感谢！很抱歉迟到了