rshinyspatialr-leaflet

Detect left or right click in Leaflet in a R Shiny App


I would like to have two distincts actions in a Shiny Leaflet object, depending on if there is a right click or a left click on a polygon.

I have two polygons initialized with a value of 1. I would like to incremente the value of +1 when the user does a left click on the polygon, and decremente the value of -1 when the user does a right click. If the right click is not possible in R Shiny, it could be a double left click. The goal here is to detect two different clicks on a polygon, in order to have two differents actions after.

There is a reproductible example of what I am doing : the left click is doing well, the value of the polygon is incrementing on left click. Now I would like to make the commented code working, for the decrementation on right click.

library(shiny)
library(leaflet)
library(sp)

## create two square polygons
Sr1 <- Polygon(cbind(c(1, 2, 2, 1, 1), c(1, 1, 2, 2, 1)))
Sr2 <- Polygon(cbind(c(2, 3, 3, 2, 2), c(1, 1, 2, 2, 1)))
Srs1 <- Polygons(list(Sr1), "s1")
Srs2 <- Polygons(list(Sr2), "s2")
SpP <- SpatialPolygons(list(Srs1, Srs2), 1:2)


ui <- fluidPage(
  titlePanel("Left or right click"),
  sidebarLayout(
    sidebarPanel(),
    mainPanel(
      leafletOutput("myMap")
    )
  )
)

server <- function(input, output) {
  ## Polygon data
  SPDF <- reactiveValues(
    df = SpatialPolygonsDataFrame(SpP, data = data.frame(
      ID = c(1, 2),
      display = c(1, 1)
    ), match.ID = FALSE)
  )

  ## generate leaflet output with two simple polygons
  output$myMap <- renderLeaflet({
    SpDf <- SPDF$df
    leaflet(options = leafletOptions( zoomControl = FALSE, minZoom = 6.2, maxZoom = 6.2, dragging = FALSE)) %>%
      addPolygons(
        data = SpDf,
        label = as.character(SpDf$display),
        layerId = SpDf$ID,
        labelOptions = labelOptions(noHide = T, textOnly = T, textsize = "15px", direction = "center")
      )
  })

  ## incremente when left click : OK
  observeEvent(input$myMap_shape_click, {
    SpDf <- SPDF$df
    SpDf$display[SpDf$ID == input$myMap_shape_click$id] <- SpDf$display[SpDf$ID == input$myMap_shape_click$id] + 1
    SPDF$df <- SpDf
  })

  ## decremente when right click (or double click if right click not possible) : HOW ?
  # observeEvent(input$??????,{
  #     SpDf <- SPDF$df
  #     # incremente when left click
  #     SpDf$display[SpDf$ID == input$myMap_shape_click$id] <- SpDf$display[SpDf$ID == input$myMap_shape_click$id] - 1
  #     SPDF$df <- SpDf
  # })
}

shinyApp(ui = ui, server = server)

Solution

  • I finally found a way to do it, maybe not the best because I am not used to Javascript ...

    library(shiny)
    library(leaflet)
    library(sp)
    library(shinyjs)
    
    ## create two square polygons
    Sr1 <- Polygon(cbind(c(1, 2, 2, 1, 1), c(1, 1, 2, 2, 1)))
    Sr2 <- Polygon(cbind(c(2, 3, 3, 2, 2), c(1, 1, 2, 2, 1)))
    Srs1 <- Polygons(list(Sr1), "s1")
    Srs2 <- Polygons(list(Sr2), "s2")
    SpP <- SpatialPolygons(list(Srs1, Srs2), 1:2)
    
    
    ui <- fluidPage(
      titlePanel("Left or right click"),
      useShinyjs(),
      sidebarLayout(
        sidebarPanel(),
        mainPanel(
          leafletOutput("myMap"),
          tags$script(
            "$(function(){
                $(myMap).on('contextmenu', 'path', function (e) {
                  e.preventDefault();
                  // get class name
                  var id = $(e.currentTarget).attr('class').match(/id-\\d+/)[0];
                  var right_click = {'count':Math.random(), 'id':id};
                  Shiny.setInputValue('right_click', right_click);
                });
              });"
          )
        )
      )
    )
    
    server <- function(input, output) {
      ## Polygon data
      SPDF <- reactiveValues(
        df = SpatialPolygonsDataFrame(SpP, data = data.frame(
          ID = paste0("id-", 1:2),
          display = c(1, 1)
        ), match.ID = FALSE)
      )
    
      ## generate leaflet output with two simple polygons
      output$myMap <- renderLeaflet({
        SpDf <- SPDF$df
        leaflet(options = leafletOptions(zoomControl = FALSE, minZoom = 6.2, maxZoom = 6.2, dragging = FALSE)) %>%
          addPolygons(
            data = SpDf,
            label = as.character(SpDf$display),
            layerId = SpDf$ID,
            options = pathOptions(className = SpDf$ID), # give a CSS class per polygon so it can be get by JS
            labelOptions = labelOptions(noHide = T, textOnly = T, textsize = "15px", direction = "center")
          )
      })
    
      ## incremente when left click : OK
      observeEvent(input$myMap_shape_click, {
        SpDf <- SPDF$df
        SpDf$display[SpDf$ID == input$myMap_shape_click$id] <- SpDf$display[SpDf$ID == input$myMap_shape_click$id] + 1
        SPDF$df <- SpDf
      })
    
      ## decremente when right click
      observeEvent(input$right_click, {
        SpDf <- SPDF$df
        # incremente when left click
        SpDf$display[SpDf$ID == input$right_click$id] <- SpDf$display[SpDf$ID == input$right_click$id] - 1
        SPDF$df <- SpDf
      })
    }
    
    shinyApp(ui = ui, server = server)