Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
199 views
in Technique[技术] by (71.8m points)

r - How do I clear the markers on a leaflet map linked with a DT?

Based on this example https://travisknocherstats.com/posts/2020-05-18-linked-dt-datatable-with-leaflet-map-in-r-shiny/ it is possible to link DT and leaflet. Selected rows on DT are ploted on leaflet. I've made some modifications to be able to have a map by default ~markers ploted in red, then when the user select a row on DT, the marker on leaflet is highligted in blue.It works fine so far. 1- However, when the row is unselected on the DT the blue highlight still shows. How to solve this problem. 2 - Using the action button ~ Clear table selections ~ remove all the markers blues and reds. However, I just would like to make the blue highlight disapear still keeping my red markers.

my code below with reproducible example. Thank you

    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)
    })
    
  }
)
question from:https://stackoverflow.com/questions/65839216/how-do-i-clear-the-markers-on-a-leaflet-map-linked-with-a-dt

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

This solution here works as intended and gets rid of a lot of unnecessary 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)
   })
}
  • The idea is that you assign all manual clicks to a group, then you can easily delete the whole group via clearGroup instead of clearMarkers.
  • quakes will not change, so no need to make it reactive.
  • You can massively clean the observer for the row_selection

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...