Search code examples
javascriptrshinyr-leaflet

How to bind a client-side event to a polygon?

Here is a shiny app:

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)

I want to bind an event on click on each polygon, but I want it to happen from the client-side only, I don't want it to go through R. For example, I would like to send an alert when the user click on the polygon.

I've got some hacky code that does that, but I would love to have a clean way to do it. What I'm looking for is a way to define from R something that would look like addPolygon(onClick = "alert('hello there')").

To be clear I don't want this to go through the server, I want everything to happen in the browser.

It works with the following JS code (in 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);
    }
}

Then in 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)

But that seems overly complicated for something you would define as such when building the leaflet in pure JS:

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

Is there a way to natively do it when building the app in R?

I've built a reprex of my current code here: https://github.com/ColinFay/leaflet-shiny-click-event

Solution

  • As mentioned in the comments we can use htmlwidgets::onRender to pass custom JS code.

    With the help of the 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)

    result