R 传单 - 如何仅等待 `map_shape_click`

Question

使用 leaflet 鼠标事件，单击 shapefile 也会触发单击 map ，因此示例中的绿线会立即绘制。

如何等待单击其中一个 shapefile，以删除单击的线并忽略 map 单击，但是当我单击 map (而不是 shapefile)时，会显示绿线？

或者我怎样才能只获得input$map_shape_click？

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

## DATA
x <- c(1,5,4,8); y <- c(1,3,4,7)
data = sp::SpatialLines(list(
  sp::Lines(sp::Line(cbind(x,y)), ID="a"),
  sp::Lines(sp::Line(cbind(rev(x)*1.1,y)), ID="b")), 
  CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))

data = SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)
data1 = SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)

## UI
ui = fluidPage(
  leafletOutput("map")
)

## SERVER
server <- shinyServer(function(input, output, session) {

  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(doubleClickZoom= FALSE)) %>% 
      addTiles() %>% 
      addPolylines(data = data, smoothFactor = 10, opacity = 1, color = "blue",
                   layerId = as.character(data$id),
                   highlightOptions = highlightOptions(color = "white",
                                                       weight = 5, bringToFront = F, opacity = 1)
      )
  })

  observeEvent(input$map_shape_click, {
    cat("Shape is Clicked \n")   
    proxy <- leafletProxy("map")
    proxy %>% removeShape("1")
  })

  observeEvent({ input$map_click }, {
    cat("Map Clicked \n")
    proxy <- leafletProxy("map")
    proxy %>%       addPolylines(data = data, smoothFactor = 10, opacity = 1, color = "green",
                                 layerId = as.character(data$id))

  })

})

shinyApp(ui, server)

Answer 1

您可以检查点击坐标并根据发现的重叠在 input$map_click 观察器中运行代码。代码如下:

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

## DATA
x <- c(1,5,4,8); y <- c(1,3,4,7)
data = sp::SpatialLines(list(
  sp::Lines(sp::Line(cbind(x,y)), ID="a"),
  sp::Lines(sp::Line(cbind(rev(x)*1.1,y)), ID="b")), 
  sp::CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))

data = sp::SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)
data1 = sp::SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)

## UI
ui = fluidPage(
  leafletOutput("map")
)

## SERVER
server <- shinyServer(function(input, output, session) {

  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(doubleClickZoom= FALSE)) %>% 
      addTiles() %>% 
      addPolylines(data = data, smoothFactor = 10, opacity = 1, color = "blue",
                   layerId = as.character(data$id),
                   highlightOptions = highlightOptions(color = "white",
                                                       weight = 5, bringToFront = F, opacity = 1)
      )
  })

  observeEvent({ input$map_click }, {

    coords <- input$map_click
    clicked <- sp::SpatialPoints(
      matrix(
        c(coords$lng, coords$lat),
        nrow = 1
      )
    )
    sp::proj4string(clicked) <- sp::CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
    compare <- rgeos::gIntersects(
      # verify if width parameter works for you
      rgeos::gBuffer(clicked, width = 0.5), 
      data, 
      byid = TRUE
    )

    if(any(compare)){
      cat("Shape is Clicked \n")  
      proxy <- leafletProxy("map")

      if(compare[1] == TRUE){
        proxy %>% removeShape("1")
      }
      if(compare[2] == TRUE){
        proxy %>% removeShape("2")
      }

    }else{
      cat("Map Clicked \n")
      proxy <- leafletProxy("map")
      proxy %>%       addPolylines(data = data, smoothFactor = 10, opacity = 1, color = "green",
                                   layerId = as.character(data$id))
    }

  })

})

shinyApp(ui, server)