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

mapedit包的最新更新（0.2）可能会有所帮助：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)

通过单击图例选择或突出显示地图上的数据

2 个答案: