通過點擊圖例選擇或突出顯示地圖上的數據

Question

通過單擊Rshiny中的圖例，是否有任何方法在傳單地圖上選擇或突出顯示數據？ 示例代碼：

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

ui <- fluidPage(
    leafletOutput("map"), 
    p(), 
    actionButton("recalc", "New points") 
) 

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

    df = data.frame(x = rnorm(100), y = rexp(100, 2), z = runif(100)) 
    pal = colorBin('PuOr', df$z, bins = c(0, .1, .4, .9, 1)) 

    output$map <- renderLeaflet({ leaflet(df) %>% 
    addCircleMarkers(~x, ~y, color = ~pal(z)) %>% 
    addLegend(pal = pal, values = ~z) 
    }) 

} 

shinyApp(ui, server) 

Answer 1

最近更新（0.2）到mapedit包可以幫助：http://r-spatial.org/r/2017/06/09/mapedit_0-2-0.html

Answer 2

我接近，但現在已經沒有時間。但無論如何，我決定分享，也許別人看到了最後一步的解決方案。

到目前爲止它適用於圖例中任何矩形的第一次點擊。它不適用於任何下面的點擊，因爲地圖被重新繪製，並且onclick監聽器被刪除。我沒有找到一種方法來添加它們到目前爲止，...

它的一個hacky aprroach：我添加onclick監聽器的框，並決定通過R更新顏色，因爲我沒有看到在JS中的好方法。

library(shiny) 
library(leaflet) 
library(RColorBrewer) 
library(leafletGeocoderRshiny) 
library(shinyjs) 

colors <- c("#000000", "#222222", "#888888", "#FFFFFF") 

ui <- fluidPage(
    useShinyjs(), 
    leafletOutput("map"), 
    p(), 
    actionButton("recalc", "New points") 
) 

server <- function(input, output, session) { 
    global <- reactiveValues(colors = colors, 
          bins = c(0, .1, .4, .9, 1)) 

    observe({ 
    print(input$interval) 
    isolate({ 
     if(!is.null(input$interval)){ 
     lowerBound <- as.numeric(unlist(input$interval)) 
     global$colors <- colors 
     global$colors[which(global$bins == lowerBound)] <- "#FF0000" 
     } 
    }) 
    }) 

    session$onFlushed(function() { 
    runjs(" 
     var legendButton = document.getElementsByTagName('i') 
     var elem; var interval; 
     for (nr = 0; nr < legendButton.length; nr++) { 
     elem = legendButton[nr] 
     elem.onclick = function(e){ 
      console.log(e.target) 
      interval = e.target.nextSibling.nodeValue.split(' '); 
      Shiny.onInputChange('interval', interval[1]); 
     } 
     } 
    ") 
    }) 


    df = data.frame(x = rnorm(100), y = rexp(100, 2), z = runif(100)) 
    pal = reactive({ 
    colorBin(global$colors, df$z, bins = global$bins) 
    }) 

    output$map <- renderLeaflet({ leaflet(df) %>% 
     addCircleMarkers(~x, ~y, color = ~pal()(z)) %>% 
     addLegend(pal = pal(), values = ~z) 
    }) 

} 

runApp(shinyApp(ui, server), launch.browser = T)