使用checkboxGroupInput进行交互式Shiny地图

时间:2019-12-25 16:43:21

标签: r shiny interactive r-leaflet

我正在尝试使用复选框组输入来过滤地图上的标记。

  titlePanel("Toronto Auto Thefts"),
  leafletOutput ("map", width = "100%", height = "100%"), 

  absolutePanel( 
                checkboxGroupInput("checkGroup", h3("Week Day"), 
                                   choices = list("Monday" = 1,
                                                  "Tuesday" = 2,
                                                  "Wednesday" = 3,
                                                  "Thursday" = 4,
                                                  "Friday" = 5,
                                                  "Saturday" = 6,
                                                  "Sunday" = 7),
                                   selected = 1))
)

用户界面部分似乎正常,因为该复选框显示正确。

server <- function(input, output, session){
  #filtered <- reactive({data[data$occurrencedayofweek != input$checkGroup]}) 


  output$map <- renderLeaflet({
    leaflet(data = data) %>%
      addTiles() %>%
      addMarkers()
  })

  observe ({
    proxy <- leafletProxy("map", data = data)
    proxy %>% clearMarkers ()
    if (data$occurrencedayofweek %in% input$checkGroup) {
      proxy %>% addMarker()}
    else {
      proxy %>% clearMarkers() %>% clearControls()}
  })
  }

我相信是引起问题的服务器,但是我不确定如何修复它。

1 个答案:

答案 0 :(得分:0)

这是我解决问题的方法。我无法正确调整您的代码 所以我重写了一部分。我认为很容易理解。此外,我还添加了示例数据(总是添加数据集的一部分的一种很好的做法)。

library(shiny)
library(leaflet)

# c("Monday","Tuesday","Wednesday", "Thursday", "Friday","Saturday","Sunday")

mydata <- data.frame(occurrencedayofweek = c(1:7),
                         longitude = c(10.47, 10.48, 10.49, 10.50,10.51, 10.52, 10.53),
                         latitude = c(45.76, 45.77, 45.78, 45.79, 45.80, 45.81, 45.82))

shinyApp(

ui <- fluidPage(

  leafletOutput ("map"),

  checkboxGroupInput("checkGroup", "Week Day",
                     choices = c("Monday" = 1,
                                    "Tuesday" = 2,
                                    "Wednesday" = 3,
                                    "Thursday" = 4,
                                    "Friday" = 5,
                                    "Saturday" = 6,
                                    "Sunday" = 7),
                     selected = 1)
),

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

  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(data = mydata,
                 ~longitude,
                 ~latitude,
                 group = "mygroup")
  })

  mydata_filtered <- reactive(mydata[mydata$occurrencedayofweek %in% input$checkGroup, ])

  observeEvent(input$checkGroup, {
    leafletProxy("map", data = mydata_filtered()) %>%
      clearGroup ("mygroup") %>%
      addMarkers(lng =  ~longitude,
                 lat = ~latitude,
                 group = "mygroup")
  })

 }

)