代码之家 › 专栏 › 技术社区 › SeGa

单张-如何等待“地图形状”单击“仅”

r-leaflet mouseevent shiny r

SeGa · 技术社区 · 6 年前

使用 leaflet 鼠标事件,点击SeabFeFLE,也会触发对地图的点击,因此该示例中的绿色线条立即被绘制。

我怎样才能等待一个按钮的点击,删除点击的线,忽略地图点击,但当我点击地图(而不是一个地图),绿线显示?

或者我怎样才能得到 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)

1 回复 | 直到 6 年前

pieca 6 年前

您可以检查单击坐标并在中运行代码 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)