在 R Shiny 应用程序中检测 Leaflet 中的左键或右键单击

Question

我想在 Shiny Leaflet 对象中执行两个不同的操作，具体取决于在多边形上是右键单击还是左键单击。

我有两个初始化值为 1 的多边形。当用户在多边形上单击鼠标左键时，我希望增加 +1 的值，并在用户右键单击时减少 -1 的值。如果在 R Shiny 中无法右键单击，则可以双击左键。这里的目标是检测多边形上的两次不同的点击，以便之后有两个不同的操作。

我正在做的事情有一个可重现的例子：左键单击效果很好，多边形的值在左键单击时递增。 现在我想让注释的代码正常工作，以便右键单击时减少。

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)

Answer 1

我终于找到了一种方法，也许不是最好的，因为我不习惯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)