How can I filter a data table based on input from a Leaflet map?

Question

I am making a dashboard using shiny that will have a leaflet map and a data table. I would like to be able to click on a polygon from the map (i.e. a specific county), store the county as a reactive value, and then filter the data table to show only results for that county.

I would also like the data table to show all rows by default if no polygon is clicked, and to go back to showing all rows if the polygon is unselected.

Here is a basic working example I've created. I am able to click the map and get the correct county, but I seem to have a problem storing the value in click_county.

lapply(c('data.table','dplyr','ggplot2','shiny','shinydashboard','leaflet','DT',
         'USAboundaries','sf'), library, character.only = TRUE)

ca_counties <- USAboundaries::us_counties(states = 'CA')

parcels <- structure(list(county = c("Yuba", "Sacramento", "Inyo"), num.parcels = c(27797L, 
                                                                                    452890L, 6432L)), row.names = c(NA, -3L), class = "data.frame")

parcels <- st_as_sf(left_join(parcels, ca_counties[,c('name')], by = c("county" = "name")))
parcels_df <- parcels
parcels_df$geometry <- NULL

#====================================================================================================

ui <- dashboardPage(
  skin = 'green',
  dashboardHeader(),
  dashboardSidebar(sidebarMenu(
    menuItem('Use of Force Incidents', tabName = 'dallas_maps', icon = icon('city'))
  )),
  dashboardBody(tabItems(
    #===== Dallas Map Tab =====#
    tabItem(tabName = 'dallas_maps',
            fluidRow(
              box(
                width = 12, collapsible = T,
                title = 'Dallas County Census Block Groups',
                solidHeader = T, status = 'primary',
                leafletOutput('parcels_map')
              )
            ),
            fluidRow(
              box(
                width = 12, collapsible = T,
                title = 'Use of Force Incidents, 2014 - 2016',
                solidHeader = T, status = 'primary',
                dataTableOutput('parcels_table')
              )
            )
    )
  ))
)

#====================================================================================================

server <- function(input, output, session) {
  #===== Dallas Map Tab =====#
  # Map of Census block groups
  output$parcels_map <- renderLeaflet({
    bins <- c(1, 10000, 50000, 100000, 500000, 600000)
    pal <- colorBin("Blues", domain = parcels$num.parcels, bins = bins)
    
    labels <- sprintf(
      "<strong>%s County</strong><br/>
      Parcels: %g<br/>",
      parcels$county, parcels$num.parcels
      ) %>% lapply(htmltools::HTML)
    
    leaflet(parcels) %>%
      setView(-119, 37.9, 6) %>%
      addTiles() %>%
      addPolygons(
        layerId = ~county,
        fillColor = ~pal(num.parcels),
        weight = 2,
        opacity = 1,
        color = 'black',
        dashArray = '2',
        fillOpacity = 0.7,
        highlightOptions = highlightOptions(color = "red", weight = 3,
                                            bringToFront = TRUE),
        label = labels,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal", padding = "4px 8px"),
          textsize = "15px",
          direction = 'auto')) %>%
      addLegend(pal = pal, values = ~num.parcels, opacity = 0.7, title = "Number of Parcels",
                position = "bottomleft")
  })
  
  click_county <- reactiveVal()
  
  observeEvent(input$parcels_map_shape_click, {
    # Capture the info of the clicked polygon
    click_county <- input$parcels_map_shape_click$id
  })
  
  print(click_county)
  
  # Parcels data table
  output$parcels_table <- DT::renderDataTable({
    DT::datatable(parcels_df,
                  # colnames = c(''),
                  options = list(lengthMenu = c(10, 25, 50, 100),
                                 pageLength = 10,
                                 columnDefs = list(list(className = 'dt-center', targets = '_all'))),
                  filter = 'top')
  })
  
}

shinyApp(ui, server)

I have tried something like this for rendering the data table so I can get all rows by default and just the filtered rows upon clicking the map:

# Parcels data table
output$parcels_table <- DT::renderDataTable({
  if (is.null(click_county())) {
    DT::datatable(parcels_df,
                  options = list(lengthMenu = c(10, 25, 50, 100),
                                 pageLength = 10,
                                 columnDefs = list(list(className = 'dt-center', targets = '_all'))),
                  filter = 'top')
  }
  else if (!is.null(click_county())) {
    DT::datatable(parcels_df[parcels_df$county == click_county(),],
                  options = list(lengthMenu = c(10, 25, 50, 100),
                                 pageLength = 10,
                                 columnDefs = list(list(className = 'dt-center', targets = '_all'))),
                  filter = 'top')
  }
})

Answer 1

You need to use the syntax click_county(input$parcels_map_shape_click$id) to assign a value to reactiveVal.

Here, I remove filter by re-clicking on same county, as I could find the event of clicking outside of a county:

  observeEvent(input$parcels_map_shape_click, {
    # Capture the info of the clicked polygon
    if(!is.null(click_county()) && click_county() == input$parcels_map_shape_click$id)
      click_county(NULL)     # Reset filter
    else
      click_county(input$parcels_map_shape_click$id)
  })

  # Parcels data table
  output$parcels_table <- DT::renderDataTable({
    DT::datatable( 
      if(is.null(click_county())) 
        parcels_df    # Not filtered
      else 
        parcels_df %>% filter( county==click_county())
        )
  })