How to Get Data from Clicking on Polygon on Leaflet Map

shiny
1

Hello,

I am working on an elections dashboard where I will have an user select a state, have that state show up on a map, and then allow the user to click on a county on the map and have voting stats show up above the map.

Here is my code so far:

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(leaflet)
library(raster)
library(stringr)


state_name=c('Delaware','Delaware','Delaware','Delaware','Delaware','Delaware')
fips=c(10001,10003,10005,10001,10003,10005)
county_name=c('Kent County','New Castle County','Sussex County','Kent County','New Castle County','Sussex County')
dem_votes=c(33347,162905,39329,44552,195034,56682)
gop_votes=c(36989,85507,62607,41009,88364,71230)
year=c(2016,2016,2016,2020,2020,2020)

Delaware=as.data.frame(cbind(state_name,fips,county_name,dem_votes,gop_votes,year))

# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
USA$CountyName <- str_c(USA$NAME_2, ' ', USA$TYPE_2)

# Define UI for application
ui <- fluidPage(
    dashboardPage(
        dashboardHeader(title=""),
        dashboardSidebar(
            sidebarMenu(
                menuItem("State Results",
                         tabName = "sta_results",
                         icon=icon("map-marker-alt")
                )
            )
        ),
        dashboardBody(
            tabItems(
                tabItem(
                    tabName = "sta_results",
                    fluidRow(align='center',valueBoxOutput("vbox0",width=12)),
                    fluidRow(align="center",splitLayout(cellWidths = c("50%","50%"),
                                                        valueBoxOutput("vbox1",width=12),
                                                        valueBoxOutput("vbox2",width=12)
                                                        
                    )
                    ),
                    fluidRow(
                        align='center',leafletOutput("state_results")
                        )
                    )))))

# Define server logic 
server <- function(input, output) {
    
    #Prepare data
    temp <- merge(USA, Delaware,
                  by.x = c("NAME_1", "CountyName"),
                  by.y = c("state_name", "county_name"),
                  all.x = TRUE,
                  duplicateGeoms=TRUE)
    D_temp <-subset(temp,temp$NAME_1=="Delaware")
    D_temp <-subset(D_temp,D_temp$year==2020)
    
    Delaware <- subset(USA, USA$NAME_1=="Delaware")
    
    
    #Value Boxes
    output$vbox0 <- renderValueBox({
            valueBox(value = '[INSERT NAME] County Stats',
                     subtitle="",
                     color = "light-blue")
        })
    
    output$vbox1 <- renderValueBox({
        valueBox(value = '[INSERT VOTES]',
                 subtitle="Democratic Votes",
                 color = "light-blue")
    })
    
    output$vbox2 <- renderValueBox({
        valueBox(value = '[INSERT VOTES]',
                 subtitle="Republican Votes",
                 color = "light-blue")
    })

    output$state_results <-renderLeaflet({
        
        leaflet() %>% 
            addProviderTiles("OpenStreetMap.Mapnik") %>%
            addPolygons(data = Delaware, stroke = TRUE, weight = 1.0,
                        smoothFactor = 0.2, fillOpacity = 0.3,
                        popup = paste("County: ", D_temp$CountyName, "<br>",
                                      "Democratic Votes: ", D_temp$dem_votes, "<br>",
                                      "Republican Votes: ", D_temp$gop_votes, "<br>"))
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

I have been reading examples of how to get the data from the polygon on the click, but have not been able to piece it together properly. Can someone show me how I would populate the value boxes on my app? I want to be able to click on a polygon and get the county name and # of votes for each political party.

Any help would be appreciated!

Thank you!

2

See the input/events section here:

https://rstudio.github.io/leaflet/shiny.html#inputsevents

By the way, for your reprex above, getData() is from the raster package and str_c() is from stringr.

3

Note the layerId in the addPolygons().

To get the values, you would have a reactive dataset where you filter on rv$county.

Edit: Done now.

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(leaflet)
library(raster)
library(stringr)
library(dplyr)

state_name=c('Delaware','Delaware','Delaware','Delaware','Delaware','Delaware')
fips=c(10001,10003,10005,10001,10003,10005)
county_name=c('Kent County','New Castle County','Sussex County','Kent County','New Castle County','Sussex County')
dem_votes=c(33347,162905,39329,44552,195034,56682)
gop_votes=c(36989,85507,62607,41009,88364,71230)
year=c(2016,2016,2016,2020,2020,2020)

Delaware=as.data.frame(cbind(state_name,fips,county_name,dem_votes,gop_votes,year))

# Get USA polygon data
# USA <- getData("GADM", country = "usa", level = 2)
USA$CountyName <- str_c(USA$NAME_2, ' ', USA$TYPE_2)

# Define UI for application
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title=""),
    dashboardSidebar(
      sidebarMenu(
        menuItem("State Results",
                 tabName = "sta_results",
                 icon=icon("map-marker-alt")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "sta_results",
          fluidRow(align='center',valueBoxOutput("vbox0",width=12)),
          fluidRow(align="center",splitLayout(cellWidths = c("50%","50%"),
                                              valueBoxOutput("vbox1",width=12),
                                              valueBoxOutput("vbox2",width=12)
                                              
          )
          ),
          fluidRow(
            align='center',leafletOutput("state_results")
          )
        )))))

# Define server logic 
server <- function(input, output, session) {
  
  # reactive text 
  rv <- reactiveValues()
  
  #Prepare data
  temp <- merge(USA, Delaware,
                by.x = c("NAME_1", "CountyName"),
                by.y = c("state_name", "county_name"),
                all.x = TRUE,
                duplicateGeoms=TRUE)
  D_temp <-subset(temp,temp$NAME_1=="Delaware")
  D_temp <-subset(D_temp,D_temp$year==2020)
  
  Delaware2 <- subset(USA, USA$NAME_1=="Delaware")
  
  
  #Value Boxes
  output$vbox0 <- renderValueBox({
    valueBox(value = paste(rv$county, 'Stats'),
             subtitle="",
             color = "light-blue")
  })
  
  # votes
  votes_dem <- reactive({
    req(rv$county)
    
    Delaware %>% 
      filter(county_name == rv$county,
             year == 2020) %>% 
      pull(dem_votes)
  })
  
  votes_gop <- reactive({
    req(rv$county)
    
    Delaware %>% 
      filter(county_name == rv$county,
             year == 2020) %>% 
      pull(gop_votes)
  })
  
  output$vbox1 <- renderValueBox({
    valueBox(value = votes_dem(),
             subtitle="Democratic Votes",
             color = "light-blue")
  })

  output$vbox2 <- renderValueBox({
    valueBox(value = votes_gop(),
             subtitle="Republican Votes",
             color = "light-blue")
  })
  
  output$state_results <-renderLeaflet({
    
    leaflet() %>% 
      addProviderTiles("OpenStreetMap.Mapnik") %>%
      addPolygons(data = Delaware2, stroke = TRUE, weight = 1.0,
                  smoothFactor = 0.2, fillOpacity = 0.3,
                  layerId = ~CountyName, 
                  popup = paste("County: ", D_temp$CountyName, "<br>",
                                "Democratic Votes: ", D_temp$dem_votes, "<br>",
                                "Republican Votes: ", D_temp$gop_votes, "<br>"))
  })
  
  # update county on map click
  observe({ 
    rv$county <- input$state_results_shape_click$id
    
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)
2 Likes
4

Thank you so much @williaml ! This is exactly what I was looking for!

If I wanted to have a default county show up before clicking on anything, like the first one alphabetically, how would I do that?

5

You could have an input that (like a select input) and update that based on the map click. The initially selected one would be the one shown.

Sort of like this: Select polygon by clicking on map, changing item selected via dropdown - #3 by williaml

6

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.