below is my code. I have a working map that zooms into each county when clicked on but I want the map to be shaded darker or lighter based on how many zip codes are in a certain place and the count of data in each state.
Any help would be much appreciated!
require(leaflet)
require(maps)
require(maptools)
require(sp)
require(rgeos)
zipdata=data2$LossZipCode
statedata=data2$LossStateAbbreviation
mapStates=map("state",fill=TRUE,plot=FALSE)
mapCounty=map("county",fill=TRUE,plot=FALSE)
shinyApp(
ui = fluidPage(leafletOutput('myMap'),
br(),
leafletOutput('myMap2')),
server <- function(input, output, session) {
#leafletOutput("myMap"),br(),leafletOutput("myMap2")
output$myMap=renderLeaflet({
leaflet()%>%
addProviderTiles("Stamen.TonerLite",options=providerTileOptions(noWrap=TRUE))%>%
addPolygons(lng=mapStates$x, lat=mapStates$y,fillColor=topo.colors(10,alpha=NULL),stroke=FALSE)
})
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
lat <- click$lat
lon <- click$lng
coords <- as.data.frame(cbind(lon, lat))
point <- SpatialPoints(coords)
mapStates_sp <- map2SpatialPolygons(mapStates, IDs = mapStates$names)
i <- point [mapStates_sp, ]
selected <- mapStates_sp [i]
mapCounty_sp <- map2SpatialPolygons(mapCounty, IDs = mapCounty$names)
z <- over(mapCounty_sp, selected)
r <- mapCounty_sp[(!is.na(z))]
output$myMap2 <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data=r,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
})
})
Related
I would like to make an interactive map in shiny, and filter as follows: first, select the name_region column, and then only the selected region will appear on the map. I would also like to have a way to optionally mark the state or municipality polygon. If nothing is checked, I would like all polygons to appear on the map.
Could someone help me with these first steps please?
library(shiny)
library(leaflet)
library(shinyWidgets)
library(sf)
library(geobr)
#Read states
SP <- read_state("SP",2019)
RJ <- read_state("RJ",2019)
PI <- read_state("PI",2019)
BA <- read_state("BA",2019)
#Read municipalities
SP_M <- read_municipality("SP",2019)
RJ_M <- read_municipality("RJ",2019)
PI_M <- read_municipality("PI",2019)
BA_M <- read_municipality("BA",2019)
#Rbind
States_all <- rbind(SP,RJ,PI,BA)
Mun_all <- rbind(SP_M,RJ_M,PI_M,BA_M)
#Transform coordinates
States_all <- st_transform(States_all, crs = 4326)
Mun_all <- st_transform(Mun_all, crs = 4326)
#UI
ui <- fluidPage(
leafletOutput("mymap"),
fluidPage(
selectInput("name_region", "Region", choices = unique(States_all$name_region))
))
#SERVER
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addScaleBar() %>%
addTiles() %>%
addPolygons(data=Mun_all,color = "blue", fillColor = "transparent",weight = 1,
smoothFactor = 0.5,opacity = 1.0,popup = ~as.character(name_muni)) %>%
addPolygons(data=States_all,color = "black",
fillColor = "transparent",weight = 1,smoothFactor = 0.5, opacity = 1.0,
popup = ~as.character(name_state))
})
observe({
leafletProxy("mymap") %>%
clearShapes()
})
}
#SHINYAPP
shinyApp(ui, server)
I would like to automatically detect which polygon is at the center of the map. And it should update dynamically when the user is moving through the map.
For the moment I could not find a way to reverse find on which polygon are some coordinates.
I think I could simulate a input$map_shape_click with shinyjs or javascript and so get input$map_shape_click$id, but before I go to this solution, I would like to make sure there is no other way.
Here is a minimal example
library(leaflet)
library(shiny)
# data source : https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds
cities <- readRDS(file = "../gadm36_FRA_2_sf.rds")
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities,layerId = ~NAME_2,label = ~NAME_2)
})
observeEvent(input$map_bounds,{
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east, input$map_bounds$west))
# how can I detect on which polygon the center is ?
})
}
shinyApp(ui = ui, server = server)
library(leaflet)
library(shiny)
library(sf)
cities <- readRDS(file = "gadm36_FRA_2_sp.rds") %>%
st_as_sf()
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities, layerId = ~NAME_2, label = ~NAME_2)
})
observeEvent(input$map_bounds, {
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east,
input$map_bounds$west))
pnt <- st_point(c(rv$center[2], rv$center[1]))
rslt <- cities[which(st_intersects(pnt, cities, sparse = FALSE)),]$NAME_1
print(rslt)
})
}
shinyApp(ui = ui, server = server)
So I found a way to do it with the function sf::st_intersects
observeEvent(input$map_bounds,{
rv$center <- data.frame(x = mean(c(input$map_bounds$north, input$map_bounds$south)),
y = mean(c(input$map_bounds$east, input$map_bounds$west)))
res <- sf::st_as_sf(rv$center, coords=c("y","x"), crs=st_crs(cities$geometry))
intersection <- as.integer(st_intersects(res, cities$geometry))
print(if_else(is.na(intersection), '', cities$NAME_2[intersection]))
})
I am still working on this R Leaflet self project to learn and I'm trying to color in some Polygons in the Wake County area of Raleigh, NC. Below is the image of what I am trying to color.
https://imgur.com/a/xdvNLvM
Basically I am trying to get each of those polygons colored differently. I've tried addPolygons but I guess I didn't have correct Polygon data. I've looked at color binning but I seem to be out of ideas. Below is my code. I even tried to unnest the GeoJSON data and create a factor palette but that hasn't seemed to work.
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
data <- geojson_read(dataurl, method = 'web', parse = FALSE, what = 'list')
wake <- readOGR(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
#bikedata <- 'D:/bicycle-crash-data-chapel-hill-region.geojson'
#bike <- geojson_read(bikedata)
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- geojson_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
data
})
#bikegeojson <- reactive({
# bike
#})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4)
})
observe({
leafletProxy("map") %>%
addWMSTiles("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",
layers = "nexrad-n0r-900913",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "") %>%
addGeoJSON(wakegeojson(), weight = 3, fill = factpal) %>%
#addGeoJSON(bikegeojson()) %>%
addGeoJSON(vtgeojson(), fill = FALSE, color = "black")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
I think I need to explore the addPolygons feature more but I'm not exactly sure how to do that or how to parse/unnest my GeoJSON data in order to accomplish filling in the Wake County Zipcodes with different colors. Any help is always appreciated. Thank you.
I would switch to sf. You can directly load the geojson and produce a Multipolygon and a Multilinestring object which will also read much faster than readOGR.
Then you can just put those objects in addPolygons and addPolylines.
The following example should work:
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
library(sf)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
wake <- st_read(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- st_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
wake
})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data=wakegeojson(), color=factpal(wake$zips)) %>%
addPolylines(data=vtgeojson(), color="red")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
Based on the comments below I've explicitly broken out lat/long in the spatial data frame.
Added
addCircleMarkers( ~ longitude, ~ latitude)
Added
observeEvent(input$map_marker_click, {
p <- input$map_marker_click
print(p)
})
Yet, nothing shows up in the console when I click the markers so I'm still confused.
Revised Code
# Click on circle and get info
library(shiny)
library(leaflet)
ui <- fluidPage(
leafletOutput("mymap"),
fluidRow(verbatimTextOutput("click_text"))
)
server <- function(input, output, session) {
# Create tree geometries
tree_1g <- st_point(c(-79.2918671415814, 43.6760766531298))
tree_2g <- st_point(c(-79.4883669334101, 43.6653747165064))
tree_3g <- st_point(c(-79.2964680812039, 43.7134458013647))
# Create sfc object with multiple sfg objects
points_sfc <- st_sfc(tree_1g, tree_2g, tree_3g, crs = 4326)
# Create tree attributes
data <- data.frame (
layerId = c("001", "002", "003"),
address = c(10, 20, 30),
street = c("first", "second", "third"),
tname = c("oak", "elm", "birch"),
latitude = c(43.6760766531298, 43.6653747165064, 43.7134458013647),
longitude = c(-79.2918671415814, -79.4883669334101, -79.2964680812039)
)
tree_data <- st_sf(data, geometry = points_sfc)
output$mymap <- renderLeaflet({
leaflet(data = tree_data) %>%
addProviderTiles(providers$Stamen.Watercolor) %>%
# Centre the map in the middle of Toronto
setView(lng = -79.384293,
lat = 43.685,
zoom = 11) %>%
addCircleMarkers( ~ longitude, ~ latitude)
})
observeEvent(input$map_marker_click, {
p <- input$map_marker_click
print(p)
})
}
shinyApp(ui, server)
When a user clicks on each marker I would like some relevant info displayed below the map. Based on this earlier post I tried this. However, nothing happens when I click on the marker. It may have something to do with my not understanding how to associate markers with layerIds?
# Click on circle and get info
library(shiny)
library(leaflet)
ui <- fluidPage(
leafletOutput("mymap"),
fluidRow(verbatimTextOutput("click_text"))
)
server <- function(input, output, session) {
# Create tree geometries
tree_1g <- st_point(c(-79.2918671415814, 43.6760766531298))
tree_2g <- st_point(c(-79.4883669334101, 43.6653747165064))
tree_3g <- st_point(c(-79.2964680812039, 43.7134458013647))
# Create sfc object with multiple sfg objects
points_sfc <- st_sfc(tree_1g, tree_2g, tree_3g, crs = 4326)
# Create tree attributes
data <- data.frame (
layerId = c("001", "002", "003"),
address = c(10, 20, 30),
street = c("first", "second", "third"),
tname = c("oak", "elm", "birch")
)
tree_data <- st_sf(data, geometry = points_sfc)
output$mymap <- renderLeaflet({
leaflet(data = tree_data) %>%
addProviderTiles(providers$Stamen.Watercolor) %>%
# Centre the map in the middle of Toronto
setView(lng = -79.384293,
lat = 43.685,
zoom = 11) %>%
addCircleMarkers()
})
observe({
click <- input$map_marker_click
if(is.null(click))
return()
address <- paste("Address: ", click$street)
output$click_text <- renderText({
address
})
})
}
shinyApp(ui, server)
When you 'observe' something on the map, you need to reference the map you're observing. You do this using this structure
output$<map_id>_event_to_observe
So, in your example your map_id is mymap, hence you'll need to use
observeEvent(input$mymap_marker_click, {
p <- input$mymap_marker_click
print(p)
})
Working code:
ui <- shinyUI(bootstrapPage(
leafletOutput("map")
))
server <- shinyServer(function(input, output, session) {
## Make your initial map
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = -86.779633, lat = 33.543682, zoom = 11) %>%
addTiles(options = providerTileOptions(noWrap = TRUE))
})
## Observe mouse click
observeEvent(input$map_click, {
## Get the click info like had been doing
click <- input$map_click
clat <- click$lat
clng <- click$lng
address <- revgeocode(c(clng,clat))
## Add the marker to the map proxy
leafletProxy('map') %>% # use the proxy to save computation
addMarkers(lng=clng, lat=clat,
popup=address)
})
})
shinyApp(ui=ui, server=server)
I would like to enhance the code above by calculating a statistic within a 5000m buffer of the clicked address...everything I try does not work. Am I missing something?
ui <- shinyUI(bootstrapPage(
leafletOutput("map")
))
server <- shinyServer(function(input, output, session) {
## Make your initial map
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = -86.779633, lat = 33.543682, zoom = 11) %>%
addTiles(options = providerTileOptions(noWrap = TRUE))
})
## Observe mouse clicks and add circles
observeEvent(input$map_click, {
## Get the click info like had been doing
click <- input$map_click
clat <- click$lat
clng <- click$lng
address <- revgeocode(c(clng,clat))
I want to create a SPDF of the lng and lat from the click:
coords<-c(clat, clng)
crs <- "+init=epsg:26930" #' this is E Alabama
x_spdf <- spTransform(coords, CRSobj = crs)
Here I want to create a 5000m buffer around the clicked point
b_dist <- 5*1000
buffer_spdf <- gBuffer(x_spdf, width=b_dist, byid=T)
buffer <- gBuffer(x_spdf, width=b_dist)
This is my SPDF of office addresses I have on my computer that I want to convert to CRS for E Alabama
dent_spdf <- spTransform(split_dentist, CRSobj = crs)
Identify # of offices within buffer
office_in_buffer <- split_office[!is.na(sp::over(split_office, buffer)),]
office_in_buffer <- spTransform(dent_in_office, CRS=crs)
Count # of offices in buffer
num_office <- nrow(office_in_buffer)
Calculate statistic based on # offices in buffer
expenditure <-office_in_buffer#data$variable/ (num_office + 1)
output$expenditure <- renderText(revenue) #' tell Shiny to display this number
leafletProxy('map') %>% # use the proxy to save computation
addMarkers(lng=clng, lat=clat,
popup=address)
})
})
shinyApp(ui=ui, server=server)