R小冊子和有光澤如何清除地圖點擊數據

Question

以下示例摘自the RStudio tutorial小冊子。我稍微修改它以適應我的問題。

我有一張地圖（這裏，地震），我使用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) 

值

Answer 1

我問過同樣的問題here，用戶NicE在那裏提供了一個解決方案。

如果有人遇到此頁面尋找解決方案，下面的代碼實現了上述請求，當點擊標記後單擊地圖時將點擊值重置爲NULL。該示例中唯一的附加代碼位於兩行#s之間。

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)