Instantly share code, notes, and snippets.

@walkerke /README.md
Last active Mar 12, 2017

Embed
What would you like to do?

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').

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