带有闪亮的交互式传单 - clearMarkers() 并设置新的

Question

我想用 Shiny 创建交互式传单地图。创建工作正常，但尽管 selectInput() 发生了变化并单击“开始！”旧标记不会被删除，也不会设置新标记。你能帮帮我吗？

操作系统： Windows 10 个 64 位 RStudio R 版本：R 版本 4.0.0

geocodes <- data.frame("customer" = c("John", "Ahmet", "Zara"),
                       "longitude" = c(8.71, 8.59, 8.98),
                       "latitude" = c(51.2, 51.3, 51.1))
# UI
ui <- dashboardPage(
  dashboardHeader(title = "CustomerLocation Dashboard"),
  dashboardSidebar(
    
    selectInput("account", label = "Account",
                choices = c(unique(geocodes$customer)),
                multiple = TRUE),
    
    actionButton("go", "Go!")

  ),

  
  dashboardBody(
    tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
    leafletOutput("mymap", height=1000)
  )
)
  

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

  reactiveDf <- reactive({
    if(is.null(input$account)){
      geocodes
    } else{
      geocodes[geocodes$customer %in% input$account,]
    }
  })
  
  
  output$mymap <- renderLeaflet({
    leaflet(geocodes) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })
  
  
  eventReactive(input$go,{
   leafletProxy("mymap", data = reactiveDf()) %>%
      clearShapes() %>%
      clearPopups() %>%
      clearMarkers() %>%
      addAwesomeMarkers(
        data = reactiveDf(),
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

}

shinyApp(ui, server)

Answer 1

我确定的三个修复：

c(unique(geocodes$customer)) 将此输入转换为 c(1,2,3)。当您稍后尝试通过 c(1,2,3) 对客户名称“John”、“Ahmet”和“Zara”进行子集时 - 这是不兼容的并且失败了。

 selectInput("account", label = "Account",
                choices = c(unique(geocodes$customer)),
                multiple = TRUE),

更改为：

selectInput("account", label = "Account",
                choices = unique(geocodes$customer),
                multiple = TRUE),

很遗憾，我不知道为什么 leafletProxy() 中的 clearMarkers() 不会像您期望的那样清除标记，而是将原始地图从 geocodes 渲染更改为 reactiveDf()（如果 input$account 为空，仍然 returns geocodes 数据框）似乎可以解决该问题。

output$mymap <- renderLeaflet({
    leaflet(geocodes) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

更改为：

output$mymap <- renderLeaflet({
    leaflet(reactiveDf()) %>%
      addProviderTiles("OpenStreetMap",
                       group = "OpenStreetMap"
      ) %>%
      addAwesomeMarkers(
        lng = ~longitude,
        lat = ~latitude,
        icon = customIcon,
        clusterOptions = markerClusterOptions(),
        label = ~customer,
        popup = ~popup
      )
  })

如果你愿意稍微改变架构：

使用observeEvent根据input$account重新定义geocodes并触发leafletProxy()。我想我们都错过了为 leafletProxy 创建反应式数据框的一些步骤，也许我们无法完全更改从初始 renderLeaflet 到 leafletProxy 的数据源？

observeEvent(input$go, {
    if(is.null(input$account)){
      geocodes = geocodes
    } else{
     geocodes = geocodes[geocodes$customer %in% input$account,]
    }
 leafletProxy("mymap") %>%
    clearShapes() %>%
    clearPopups() %>%
    clearMarkers() %>%
    addMarkers(
      data = geocodes,
      lng = ~longitude,
      lat = ~latitude,
      label = ~customer,
    )
  }
)

编辑：另一种选择是为每个标记层定义一个组，并调用 showGroup() 和 hideGroup() 来操作可视化显示的标记。

希望对您有所帮助

带有闪亮的交互式传单 - clearMarkers() 并设置新的

Interactive Leaflet with shiny - clearMarkers() and set new ones

r

shiny

shinydashboard

r-leaflet