Не могу отфильтровать маркеры в RShiny на основе ввода пользователя - PullRequest
0 голосов
/ 21 февраля 2020

У меня проблема с моим приложением RShiny, не фильтрующим маркеры на карте Leaflet. Что я делаю неправильно? У меня проблемы с определением, почему это происходит. Я сделал то же самое, но другими способами, например, использовал переключатель, основанный на вводе $ df, для переключения наборов данных в прокси листовок.

Вот весь мой код

Пользовательский интерфейс:

ui <- fluidPage(
theme = shinytheme("superhero"),
tags$head(
    includeCSS("MarkerCluster.Default.css", "MarkerCluster.css"),

    includeScript("leaflet.markercluster-src.js"),

),

titlePanel("Map App"),
sidebarLayout(
    position = "right",
    sidebarPanel(
        h3("Options"),
        selectInput(
            "df",
            h5("Display facilities"),
            choices = list(
                "All" = 3,
                "Empty" = 2,
                "Non-empty" = 1
            ),
            selected = 3
        ),


    ),
    mainPanel(
        h3("Map demo with MarkerClusters"),
        tabsetPanel(
            type = "tabs",
            tabPanel(
                "Map",
                leafletOutput("map1", width = "100%", height = "764px"),

            ),
            tabPanel("Data", h4("Showing first 100 rows"), tableOutput("data"))
        )




    )
)
)

Сервер:

server <- function(input, output) {


output$map1 <- renderLeaflet({
    leaflet() %>%
        addTiles(attribution = "Map Demo") %>%
        setView(-98.5795, 39.828175, zoom = 3)
})

output$data <- renderTable({
    ds_comp2[1:100, ]
})





observe({
    filter <- reactive({

            switch(input$df,
                   "1" = ds_comp2[ds_comp2$empty == F,],
                   "2" = ds_comp2[ds_comp2$empty == T,],
                   "3" = ds_comp2[,]


            )})

    proxy <- leafletProxy("map1") %>%
                   clearMarkerClusters() %>%
                    clearMarkers() %>%



                   addMarkers(
                       clusterOptions = markerClusterOptions(),
                       data = filter(), 

                       popup = paste(
                           "<b>ZIP code:</b>",
                           ds_comp2$zip,
                           "<br>",
                           "<b>Type:</b>",
                           ds_comp2$type,
                           "<br>",
                           "<b>Group:</b>",
                           ds_comp2$group,
                           "<br>",
                           "<b>Empty?:</b>",!(ds_comp2$empty),
                           "<br>"
                       )
                   )
           })





}

shinyApp(ui = ui, server = server)

Редактировать:

заголовок данных

 type group empty   zip        lon      lat
1     1     3  TRUE 01913  -70.94279 42.85258
2     0     3  TRUE 92708 -117.96005 33.71688
3     1     3 FALSE 97402 -123.22592 44.04315
4     0     3  TRUE 02109  -71.04829 42.36606
5     0     1 FALSE 92626 -117.90732 33.68341
6     0     2  TRUE 94103 -122.40992 37.77264
7     1     2  TRUE 21801  -75.63245 38.40015
8     0     2  TRUE 10011  -74.00945 40.74650
9     1     2 FALSE 78701  -97.74439 30.27292
10    1     2 FALSE 99019 -117.06447 47.63483

1 Ответ

0 голосов
/ 21 февраля 2020

Кажется, это работает для меня. Будет leafletProxy отдельно в observe и filter будет отдельным reactive блоком. Похоже, маркеры карты обнаружены на основе отфильтрованных данных. Дайте мне знать, если это работает для вас.

server <- function(input, output) {

  output$map1 <- renderLeaflet({
    leaflet() %>%
      addTiles(attribution = "Map Demo") %>%
      setView(-98.5795, 39.828175, zoom = 3)
  })

  output$data <- renderTable({
    ds_comp2[1:100, ]
  })

  filter <- reactive({
      switch(input$df,
             "1" = ds_comp2[ds_comp2$empty == F,],
             "2" = ds_comp2[ds_comp2$empty == T,],
             "3" = ds_comp2[,]
      )
  })

  observe({
    proxy <- leafletProxy("map1") %>%
       clearMarkerClusters() %>%
       clearMarkers() %>%
       addMarkers(
         clusterOptions = markerClusterOptions(),
         data = filter(),
          popup = paste(
            "<b>ZIP code:</b>",
            ds_comp2$zip,
            "<br>",
            "<b>Type:</b>",
            ds_comp2$type,
            "<br>",
            "<b>Group:</b>",
            ds_comp2$group,
            "<br>",
            "<b>Empty?:</b>",!(ds_comp2$empty),
            "<br>"
          )
      )
  })
}
...