r - 如何在 Shiny 的应用程序中正确清除传单中的形状

Question

请注意，此问题已发布 at the R Shiny Google Group :

遵循Leaflet for R/ Shiny Integration documentation ，我使用 leafletProxy 函数得到了不需要的/意外的行为。

在下面的应用程序中，我希望圆圈标记随着 input$choices 的变化而出现/消失。

响应式(Reactive) df“filteredData”似乎工作正常。

我是否错误地使用了 leafletProxy() 或clearShapes()？

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


my_df <- data.frame(lat = 34.72 + rnorm(1000, sd = .18), 
                    lng = -92.5 + rnorm(1000, sd = .33), 
                    category = c(rep("A", 300), rep("B", 300), rep("C", 400)))

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", height = '100%', width = '100%'),
  absolutePanel(top = 10, right = 10, 
                checkboxGroupInput("choices", "Choices", choices =     list("A","B","C"), selected = c("A","B","C")),
                verbatimTextOutput("my_rows")


  )
)


server <- function(input, output) {

  filteredData <- reactive( my_df %>% filter(category %in% input$choices) )

    output$map <- renderLeaflet({ leaflet() %>% addTiles() %>% setView(lat =     34.72, lng = -92.5, zoom = 9) })

    observe({

      leafletProxy("map", data = filteredData()) %>% clearShapes() %>% addCircleMarkers(radius = 6, weight = 1, fillColor = "red", fillOpacity = 0.3)

    })

    output$my_rows <- renderPrint({ filteredData() %>% nrow() })
}

shinyApp(ui = ui, server = server)

Answer 1

您的第一个问题可以通过使用 clearMarkers() 而不是 clearShapes() 来解决。

至于您指出的另一个问题，leaflet 与空(和 NA)数据作斗争。当您取消选择所有值时，您的 data.frame 显然会变空。对此进行简单检查以阻止 leaflet 尝试绘制它即可解决此问题。

这里我使用 if - else 进行检查。

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

my_df <- data.frame(lat = 34.72 + rnorm(1000, sd = .18), 
                    lng = -92.5 + rnorm(1000, sd = .33), 
                    category = c(rep("A", 300), rep("B", 300), rep("C", 400)))

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", height = '100%', width = '100%'),
    absolutePanel(top = 10, right = 10, 
                 checkboxGroupInput("choices", "Choices"
                                     , choices = list("A","B","C")
                                     , selected = c("A","B","C")),
                 verbatimTextOutput("my_rows")
    )
)

server <- function(input, output) {

    filteredData <- reactive({ 
        my_df %>% filter(category %in% input$choices) 
        })

    output$map <- renderLeaflet({ 
        leaflet() %>% 
            addTiles() %>% 
            setView(lat = 34.72, lng = -92.5, zoom = 9) 
        })

    observe({

        df <- filteredData()

        ## check for empty dataframe
        if(nrow(df) == 0){
            leafletProxy("map", data = df) %>% 
            clearMarkers()
        }else{
            leafletProxy("map", data = df) %>% 
                clearMarkers() %>% 
                addCircleMarkers(radius = 6, weight = 1
                                 , fillColor = "red", fillOpacity = 0.3)
        }

    })

    output$my_rows <- renderPrint({ 
        filteredData() %>% 
            nrow() 
        })
}

shinyApp(ui = ui, server = server)