R leaflet和shiny：如何清除地图上的点击数据

Question

下面的示例取自 RStudio教程关于leaflet的部分。我稍微修改了一下，以适应我的问题。

我有一个地图（这里是地震），我使用addCircleMarkers在地图上绘制，并单击时弹出一个弹出窗口显示一些信息。在我的实际应用程序中，我想要做的是当单击地图上的标记时，过滤页面上的其他图表，只显示与该标记相关的数据。我知道如何获取用户单击位置的信息，使用input$map_marker_click - 这将为我提供纬度和经度，这对我的需求足够了。然而-一旦设置，此值就不会更改。当用户在非标记区域单击地图时，它不会恢复为NULL。我如何检测用户是否单击了地图上除标记以外的其他内容，并将input$map_marker_click重置为NULL 下面的示例没有其他图表，但我让它显示了input$map_marker_click的值。

library(shiny)
library(leaflet)
library(RColorBrewer)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
                            value = range(quakes$mag), step = 0.1
                ),
                selectInput("colors", "Color Scheme",
                            rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                ),
                checkboxInput("legend", "Show legend", TRUE),
                verbatimTextOutput("clickInfo")
  )
)

server <- function(input, output, session) {

  output$clickInfo = renderPrint({input$map_marker_click})

  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })

  colorpal <- reactive({
    colorNumeric(input$colors, quakes$mag)
  })

  output$map <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  observe({
    pal <- colorpal()
    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircleMarkers(radius = ~mag^2/3, weight = 1, color = "#777777",
                 fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  observe({
    proxy <- leafletProxy("map", data = quakes)
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",
                          pal = pal, values = ~mag
      )
    }
  })
}

shinyApp(ui, server)

- Mark

Answer 1

我在这里提过同样的问题，用户NicE在那里提供了一个解决方案。

如果有人在这个页面上寻找解决方案，下面的代码实现了上述请求，在单击标记后单击地图时将单击值重置为NULL。 示例中唯一额外的代码在#之间的两行之间。

library(shiny)
library(leaflet)
library(RColorBrewer)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
                            value = range(quakes$mag), step = 0.1
                ),
                selectInput("colors", "Color Scheme",
                            rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                ),
                checkboxInput("legend", "Show legend", TRUE),
                verbatimTextOutput("clickInfo")
  )
)

server <- function(input, output, session) {

  #########################################################

  data <- reactiveValues(clickedMarker=NULL)

  observeEvent(input$map_marker_click,
               {data$clickedMarker <- input$map_marker_click})

  observeEvent(input$map_click,
               {data$clickedMarker <- NULL})

  output$clickInfo <- renderPrint({data$clickedMarker})

  ##########################################################

  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })

  colorpal <- reactive({
    colorNumeric(input$colors, quakes$mag)
  })

  output$map <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  observe({
    pal <- colorpal()
    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircleMarkers(radius = ~mag^2/3, weight = 1, color = "#777777",
                       fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  observe({
    proxy <- leafletProxy("map", data = quakes)
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",
                          pal = pal, values = ~mag
      )
    }
  })
}

shinyApp(ui, server)

- E Keith