This is an example Shiny app to use a dynamic Leaflet map like a selectInput. To run the app, install the necessary packages then enter the command shiny::runGist('4988b5164258917687cb')
.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(shiny) | |
# requires the dev version of leaflet; devtools::install_github('rstudio/leaflet') | |
library(leaflet) | |
library(tigris) | |
library(sp) | |
# Using counties in Washington here from the tigris package; any spatial data frame in WGS84 | |
# will do! (Also NAD83 works fine, that's what the Census shapefiles use) | |
wa <- counties('WA', cb = TRUE, resolution = '20m') | |
ui <- fluidPage( | |
titlePanel("Leaflet map as selectInput"), | |
sidebarLayout( | |
sidebarPanel( | |
selectInput('county', | |
'Select a county:', | |
# Using the county name as the common ID here; be sure | |
# to keep this consistent across your app | |
choices = sort(wa$NAME), | |
selected = 'King'), | |
leafletOutput('map') | |
), | |
mainPanel( | |
verbatimTextOutput('expression') | |
) | |
) | |
) | |
server <- function(input, output, session) { | |
# Here, grab a single county based on user input | |
selected_county <- reactive({ | |
s <- wa[wa$NAME == input$county, ] | |
return(s) | |
}) | |
output$map <- renderLeaflet({ | |
wamap <- leaflet() %>% | |
addProviderTiles('CartoDB.Positron') %>% | |
# First add all of the counties... | |
addPolygons(data = wa, weight = 1, smoothFactor = 0.2, color = '#00008B', | |
fillColor = '#00008B', label = ~NAME, | |
layerId = ~NAME) %>% | |
# ... then superimpose the outline of the selected county in a different color - I'm using yellow. | |
addPolygons(data = selected_county(), fill = FALSE, color = '#FFFF00', | |
opacity = 1, layerId = 'sel_cty') %>% | |
# Zoom to the bounds of the selected county | |
fitBounds(lng1 = bbox(selected_county())[1], | |
lat1 = bbox(selected_county())[2], | |
lng2 = bbox(selected_county())[3], | |
lat2 = bbox(selected_county())[4]) | |
wamap | |
}) | |
# Get the ID of the clicked county. The returned ID will be | |
# the layerId specified in the first addPolygons call - in this | |
# case the value of the NAME field for the clicked county. | |
county_click <- eventReactive(input$map_shape_click, { | |
x <- input$map_shape_click | |
y <- x$id | |
return(y) | |
}) | |
# Here, we update our drop-down menu based on the county clicked. | |
observe({ | |
updateSelectInput(session, 'county', selected = county_click()) | |
}) | |
# Here, we generate a new map based on the county click. We remove the old | |
# highlighted county, then add the new one using the same styling we did before. | |
observe({ | |
wamap <- leafletProxy('map', session) %>% | |
removeShape('sel_cty') %>% | |
addPolygons(data = selected_county(), fill = FALSE, color = '#FFFF00', | |
opacity = 1, layerId = 'sel_cty') %>% | |
fitBounds(lng1 = bbox(selected_county())[1], | |
lat1 = bbox(selected_county())[2], | |
lng2 = bbox(selected_county())[3], | |
lat2 = bbox(selected_county())[4]) | |
}) | |
# This is just an example of the output that can be generated. | |
# As you've changed the value for NAME - in this case the | |
# name of the county - it could be passed to a reactive expression to subset another | |
# dataset by county and then create a custom county plot. | |
output$expression <- renderPrint({ | |
paste0('You clicked on ', input$county, '! Pass me to a reactive expression!') | |
}) | |
} | |
# Run the application | |
shinyApp(ui = ui, server = server) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment