I want to make a loop to add polygons to a leaflet map according to different columns of a data frame.
for (i in 18:22)
createMap = lapply((concello_wgs84_Datos#data[,i]),function(x){
data <- concello_wgs84_Datos#data[,i]
nombre <- names(concello_wgs84_Datos#data[,i])
pal3 <- leaflet::colorBin("YlOrRd", domain = data, 20, pretty = TRUE)
m = leaflet(data=concello_wgs84_Datos[1:17 & concello_wgs84_Datos#data[,i] == x], options = leafletOptions(minZoom = 8, maxZoom = 18)) %>%
addProviderTiles(providers$Esri.WorldImagery) %>% setView(-8.00, 42.80, zoom = 8.3) %>%
addPolygons(data=datos,
fill= TRUE,
fillColor = ~pal3(data),
stroke = FALSE,
color = "#0000CD",
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 1,
weight = 0.5,
label = ~as.character(datos$CONCELLO),
labelOptions = labelOptions(noHide = F,
textsize = "7px",
direction = "topright"),
highlightOptions = highlightOptions(color = "white",
weight = 1,
bringToFront = TRUE)) %>%
addCircles(data = coordenadasOAC,
lat = ~ coordenadasOAC$LAT,
lng = ~ coordenadasOAC$LONG,radius =0.3,
color="#CD3333",
fillOpacity = 0.8,
popup = ~as.character(coordenadasOAC$OAC)) %>%
addLegend("bottomleft",
pal = pal3,
values = data,
title = nombre,
labFormat = labelFormat(prefix = ""),opacity = 1)})
htmltools::tagList(createMap)
but I have the following error: Error in`[.data.frame´(x#data,i,j,...,drop=False): undefined columns selected.
Could you help me?
Related
Using the code below, I have created a map within the shiny app context. However, as shown in the picture, the polygons' colors are inconsistent with the legend color scheme. I wonder how they can be consistent preferably by changing the legend color scheme. In the code below, the bi_class variable was defined in 9 categories involving a 3-dimensional quantile of x and y variables (i.e, low-low, low-medium, low-high, medium-low, medium-medium, ...).
output$bi_ACSB_BlackP <- renderLeaflet ({
npal2 <- colorFactor(
palette = ("Greens"),
domain = IDD_nhmap$bi_class
)
labels <- sprintf(
"<strong>Zip Code=%s </strong> <br/> African American (ACS) = %s <br/> African American (Projects)= %s ",
IDD_mapdata_()$Zip,
IDD_mapdata_()$Zip_Black,
IDD_mapdata_()$Zip_Hisp
) %>%
lapply(htmltools::HTML)
leaflet (IDD_mapdata_(), options = leafletOptions(zoomSnap = 0.25, zoomDelta =
0.25)) %>%
addProviderTiles("CartoDB.Positron",
options = providerTileOptions(opacity = 2)) %>%
clearControls() %>%
clearShapes() %>%
addPolygons(
fillColor = ~npal2(bi_class),
stroke = T,
weight = 1,
smoothFactor = 0.2,
fillOpacity = 1,
color = "black",
# label=~paste0(NAME," ","County",":"," ",input$sex_map,",", " ",
# input$ProjectID,"=",Age,"%"),
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)'
)
),
# label=~paste(NAME,"<br>",input$sex_map,
# input$ProjectID,"=",Age,"%"),
# label = lapply(labs, htmltools::HTML),
highlightOptions = highlightOptions(
#color = "red",
weight = 2,
bringToFront = T,
# color = "#666",
fillOpacity = 0.7
)
) %>%
setView(lng = IDD_mapdata_1()$long,
lat = IDD_mapdata_1()$lat,
zoom = 8) %>%
bivariatechoropleths::addBivariateChoropleth(
map_data = bivariatechoropleths::renfrew_county,
var1_name = pop_2016,
var2_name = median_household_income_2015,
ntiles= 3,
var1_label = "African American",
var2_label = "Hispanics",
region_name = "CSDNAME",
weight = 1,
fillOpacity = 0.7,
color = "grey",
highlightOptions = leaflet::highlightOptions(color = "orange",
weight = 2,
opacity = 1)) %>%
addTiles(options = tileOptions(opacity = 2))
})
I think if you declare a function that selects the Green colors like this one should probably work:
palColFun <- function(colorPalette = "Greens", n = 9){
pal <- RColorBrewer::brewer.pal(n, colorPalette)
return(pal)
}
Then in your code for bivariatechropleth you should add as follows:
bivariatechoropleths::addBivariateChoropleth(
map_data = bivariatechoropleths::renfrew_county,
var1_name = pop_2016,
var2_name = median_household_income_2015,
ntiles= 3,
var1_label = "African American",
var2_label = "Hispanics",
region_name = "CSDNAME",
weight = 1,
paletteFunction = palColFun,
fillOpacity = 0.7,
color = "grey",
highlightOptions = leaflet::highlightOptions(color = "orange",
weight = 2,
opacity = 1)) %>%
addTiles(options = tileOptions(opacity = 2))
Ideally you would link palColFun with the same color you generated for the plots, but given the example above, it is not for me to reproduce the example.
Hopefully this works.
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 am using the R leaflet package to plot data for California counties. I would like the polygons of each county to vary in opacity based on the number of parcels in that county. Counties with more parcels should be more opaque, and counties with fewer parcels should be more transparent. Is this possible?
I have tried changing the fillOpacity option similar to how fillColor varies with number of parcels:
fillOpacity = ~num.parcels
Sample of my data:
packages <- c('dplyr','leaflet','sf','USAboundaries')
lapply(packages, library, character.only = TRUE)
ca_counties <- USAboundaries::us_counties(states = 'CA')
parcels <- structure(list(county = c("Yuba", "Sacramento", "Inyo", "Los Angeles", "Sierra"),
num.parcels = c(27797L, 452890L, 6432L, 15830L, 54291L)), row.names = c(NA, -5L), class = "data.frame")
parcels <- st_as_sf(left_join(parcels, ca_counties[,c('name')], by = c("county" = "name")))
Leaflet map:
labels <- sprintf(
"<strong>%s County</strong><br/>
Parcels: %g<br/>",
parcels$county, parcels$num.parcels
) %>% lapply(htmltools::HTML)
leaflet(parcels) %>%
setView(-119, 37.9, 6) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(num.parcels),
weight = 2,
opacity = 1,
color = 'black',
dashArray = '2',
fillOpacity = 0.7,
highlightOptions = highlightOptions(color = "red", weight = 3,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "4px 8px"),
textsize = "15px",
direction = 'auto')) %>%
addLegend(pal = pal, values = ~num.parcels, opacity = 0.7, title = "Number of Parcels",
position = "bottomleft")
try setting fillOpacity = ~num.parcels / max(num.parcels),
I also included a pal-function.. it seemed to be missing from your code..
# Create a continuous palette function
pal <- colorNumeric( palette = "Reds", domain = parcels$num.parcels )
#calculate fillopacity
labels <- sprintf(
"<strong>%s County</strong><br/>
Parcels: %g<br/>",
parcels$county, parcels$num.parcels
) %>% lapply(htmltools::HTML)
leaflet(parcels) %>%
setView(-119, 37.9, 6) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(num.parcels),
weight = 2,
opacity = 1,
color = 'black',
dashArray = '2',
fillOpacity = ~num.parcels / max(num.parcels),
highlightOptions = highlightOptions(color = "red", weight = 3,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "4px 8px"),
textsize = "15px",
direction = 'auto')) %>%
addLegend(pal = pal, values = ~num.parcels, opacity = 1, title = "Number of Parcels",
position = "bottomleft")
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?
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.