如何清除与 DT 链接的传单地图上的标记？

Question

基于此示例https://travisknocherstats.com/posts/2020-05-18-linked-dt-datatable-with-leaflet-map-in-r-shiny/，可以链接 DT 和传单。 DT 上的选定行绘制在传单上。 我进行了一些修改，以便能够在默认情况下将地图绘制为红色〜标记绘制为红色，然后当用户在 DT 上选择一行时，传单上的标记以蓝色突出显示。到目前为止它工作正常。 1- 但是，当未选择 DT 上的行时，蓝色突出显示仍会显示。如何解决这个问题呢。 2 - 使用操作按钮〜清除表选择〜删除所有标记蓝色和红色。但是，我只是想让蓝色突出显示消失，仍然保留我的红色标记。

我的代码在下面带有可重现的示例。 谢谢

    require(shiny)
require(leaflet)
require(DT)
require(tidyverse)

shiny::shinyApp(
  ui = fluidPage(
    column(
      width = 3,
      br(),
      actionButton(
        "select_all_rows_button",
        "Select All Table Rows"
      ),
      br(),
      actionButton(
        "clear_rows_button",
        "Clear Table Selections"
      )
    ),
    column(
      width = 9,
      fluidRow(
        column(
          width = 12,
          solidHeader = TRUE,
          leafletOutput(
            "my_leaflet"
          )
        )
      ),
      fluidRow(
        column(
          width = 12,
          solidHeader = TRUE,
          DTOutput(
            "my_datatable"
          )
        )
      )
    )
  ),
  
  server = function(session, input, output) {
    
    quakes_r <- reactive({ as_tibble(quakes) })
    
    output$my_datatable <- renderDT({
      
      quakes_r() %>% 
        datatable()
      
    })
    
    
    # base map that we will add points to with leafletProxy()
    output$my_leaflet <- renderLeaflet({
      
      leaflet() %>% 
        addProviderTiles(
          provider = providers$CartoDB.Positron,
          options = providerTileOptions(
            noWrap = FALSE
          )
        ) %>% 
        addCircleMarkers(
          data = quakes_r(),
          lng = ~long,
          lat = ~lat,
          fillColor = "red",
          stroke = TRUE,
          color = "white",
          radius = 3,
          weight = 1,
          fillOpacity = 0.4
        )%>% 
        setView(
          lat = -25.5,
          lng = 178.58,
          zoom = 4
        )
      
    })
    
    observeEvent(input$my_datatable_rows_selected, {
      
      selected_lats <- eventReactive(input$my_datatable_rows_selected, {
        as.list(quakes_r()$lat[c(unique(input$my_datatable_rows_selected))])
      })
      
      selected_longs <- eventReactive(input$my_datatable_rows_selected, {
        as.list(quakes_r()$long[c(unique(input$my_datatable_rows_selected))])
      })
      
      selected_depths <- eventReactive(input$my_datatable_rows_selected, {
        as.list(quakes_r()$depth[c(unique(input$my_datatable_rows_selected))])
      })
      
      selected_mags <- eventReactive(input$my_datatable_rows_selected, {
        as.list(quakes_r()$mag[c(unique(input$my_datatable_rows_selected))])
      })
      
      selected_stations <- eventReactive(input$my_datatable_rows_selected, {
        as.list(quakes_r()$stations[c(unique(input$my_datatable_rows_selected))])
      })
      
      # this is the data that will be passed to the leaflet in the addCircleMarkers argument,
      # as well as the popups when the points are hovered over
      map_df <- reactive({
        tibble(lat = unlist(selected_lats()),
               lng = unlist(selected_longs()),
               depth = unlist(selected_depths()),
               mag = unlist(selected_mags()),
               stations = unlist(selected_stations()))
      })
      
      leafletProxy("my_leaflet", session) %>% 
        # clearMarkers() %>% 
        addCircleMarkers(
          data = map_df(),
          lng = ~lng,
          lat = ~lat,
          fillColor = "blue",
          stroke = TRUE,
          color = "white",
          radius = 3,
          weight = 1,
          fillOpacity = 0.4,
          popup = paste0("lat: ", map_df()$lat, "<br>",
                         "lng: ", map_df()$lng, "<br>",
                         "depth: ", map_df()$depth, "<br>",
                         "mag: ", map_df()$mag, "<br>",
                         "stations: ", map_df()$stations)
        )
      
    })
    
    # create a proxy to modify datatable without recreating it completely
    DT_proxy <- dataTableProxy("my_datatable")
    
    # clear row selections when clear_rows_button is clicked
    observeEvent(input$clear_rows_button, {
      selectRows(DT_proxy, NULL)
    })
    
    # clear markers from leaflet when clear_rows_button is clicked
    observeEvent(input$clear_rows_button, {
      clearMarkers(leafletProxy("my_leaflet", session))
    })
    
    # select all rows when select_all_rows_button is clicked
    observeEvent(input$select_all_rows_button, {
      selectRows(DT_proxy, input$my_datatable_rows_all)
    })
    
  }
)

Answer 1

这里的解决方案按预期工作，并消除了许多不必要的reactives/observer：

server = function(session, input, output) {
   
   quakes <- as_tibble(quakes)
   group_name <- "my_additons"
   
   output$my_datatable <- renderDT({
      quakes %>% 
         datatable()
   })
   
   
   # base map that we will add points to with leafletProxy()
   output$my_leaflet <- renderLeaflet({
      
      leaflet() %>% 
         addProviderTiles(
            provider = providers$CartoDB.Positron,
            options = providerTileOptions(
               noWrap = FALSE
            )
         ) %>% 
         addCircleMarkers(
            data = quakes,
            lng = ~long,
            lat = ~lat,
            group = "original",
            fillColor = "red",
            stroke = TRUE,
            color = "white",
            radius = 3,
            weight = 1,
            fillOpacity = 0.4
         ) %>% 
         setView(
            lat = -25.5,
            lng = 178.58,
            zoom = 4
         )
      
   })
   
   observe({
      sel <- quakes[input$my_datatable_rows_selected, ]
      leafletProxy("my_leaflet") %>% 
         clearGroup(group_name) %>%
         addCircleMarkers(
            data = sel,
            lng = ~long,
            lat = ~lat,
            group = group_name,
            fillColor = "blue",
            stroke = TRUE,
            color = "white",
            radius = 3,
            weight = 1,
            fillOpacity = 0.4,
            popup = ~ paste0("lat: ", lat, "<br>",
                             "lng: ", long, "<br>",
                             "depth: ", depth, "<br>",
                             "mag: ", mag, "<br>",
                             "stations: ", stations)
         )
   })
   
   
   
   # create a proxy to modify datatable without recreating it completely
   DT_proxy <- dataTableProxy("my_datatable")
   
   # clear row selections when clear_rows_button is clicked
   observeEvent(input$clear_rows_button, {
      selectRows(DT_proxy, NULL)
      leafletProxy("my_leaflet") %>% 
         clearGroup(group_name)
   })
   
   # select all rows when select_all_rows_button is clicked
   observeEvent(input$select_all_rows_button, {
      selectRows(DT_proxy, input$my_datatable_rows_all)
   })
}

• 想法是将所有手动点击分配给group，然后您可以通过clearGroup 而不是clearMarkers 轻松删除整个组。
• quakes 不会改变，所以不需要让它反应。
• 您可以为row_selection 大量清理observer