传单中的addMarkers函数不允许过滤数据

Question

我正在使用shinyapps中的传单库。我试图显示根据用户输入下拉选项保存为图标的标记。在下面的示例中，我无法根据用户输入过滤掉标记。当我仅使用没有闪亮的传单包运行时，类似的代码可以工作。

下面的示例代码位于Shiny的server.r中。

filteredData <- reactive({
    sampling_data[sampling_data$county == input$county_select, ]
    })

  theData <- filteredData()
    leafletProxy("mapData") %>%
      clearMarkers() %>%
      addMarkers(lng = sampling_data$lon,
                 lat = sampling_data$lat,
                 clusterOptions = markerClusterOptions())
  })

  output$mapData <- renderLeaflet({
    leaflet(sampling_data) %>%
      addProviderTiles(providers$Esri.WorldTopoMap) %>%
      setView(lng = -75, lat = 43, zoom = 6)
  })
  observe({
    theData <- filteredData()
    leafletProxy("mapData") %>%
      clearMarkers() %>%
      addMarkers(lng = sampling_data$lon,
                 lat = sampling_data$lat,
                 clusterOptions = markerClusterOptions())
  }) 

这段代码，没有闪亮，工作正常

  subsetData <- sampling_data %>%
  filter(county == "Albany")

  leaflet(subsetData) %>%
  addTiles() %>%
  addMarkers(lng = ~lon,
             lat = ~lat)

Answer 1

您只需要

leafletProxy

出现在您的

observe

块中即可。

library(shiny)
library(dplyr)
library(leaflet)

ui <- fluidPage(

  mainPanel(
    leafletOutput("map"),
    sliderInput("depth", "Depth",
                min = min(quakes$depth),
                max = max(quakes$depth),
                value = c(min(quakes$depth), max(quakes$depth))
    ),
    textOutput("value")
  )

)

server <- function(input, output) {

  filteredData <- reactive({

    quakes %>%
      filter(depth >= input$depth[1] & depth <= input$depth[2])

  })

  output$value <- renderText({paste("min: ", input$depth[1], " max: ", input$depth[2])})

  output$map <- renderLeaflet({

    leaflet(quakes) %>%
      fitBounds(~min(long),
                ~min(lat),
                ~max(long),
                ~max(lat))

  })

  observe({

    leafletProxy("map") %>%
      clearTiles %>%
      clearMarkers %>%
      addTiles %>%
      addMarkers(lng = filteredData()$long, lat = filteredData()$lat)

  })

}

shinyApp(ui = ui, server = server)