Subset data based on leaflet click action in a shiny app

Question

Im trying to subset the df dataframe based on the click of the selected county in the leaflet map above but I get an empty table.

library(shiny)
library(leaflet)
library(sp)
library(rgdal)  # Make sure you have this package installed

# Sample dataframe (replace this with your actual data)
df <- data.frame(
  Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
  Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
  Year = c(2008, 2008, 2008, 2008, 2008, 2008),
  Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
  Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
  Numerator = c(NA, 2618, 124, 0, 0, 13),
  Denominator = c(NA, 532102, 20483, 11, 295, 2466),
  Rate = c(60.3, 49.2, 60.5, 0.0, 0.0, 52.7)
)


# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

ui <- fluidPage(
  titlePanel("County Rate Map"),
  leafletOutput("map"),
  dataTableOutput("dt")
)

server <- function(input, output, session) {
  
  # Merge the USA polygon data with the dataframe
  merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
  
  
  #calls map
  output$map<-renderLeaflet({
    # Load your data for the choropleth
    #data <- read.csv("your_data.csv")  # Replace with the path to your data file
    
    # Merge the data with the US states geojson data
    #merged_data <- merge(us_states, data, by.x = "state", by.y = "State", all.x = TRUE)
    temp <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
    
    # Determine the maximum value excluding NA values
    max_value <- max(temp$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
    
   
    leaflet(temp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label =  lapply(
          paste0(
            "County: ", temp$County, "<br>",
            "Rate: ",temp$Rate, "<br>",
            "Denominator: ", temp$Denominator,"<br>",
            "Numerator:",temp$Numerator
          ),
          HTML
        ),
        labelOptions = labelOptions(
          style = list("font-weight" = "normal"
                       , padding = "3px 8px"
                       , textsize = "15px"
                       , direction = "auto" ))
      ) %>%
      addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
                position = "bottomright")
  })
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    click_county <- input$map_click
    if (is.null(click_county)) {
      return(NULL)
    } else {
      clicked_county <- click_county$id
      subset(df, Geography == clicked_county)
    }
  })
  output$dt<-renderDataTable({
    selected_county_data()
  })
}

shinyApp(ui, server)

Answer 1

You have three issues.

1. You need to use layerId = temp$NAME_2 to set the id.
2. You need to use input$map_shape_click instead of 'input$map_click`.
3. As there are multiple states with counties of same name (Orange is in CA, NJ & NY at the least), use state also while merging data.

Try this

library(shiny)
library(leaflet)
library(sp)
library(rgdal)  # Make sure you have this package installed
library(raster)

# Sample dataframe (replace this with your actual data)
df <- data.frame(
  Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
  Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
  State = c(rep("California",6)),
  Year = c(2008, 2008, 2008, 2008, 2008, 2008),
  Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
  Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
  Numerator = c(NA, 2618, 124, 0, 0, 13),
  Denominator = c(NA, 532102, 20483, 11, 295, 2466),
  Rate = c(60.3, 49.2, 60.5, 0.0, 0.0, 52.7)
)


# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

ui <- fluidPage(
  titlePanel("County Rate Map"),
  leafletOutput("map"),
  dataTableOutput("dt")
)

server <- function(input, output, session) {
  
  # Merge the USA polygon data with the dataframe
  merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))
  
  
  #calls map
  output$map<-renderLeaflet({
    # Load your data for the choropleth
    #data <- read.csv("your_data.csv")  # Replace with the path to your data file
    
    # Merge the data with the US states geojson data
    #merged_data <- merge(us_states, data, by.x = "state", by.y = "State", all.x = TRUE)
    # temp <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
    temp <- merged_data
    
    # Determine the maximum value excluding NA values
    max_value <- max(temp$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
    
    
    leaflet(temp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        layerId = temp$NAME_2,
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label =  lapply(
          paste0(
            "County: ", temp$NAME_2, "<br>",
            "Rate: ",temp$Rate, "<br>",
            "Denominator: ", temp$Denominator,"<br>",
            "Numerator:",temp$Numerator
          ),
          HTML
        ),
        labelOptions = labelOptions(
          style = list("font-weight" = "normal"
                       , padding = "3px 8px"
                       , textsize = "15px"
                       , direction = "auto" ))
      ) %>%
      addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
                position = "bottomright")
  })
  
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    # click_county <- input$map_click
    click_county <- input$map_shape_click
    
    # print(click_county)
    if (is.null(click_county)) {
      return(NULL)
    } else {
      clicked_county <- click_county$id
      subset(df, Geography == clicked_county)
    }
  })
  output$dt<-renderDataTable({
    selected_county_data()
  })
}

shinyApp(ui, server)