It is possible create use a grey when the value in nycounties$dimension is 0 and in the rest use the palette? How can I do it? I have try an if in fill color but i have an error Error in getMapData(map) : argument "map" is missing, with no default
library(leaflet)
nycounties <- rgdal::readOGR("https://raw.githubusercontent.com/openpolis/geojson-italy/master/geojson/limits_IT_provinces.geojson")
city <- c("Novara", "Milano","Torino","Bari")
dimension <- as.numeric(c("1500", "5000","3000","4600"))
df <- data.frame(city, dimension)
nycounties#data = data.frame(nycounties#data,
df[match(nycounties#data[, "prov_name"],
df[, "city"]),])
pal <- colorNumeric("viridis", NULL)
nycounties$dimension[is.na(nycounties$dimension)] = 0
leaflet(nycounties) %>%
addTiles() %>%
addPolygons(stroke = TRUE, smoothFactor = 0.3, fillOpacity = 1,
fillColor = ~pal(nycounties$dimension), weight = 1, color = "black", label = nycounties$prov_name) %>%
addLegend(pal = pal, values = ~(nycounties$dimension), opacity = 1.0)
library(leaflet)
nycounties <- rgdal::readOGR("https://raw.githubusercontent.com/openpolis/geojson-italy/master/geojson/limits_IT_provinces.geojson")
city <- c("Novara", "Milano","Torino","Bari","Cagliari","Perugia")
dimension <- as.numeric(c("1500", "5000","3000","4600","4500","8604"))
df <- data.frame(city, dimension)
nycounties#data = data.frame(nycounties#data,
df[match(nycounties#data[, "prov_name"],
df[, "city"]),])
nycounties$dimension[is.na(nycounties$dimension)] = 0
pal <- colorNumeric("viridis", domain=c(1,max(nycounties$dimension)))
leaflet(nycounties) %>%
addTiles() %>%
addPolygons(stroke = TRUE, smoothFactor = 0.3, fillOpacity = 1,
fillColor = ~pal(nycounties$dimension), weight = 1, color = "black", label = nycounties$prov_name) %>%
addLegend(pal = pal, values = ~(nycounties$dimension), opacity = 1.0)
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 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?
I'm building a leaflet map on R having multiple layers that are controlled by addLayersControl. Every layer as the same spatial information, so only the data associated to each polylines changes. The idea is to have a basic map, where the user decide which data field is display. I succeeded at making the map, however I noticed that the size of the html file produced is huge.
In my actual context, making the map with only one layer leads to a ~20mb file. However, if I add one field it gets to ~40mb and three layer ~60mb. So it seems to me that the html produced is loading the same shapefile 3 times instead of simply using one shapefile and linking it a data frame of some sort.
Am I stock with this behavior of leaflet or is there a way to file size inflation in my context? I may not have programmed my leaflet the better way...
I've made a reproducible example to show the problem. It uses a small shapefile so the size problem is not dramatic, however the point is the same, which is constantly doubling file size. Also, the example is lengthy, sorry about that, I could'n find a way to simplify it further.
Preparation:
# loading the libraries
library(sf)
library(leaflet)
library(htmlwidgets)
# preparing the shapefile
nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>%
st_transform(st_crs(4326))
# preparing the colors (not really important)
pal.area <- colorNumeric(palette = "inferno", domain = range(nc$AREA))
pal.perim <- colorNumeric(palette = "inferno", domain = range(nc$PERIMETER))
pal.cnty <- colorNumeric(palette = "inferno", domain = range(nc$CNTY_))
pal.sid74 <- colorNumeric(palette = "inferno", domain = range(nc$SID74))
Making the leaflet, this section is long, however it's simply 4 leaflet maps created one after another by adding one layer at a time. It's mostly copy-pasted work:
###
one_layer <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area"
)
###
###
two_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addLayersControl(
overlayGroups = c("area", "perim"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
###
###
three_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addPolylines(fillColor = ~pal.cnty(CNTY_),
fill = TRUE,
opacity = 0.8,
group = "cnty") %>%
addLegend("bottomright",
pal = pal.cnty, values = ~CNTY_,
opacity = 1, group = "cnty"
) %>%
addLayersControl(
overlayGroups = c("area", "perim", "cnty"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c("perim","cnty"))
###
###
four_layers <- leaflet(data = nc) %>%
addTiles() %>%
addPolylines(fillColor = ~pal.area(AREA),
fill = TRUE,
opacity = 0.8,
group = "area") %>%
addLegend("bottomright",
pal = pal.area, values = ~AREA,
opacity = 1, group = "area") %>%
addPolylines(fillColor = ~pal.perim(PERIMETER),
fill = TRUE,
opacity = 0.8,
group = "perim") %>%
addLegend("bottomright",
pal = pal.perim, values = ~PERIMETER,
opacity = 1, group = "perim"
) %>%
addPolylines(fillColor = ~pal.cnty(CNTY_),
fill = TRUE,
opacity = 0.8,
group = "cnty") %>%
addLegend("bottomright",
pal = pal.cnty, values = ~CNTY_,
opacity = 1, group = "cnty"
) %>%
addPolylines(fillColor = ~pal.sid74(SID74),
fill = TRUE,
opacity = 0.8,
group = "sid74") %>%
addLegend("bottomright",
pal = pal.sid74, values = ~SID74,
opacity = 1, group = "sid74"
) %>%
addLayersControl(
overlayGroups = c("area", "perim", "cnty", "sid74"), position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c("perim","cnty", "sid74"))
###
Then, you get 4 objects (maps) we can compare their size directly in R:
object.size(one_layer)
301864 bytes
object.size(two_layers)
531144 bytes
object.size(three_layers)
681872 bytes
object.size(four_layers)
828616 bytes
The size increase is constant and way higher that what we would expect if the only the data was added instead of all the spatial info. As a comparison, the initial shape which has 15 fields is of size:
object.size(nc)
135360 bytes
If we save the maps to HTML, the problem is even more visible:
saveWidget(one_layer, paste0(getwd(),"/temp_data/temp/one_layer.html"), selfcontained = F)
saveWidget(two_layers, paste0(getwd(),"/temp_data/temp/two_layers.html"), selfcontained = F)
saveWidget(three_layers, paste0(getwd(),"/temp_data/temp/three_layers.html"), selfcontained = F)
saveWidget(four_layers, paste0(getwd(),"/temp_data/temp/four_layers.html"), selfcontained = F)
file.info(list.files("temp_data/temp", pattern = ".html$", full.names = T))$size[c(2,4,3,1)] %>%
setNames(c("One Layer", "Two Layers", "Three Layers", "Four Layers")) %>%
barplot(ylab="size in Bytes")
It's clearly doubling in size.
So, to summarize, is there a way to get leaflet to not reproduced the spatial information when adding multiple fields of data to the same map?
My leaflet map looks something like this:
library(sp)
library(leaflet)
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
Sr1 = Polygon(cbind(xx, yy))
Srs1 = Polygons(list(Sr1), "s1")
SpP = SpatialPolygons(list(Srs1), 1:1)
return(SpP)
}
Circle.Town <- circleFun(c(1,-1),2.3,npoints = 100)
df1 <- data.frame(long=c(0.6,1,1.4), lat=c(-2, -.8, -0.2), other=c('a', 'b', 'c'), VAM=c(10,8,6),
type=c('Public', 'Public', 'Private'), id=c(1:3)) %>%
mutate(X=paste0('<strong>id: </strong>',
id,
'<br><strong>type</strong>: ',
type,
'<br><strong>VAM</strong>: ',
VAM))
# Create a continuous palette function
pal <- colorNumeric(
palette = "RdYlBu",
domain = df1$VAM
)
leaflet(height = "400px") %>%
addTiles() %>%
addPolygons(data = Circle.Town, color = 'green', fillOpacity = .7) %>%
addCircleMarkers(data = df1, lat = ~lat, lng =~long,
radius = ~VAM, popup = ~as.character(X),
fillColor = ~pal(VAM),
stroke = FALSE, fillOpacity = 0.8,
clusterOptions = markerClusterOptions()) %>%
addLegend(position = "topright",
pal = pal, values = df1$VAM,
title = "VAM",
opacity = 1
) %>%
setView(lng = 1, lat = -1, zoom = 8)
Right now, I get a popup when I click one of the circles. Is it possible to get the information when I hover the mouse instead of click? Ideally, I would like something like this.
Thanks!
This may have been added to the leaflet package since this question was posed a year ago, but this can be done via the label argument. I am using leaflet R package version 1.1.0.
Read the data in as above:
library(sp)
library(leaflet)
library(dplyr)
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
Sr1 = Polygon(cbind(xx, yy))
Srs1 = Polygons(list(Sr1), "s1")
SpP = SpatialPolygons(list(Srs1), 1:1)
return(SpP)
}
Circle.Town <- circleFun(c(1,-1),2.3,npoints = 100)
df1 <- data.frame(long=c(0.6,1,1.4), lat=c(-2, -.8, -0.2), other=c('a', 'b', 'c'), VAM=c(10,8,6),
type=c('Public', 'Public', 'Private'), id=c(1:3)) %>%
mutate(X=paste0('<strong>id: </strong>',
id,
'<br><strong>type</strong>: ',
type,
'<br><strong>VAM</strong>: ',
VAM))
# Create a continuous palette function
pal <- colorNumeric(
palette = "RdYlBu",
domain = df1$VAM
)
But create a list of labels instead of vector:
labs <- as.list(df1$X)
And then lapply the HTML function over that list within the label argument. Note to use label instead of popup.
library(htmltools)
leaflet(height = "400px") %>%
addTiles() %>%
addPolygons(data = Circle.Town, color = 'green', fillOpacity = .7) %>%
addCircleMarkers(data = df1, lat = ~lat, lng =~long,
radius = ~VAM, label = lapply(labs, HTML),
fillColor = ~pal(VAM),
stroke = FALSE, fillOpacity = 0.8,
clusterOptions = markerClusterOptions()) %>%
addLegend(position = "topright",
pal = pal, values = df1$VAM,
title = "VAM",
opacity = 1
) %>%
setView(lng = 1, lat = -1, zoom = 8)
This method is described in an an answer to this SO question: R and Leaflet: How to arrange label text across multiple lines
There is more info on HTML in labels in leaflet documentation:
https://rstudio.github.io/leaflet/popups.html
Here is an alternative:
library(leaflet)
library(htmltools)
library(htmlwidgets)
yourmap <- leaflet(height = "400px") %>%
addTiles() %>%
addPolygons(data = Circle.Town, color = 'green', fillOpacity = .7) %>%
addCircleMarkers(data = df1, lat = ~lat, lng =~long,
radius = ~VAM, popup = ~as.character(X),
fillColor = ~pal(VAM),
stroke = FALSE, fillOpacity = 0.8,
clusterOptions = markerClusterOptions()) %>%
addLegend(position = "topright",
pal = pal, values = df1$VAM,
title = "VAM",
opacity = 1
) %>%
setView(lng = 1, lat = -1, zoom = 8)
setwd("~/Desktop/")
saveWidget(yourmap, file="yourmap.html")
In your desktop, you will have an html and a folder saved under yourmap. Open the leaflet.js file located in /pathTo/yourmap_files/leaflet-binding-1.0.1.9002.
In leaflet.js, scroll down to var popup = df.get(i, 'popup');
and paste just below:
marker.on('mouseover', function (e) {
this.openPopup();
});
marker.on('mouseout', function (e) {
this.closePopup();
});
Save and reopen yourmap.html file. Hover on one of your point!!