Related
Using the code below, I could create my maps of interest which work perfectly fine within my shiny dashboard. I would like to create a bivariate map by combining these two maps.
Here are the codes for the maps:
#The code below reactivates the data:
IDD_mapdata_ <- reactive ({
out_map <- IDD_nhmap %>%
filter (ProjectID %in% input$ProjectID)
return(out_map)
})
#The code below creates the first map:
output$IDD_int_map_svi <- renderLeaflet ({
npal2 <- colorNumeric(palette = "Greens",
domain = IDD_nhmap$svi)
leaflet (IDD_mapdata_(), options = leafletOptions(zoomSnap = 0.25, zoomDelta =
0.25)) %>%
addProviderTiles("CartoDB.Positron",
options = providerTileOptions(opacity = 2)) %>%
clearControls() %>%
clearShapes() %>%
addPolygons(
fillColor = ~npal2(svi),
stroke = T,
weight = 1,
smoothFactor = 0.2,
fillOpacity = 1,
color = "black",
label = labels,
labelOptions = labelOptions(
interactive = TRUE,
style = list(
'direction' = 'auto',
'color' =
'black',
'font-family' = 'sans-serif',
# 'font-style'= 'italic',
'box-shadow' = '3px 3px rgba(0,0,0,0.25)',
'font-size' = '14px',
'border-color' = 'rgba(0,0,0,0.5)'
)
),
highlightOptions = highlightOptions(
weight = 2,
bringToFront = T,
fillOpacity = 0.7
)
) %>%
setView(lng = IDD_mapdata_1()$long,
lat = IDD_mapdata_1()$lat,
zoom = 8) %>%
addLegend(
position = "topright",
opacity = 1,
values = IDD_nhmap$svi,
pal = npal2,
title = (paste("Social Vulnerability Index")) ,
labFormat = labelFormat()
) %>%
addTiles(options = tileOptions(opacity = 2))
})
#The code below generates the second map:
output$IDD_int_map1 <- renderLeaflet ({
npal2 <- colorNumeric(palette = "Greens",
domain = IDD_nhmap$Zip_Black)
leaflet (IDD_mapdata_(), options = leafletOptions(zoomSnap = 0.25, zoomDelta =
0.25)) %>%
addProviderTiles("CartoDB.Positron",
options = providerTileOptions(opacity = 2)) %>%
clearControls() %>%
clearShapes() %>%
addPolygons(
fillColor = ~npal2(Zip_Black),
stroke = T,
weight = 1,
smoothFactor = 0.2,
fillOpacity = 1,
color = "black",
label = labels,
labelOptions = labelOptions(
interactive = TRUE,
style = list(
'direction' = 'auto',
'color' =
'black',
'font-family' = 'sans-serif',
# 'font-style'= 'italic',
'box-shadow' = '3px 3px rgba(0,0,0,0.25)',
'font-size' = '14px',
'border-color' = 'rgba(0,0,0,0.5)'
)
),
highlightOptions = highlightOptions(
weight = 2,
bringToFront = T,
# color = "#666",
fillOpacity = 0.7
)
) %>%
setView(lng = IDD_mapdata_1()$long,
lat = IDD_mapdata_1()$lat,
zoom = 8) %>%
addLegend(
position = "topright",
opacity = 1,
values = IDD_nhmap$Zip_Black,
pal = npal2,
title = (paste("African Americans (ACS)")) ,
labFormat = labelFormat()
) %>%
addTiles(options = tileOptions(opacity = 2))
})
I created a leaflet map. With zoom=2, I have a fairly small map, but if I zoom in at 3, the map becomes larger in relation to the frame. How can I set the zoom between zoom = 2 and zoom = 3; A zoom=2.5 for example.
leaflet(data) %>% addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng=lng,lat=lat,zoom=2.5) %>%
addPolygons(fillColor = ~palette(covariable),
stroke = TRUE,
weight = 0.3,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,popup = ~(popup_covar),
highlight = highlightOptions(
weight = 3,color = "#666",dashArray = "",
fillOpacity = 0.8,bringToFront = FALSE))
I'm developing a shiny app to show a choropleth map, using leaflet and a shapefile to add the polygons. Outside shiny everything works fine, but with shiny I got a problem when using addLegend as follows:
mypal <- reactive({
colorBin(palette = "RdYlBu", domain = get("map_fires")[[paste0("qm_", selectedYear())]],
bins = 5, reverse = TRUE, pretty = FALSE,
na.color = "#FFFAFA")
})
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addPolygons(data = map_fires,
stroke = TRUE, weight = 1, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal()(get("map_fires")[[paste0("qm_", selectedYear())]]),
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE),
label= lapply(stats_labels(), HTML),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomright", pal = ~mypal(),
values = ~get("map_fires")[[paste0("qm_", selectedYear())]],
opacity = 1)
})
The code above returns:
Warning: Error in if: argument is of length zero
104: addLegend
...
I'm using paste0("qm_", selectedYear()) to refer to different columns with yearly data.
I believe the problem is in values = ~get("map_fires")[[paste0("qm_", selectedYear())]], but can't tell why. I have already tried to specify the dataset on addLegend, and also to put a specific column on values = (i.e., without depending on the reactive value of selectedYear()), to no avail.
Outside shiny things work good with the code below (where I keep using get("map_fires")[[paste0("qm_", 2018)]], changing selectedYear() for a specific year, just to better show my case):
mypal <- colorBin(palette = "RdYlBu", domain = get("map_fires")[[paste0("qm_", 2018)]],
bins = 5, reverse = TRUE, pretty = FALSE,
na.color = "#FFFAFA")
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addPolygons(data = map_fires,
stroke = TRUE, weight = 1, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(get("map_fires")[[paste0("qm_", 2018)]]),
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE),
label= lapply(stats_labels, HTML),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomright", pal = mypal,
values = get("map_fires")[[paste0("qm_", 2018)]],
opacity = 1)
Am I missing something?
Following the guidance of #TimSalabim, I separated the borders and fill of my neighbourhood polygons so that I could order them appropriately with zIndex.
https://lawsblog.netlify.com/post/leaflet-map/
If I place the highlightOptions() function within the addPolygons(neighbourhood fill) function, I don't know how to increase the border of the polygon upon mouseover.
If I place the highlightOptions() function within the addPolylines(neighbourhood border) function I can CAREFULLY mouse-over just the borders and the widths increase. That's the behavior I want, when I mouse-over any part of the neighbourhood area.
Now that I've separated the fill and borders of the polygons how do I increase the border width when I mouse-over the fill area?
# Add hood borders
addPolylines(data = borders,
color = "white",
opacity = 1,
weight = 2,
options = pathOptions(pane = "hood_borders")) %>%
# Add hood fill
addPolygons(data = hood_shp,
fillColor = ~pal(be_per_cap),
fillOpacity = 1.0,
color = NA,
options = pathOptions(pane = "hoods",
# Highlight neighbourhoods upon mouseover - NOT CORRECT
highlight = highlightOptions(
stroke = 4),
# Add label info when mouseover
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")))
Taking what SeGa advised, I've modified the code. See here. The neighbourhood borders are not obscured and the border does expand upon hover. However the border does not revert back to its original width with mouse out. Why is that?
leaflet(options = leafletOptions(minZoom = 11, maxZoom = 16), width = "100%") %>%
addTiles() %>%
# Raster image surrounding Toronto
addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
# Center map north of Toronto City Hall slightly zoomed in
setView(map,
lng = -79.384293,
lat = 43.685, #43.653908,
zoom = 12) %>%
# Vector neighbourhoods
addPolygons(data = hood_shp,
fillColor = ~pal(be_per_cap),
color = NA,
fillOpacity = 1,
# Highlight neighbourhoods upon mouseover
highlight = highlightOptions(
weight = 3,
fillOpacity = 0,
color = "black",
opacity = 1.0,
bringToFront = TRUE,
sendToBack = TRUE),
# # Add label info when mouseover
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
# Add highways
addPolygons(data = xway,
color = "sienna",
weight = 1.0,
opacity = 1.0,
fillOpacity = 0.7) %>%
# Add major arterial
addPolygons(data = mart,
color = "#737373",
weight = 1.0,
opacity = 1.0,
fillOpacity = 1.0) %>%
# Add parks
addPolygons(data = parks,
color = "green",
weight = 1.0,
opacity = 1.0,
fillOpacity = 1.0,
options = pathOptions(clickable = FALSE)) %>%
# Add border
addPolylines(data = hood_shp,
color = "black",
stroke = TRUE,
opacity = 1,
weight = 1) %>%
# Add legend
addLegend(data = hood_shp,
colors =c("#AA122E", "#F4AE7E", "#FEFDB7"),
labels= c("More", "", "Less"),
opacity = 1.0,
title = "B&Es",
position = "bottomright")
I'm not sure if I understand your problem correctly but if you only want to increase the borders of a polygon with leaflet, the highlightoption is the right choice, but you shouldn't place it inside the pathOptions.
The following example uses addPolygons for the neighboorhoods with a highlightOption. Within those you define the behaviour of the neighboorhoods when mouse-overing. With the weight argument you define the border size.
The parks also go in an addPolygons but with options =
pathOptions(clickable = FALSE) you make them unclickable, so they
dont interact with mouse events.
And the borders go in a addPolylines without any further
options.
Is the following example what you are looking for?
library(sp)
Sr1 = Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))
Sr2 = Polygon(cbind(c(5,4,2,5),c(2,3,2,2)))
Srs1 = Polygons(list(Sr1), "s1")
Srs2 = Polygons(list(Sr2), "s2")
hood_shp = SpatialPolygons(list(Srs1,Srs2), 1:2)
hood_shp <- SpatialPolygonsDataFrame(hood_shp, data=data.frame(be_per_cap = 1:length(hood_shp)), match.ID = F)
parks = Polygon(cbind(c(2,3,3,1,2),c(1,2,4,3,1)))
parks = SpatialPolygons(list(Polygons(list(parks), "parks")))
xway = Polygon(cbind(c(1,5,5,1,3),c(3,5,5,3,1)))
xway = SpatialPolygons(list(Polygons(list(xway), "xway")))
library(shiny)
library(leaflet)
library(htmlwidgets)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
output$map <- renderLeaflet({
pal = colorBin("Blues", hood_shp$be_per_cap)
leaflet(width = "100%") %>%
addTiles() %>%
# Raster image surrounding Toronto
addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
# Vector neighbourhoods
addPolygons(data = hood_shp,
fillColor = ~pal(be_per_cap),
color = "transparent",
fillOpacity = 1,
# Highlight neighbourhoods upon mouseover
highlight = highlightOptions(
weight = 3,
fillOpacity = 0,
color = "black",
opacity = 1.0,
bringToFront = TRUE,
sendToBack = TRUE),
# # Add label info when mouseover
label = "labels",
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
# Add parks
addPolygons(data = parks,
color = "green",
weight = 1.0,
opacity = 1.0,
fillOpacity = 1.0,
options = pathOptions(clickable = FALSE)) %>%
# Add highways
addPolygons(data = xway,
color = "sienna",
weight = 1.0,
opacity = 1.0,
fillOpacity = 0.7) %>%
# Add border
addPolylines(data = hood_shp,
color = "black",
stroke = TRUE,
opacity = 1,
weight = 1) %>%
# Add legend
addLegend(data = hood_shp,
colors =c("#AA122E", "#F4AE7E", "#FEFDB7"),
labels= c("More", "", "Less"),
opacity = 1.0,
title = "B&Es",
position = "bottomright")
})
}
shinyApp(ui, server)
With this script, I am displaying a map with three isochrones. I would like the map to have labels containing the max time represented by each isochrone/polygon.
How should I reference the spatial data frames (iso1/2/3) in the addPolygons() section?
In each of the three addPolygons() bellow I tried a different approach but no luck :( (although the script still works).
library(osrm)
library(leaflet)
library(viridisLite)
# Making isochrones
iso1 = osrmIsochrone(loc = c(9.2,45.5),
breaks = seq(from = 0,
to = 45,
by = 5),
res=75)
iso2 = osrmIsochrone(loc = c(12.51182,41.92631),
breaks = seq(from = 0,
to = 45,
by = 15),
res=100)
iso3 = osrmIsochrone(loc = c(11.25581,43.76956),
breaks = seq(from = 0,
to = 45,
by = 15),
res=100)
# colors for leaflet
vir = viridis(9)
# palette
pal1 <- colorNumeric(
palette = vir,
domain = iso1#data$id)
pal2 <- colorNumeric(
palette = "Blues",
domain = iso2#data$id)
pal3 <- colorNumeric(
palette = "Reds",
domain = iso3#data$id)
# Plotting interactive map using spdf
leaflet()%>%
addTiles("http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga", attribution = 'Google')%>%
addPolygons(data = iso1,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal1(id),stroke = FALSE, label = iso1#data$max)%>%
addPolygons(data = iso2,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal2(id),stroke = FALSE, label = ~max)%>%
addPolygons(data = iso3,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal3(id),stroke = FALSE, label = ~iso3#data$max)
It works if you provide the max values as.character to the label.
library(osrm)
library(leaflet)
library(viridisLite)
# Making isochrones
iso1 = osrmIsochrone(loc = c(9.2,45.5),
breaks = seq(from = 0,
to = 45,
by = 5),
res=75)
iso2 = osrmIsochrone(loc = c(12.51182,41.92631),
breaks = seq(from = 0,
to = 45,
by = 15),
res=100)
iso3 = osrmIsochrone(loc = c(11.25581,43.76956),
breaks = seq(from = 0,
to = 45,
by = 15),
res=100)
# colors for leaflet
vir = viridis(9)
# palette
pal1 <- colorNumeric(
palette = vir,
domain = iso1#data$id)
pal2 <- colorNumeric(
palette = "Blues",
domain = iso2#data$id)
pal3 <- colorNumeric(
palette = "Reds",
domain = iso3#data$id)
# Plotting interactive map using spdf
leaflet()%>%
addTiles("http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga", attribution = 'Google')%>%
addPolygons(data = iso1,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal1(id),stroke = FALSE, label = as.character(iso1#data$max))%>%
addPolygons(data = iso2,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal2(id),stroke = FALSE, label = as.character(iso2#data$max))%>%
addPolygons(data = iso3,
fill = TRUE,
fillOpacity = 0.7,
fillColor = ~pal3(id),stroke = FALSE, label = as.character(iso3#data$max))
leaflet()%>%
addTiles("http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga", attribution = 'Google')%>%
addPolygons(data = iso1,
fill = TRUE,
group = "label1",
fillOpacity = 0.7,
fillColor = ~pal1(id),stroke = FALSE, label = iso1#data$max)%>%
addPolygons(data = iso2,
fill = TRUE,
group = "label2",
fillOpacity = 0.7,
fillColor = ~pal2(id),stroke = FALSE, label = ~max)%>%
addPolygons(data = iso3,
fill = TRUE,
group = "label3",
fillOpacity = 0.7,
fillColor = ~pal3(id),stroke = FALSE, label = ~iso3#data$max)
Use the group argument to specify the label.