Last active
February 26, 2016 05:15
-
-
Save byzheng/83fd3fcff9e3614e8b82 to your computer and use it in GitHub Desktop.
leafletProxy
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) | |
library(leaflet) | |
library(RColorBrewer) | |
ns_map <- function(id) { | |
ns <- NS(id) | |
tagList( | |
leafletOutput(ns("map"), width = "100%", height = "100%"), | |
absolutePanel(top = 10, right = 10, | |
sliderInput(ns("range"), "Magnitudes", min(quakes$mag), max(quakes$mag), | |
value = range(quakes$mag), step = 0.1 | |
), | |
selectInput(ns("colors"), "Color Scheme", | |
rownames(subset(brewer.pal.info, category %in% c("seq", "div"))) | |
), | |
checkboxInput(ns("legend"), "Show legend", TRUE) | |
)) | |
} | |
ui <- bootstrapPage( | |
tags$style(type = "text/css", "html, body {width:100%;height:100%}"), | |
ns_map('ns_map') | |
) | |
server_map <- function(input, output, session) { | |
# Reactive expression for the data subsetted to what the user selected | |
filteredData <- reactive({ | |
quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],] | |
}) | |
# This reactive expression represents the palette function, | |
# which changes as the user makes selections in UI. | |
colorpal <- reactive({ | |
colorNumeric(input$colors, quakes$mag) | |
}) | |
output$map <- renderLeaflet({ | |
# Use leaflet() here, and only include aspects of the map that | |
# won't need to change dynamically (at least, not unless the | |
# entire map is being torn down and recreated). | |
leaflet(quakes) %>% addTiles() %>% | |
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) | |
}) | |
# Incremental changes to the map (in this case, replacing the | |
# circles when a new color is chosen) should be performed in | |
# an observer. Each independent set of things that can change | |
# should be managed in its own observer. | |
observe({ | |
pal <- colorpal() | |
leafletProxy("ns_map-map", data = filteredData()) %>% | |
clearShapes() %>% | |
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777", | |
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag) | |
) | |
}) | |
# Use a separate observer to recreate the legend as needed. | |
observe({ | |
proxy <- leafletProxy("ns_map-map", data = quakes) | |
# Remove any existing legend, and only if the legend is | |
# enabled, create a new one. | |
proxy %>% clearControls() | |
if (input$legend) { | |
pal <- colorpal() | |
proxy %>% addLegend(position = "bottomright", | |
pal = pal, values = ~mag | |
) | |
} | |
}) | |
} | |
server <- function(input, output, session) { | |
callModule(server_map, 'ns_map') | |
} | |
shinyApp(ui, server) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment