Suppose you have the following data frame:
cities = data.frame( name = c('Madrid','Barcelona','Sevilla'),
country = c('Spain','Spain','Spain'),
region = c('Comunidad de Madrid','Cataluña','Andalucia'),
data = c(100, 200, 300),
lng = c(-3.683333,2.166667,-6.083333),
lat = c(40.433333,41.383333,37.446667))
My idea is to have a map of these cities and labels that could display some relevant information when hovering the corresponding city circles. I'd like to have the label text arranged in several lines. The very first approach below failed:
library( leaflet )
map = leaflet( cities ) %>%
addTiles() %>%
addCircles( lng = ~lng, lat = ~lat, fillColor = 'darkBlue', radius = 10000,
stroke = FALSE, fillOpacity = 0.8, label = paste0( cities$name,'\n', cities$region, '\n', cities$country, '\n', cities$data ) )
as well as other similar attempts. After googling a while, I found a possible solution by involving the htmltools package:
library( htmltools )
map2 = leaflet( cities ) %>%
addTiles() %>%
addCircles( lng = ~lng, lat = ~lat, fillColor = 'darkBlue', radius = 10000,
stroke = FALSE, fillOpacity = 0.8,
label = HTML( paste0( '<p>', cities$name, '<p></p>', cities$region, ', ', cities$country,'</p><p>', cities$data, '</p>' ) ) )
In this case, the information is displayed as I'd like but, within the same label, there is an entry for each city of the dataset. How could I do to have the text of a single city arranged in multiple lines? Any help would be really appreciated
First, create a character vector of html content for each city and then wrap that in a lapply call to set the HTML attribute for correct display when defining the label attribute in adCircles
labs <- lapply(seq(nrow(cities)), function(i) {
paste0( '<p>', cities[i, "name"], '<p></p>',
cities[i, "region"], ', ',
cities[i, "country"],'</p><p>',
cities[i, "data"], '</p>' )
})
map2 = leaflet( cities ) %>%
addTiles() %>%
addCircles(lng = ~lng, lat = ~lat, fillColor = 'darkBlue', radius = 10000,
stroke = FALSE, fillOpacity = 0.8,
label = lapply(labs, htmltools::HTML))
map2
The following also works for two labels:
labels <- sprintf(
"<strong>%s</strong><br/>%g people / mi<sup>2</sup>",
states$name, states$density
) %>% lapply(htmltools::HTML)
m <- m %>% addPolygons(
fillColor = ~pal(density),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))
m
see here for further info.
p.s: I wanted to use it for three labels but couldn't manage to.
Related
In the tiny example shown below, I have two features associated with each country (polygons) in the map, namely: randomA, randomB. Each feature has its own legend, so I armed a group named "randomA" containing the polygons coloured with feature randomA and its corresponding legend. I did the same for group "randomB". When the map is depicted, leaflet correctly shows or hides polygons for features "randomA" and "randomB". However legends are always shown stacked on the bottom right corner.
This is the code:
library(rgdal)
library(leaflet)
# From http://data.okfn.org/data/datasets/geo-boundaries-world-110m
countries <- readOGR("json/countries.geojson")
n <- nrow(countries)
# Add two random fields
set.seed(15)
countries#data$randomA <- rnorm(n, 1000, 250)
countries#data$randomB <- rnorm(n, 10000, 3000)
map <- leaflet(countries) %>% addTiles()
pal <- colorNumeric(
palette = "YlGnBu",
domain = countries$randomA
)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~pal(randomA), group = "randomA"
) %>%
addLegend("bottomright", pal = pal, values = ~randomA,
title = "random A",
labFormat = labelFormat(prefix = "$"),
opacity = 1, group = "randomA"
)
qpal <- colorQuantile("RdYlBu", countries$gdp_md_est, n = 5)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~qpal(randomB), group = "randomB"
) %>%
addLegend(
"bottomright",
pal = qpal,
values = ~randomB,
opacity = 1, group = "randomB"
)
# Finally control layers:
map <- map %>%
addLayersControl(
baseGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
map
A snapshot of the result is shown in the image below:
Also, in the actual problem I have to represent nine of these groups, so I wish I had all the legends in the same place.
Do you have any suggestion?
Try using overlay groups instead of base groups:
addLayersControl(
overlayGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
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?
I am making an R leaflet map (not Shiny) and I have two control groups, and based on the selection I would like a different legend to become visible. Currently I only manage to have both legends visible at all time.
Below is the code for the leaflet map, and the output can be seen in the image.
leaflet() %>% addSearchOSM() %>%
addProviderTiles(providers$CartoDB.Positron,
options = providerTileOptions(noWrap = TRUE),
group = "kaart") %>%
# addFullscreenControl() %>%
addCircleMarkers(data = table#data,
lat = ~lng,
lng = ~lat,
color = ~palverbruikplaats(Verbruiksplaats),
label = bepaalPopup(),
group = "Verbruikplaatscircles"
)%>%
addCircleMarkers(data = table#data,
lat = ~lng,
lng = ~lat,
color = ~palstatus(`Status omschrijving`),
label = bepaalPopup(),
group = "statuscircles"
)%>%
leaflet::addLegend("bottomleft", pal = palverbruikplaats, values = verbruikplaatsuniek, title = "Legenda") %>%
leaflet::addLegend("bottomleft", pal = palstatus, values = statusuniek, title = "Legenda") %>%
addLayersControl(baseGroups = c("Verbruikplaatscircles", "statuscircles"),
options = layersControlOptions(collapsed = FALSE))
In your addLayersControl did you mean to set the overlayGroups argument instead of baseGroups?
library(leaflet)
leaflet() %>%
addTiles(group = "OpenStreetMap") %>%
addCircleMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers1", color ="red") %>%
addMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers2") %>%
addLegend(values = 1, group = "Markers1", position = "bottomleft", labels = "1", colors= "red") %>%
addLegend(values = 2, group = "Markers2", position = "bottomleft", labels = "2" ,colors= "blue") %>%
addLayersControl(overlayGroups = c("Markers1", "Markers2"),
options = layersControlOptions(collapsed = FALSE))
what you need to do is, you need to make your legends values reactive
addLegend("bottomright", pal = pal, values = maindata#data[,req_var1()],
you can declare the req_var1() in server before calling
req_var1<-reactive({if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){
paste(input$Curr2,"Curr",sep="_")
} else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
paste(input$Curr2,"CWP",sep="_")
}
})
and also the pal can be declared as
pal1 <- reactive({if(input$ColorType=="Percentile"){
colorQuantile(
palette = "Spectral",
domain = tempdata()#data[,req_var1()],
probs = if(input$`Comparison Metric`=="Current Territory Factors vs GeoProxy Smoothing"){seq(0,1,by=0.25)
} else if(input$`Comparison Metric`=="Current Written Premium Vs Indicated Written Premium"){
seq(0,1,by=0.5)
}
## In case of Current written premium the variation is very less so while executing color mapping code is throwing error.
## This is because the some of quantiles values are not differentiable.
## So in colorQuantile function we have given two different prob values depending on metric selection.
)
} else if(input$ColorType=="Absolute Value"){colorNumeric(
palette = "Spectral",
domain = tempdata()#data[,req_var1()])
}else{print("Plese select Any one color map")}
})
I am working with the leaflet R package. I have a zoning system made of polygons and I'd like to lay their IDs on top of them. Below is an illustration (with another software) of my objective.
Thanks for your suggestions!
Since there is no reproducible data, I decided to use one of my previous posts related to leaflet. There are two things you want to take away from this post: 1) you need to create a data frame containing center points of target regions, 2) you need to use addLabelOnlyMarkers(). You can achieve the first thing using gCentroid(). I added row names of the polygon data set (UK) as character to centers. This is used for labeling. You need to think what labels you use in your own case. Once this data set is ready, you want to use it in addLabelOnlyMarkers().
library(raster)
library(rgeos)
library(leaflet)
# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)
# Find a center point for each region
centers <- data.frame(gCentroid(UK, byid = TRUE))
centers$region <- row.names(UK)
### Create dummy data
set.seed(111)
mydf <- data.frame(place = unique(UK$NAME_2),
value = sample.int(n = 1000, size = n_distinct(UK$NAME_2), replace = TRUE))
### Create five colors for fill
mypal <- colorQuantile(palette = "RdYlBu", domain = mydf$value, n = 5, reverse = TRUE)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK,
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydf$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$value, "<br>")) %>%
addLabelOnlyMarkers(data = centers,
lng = ~x, lat = ~y, label = ~region,
labelOptions = labelOptions(noHide = TRUE, direction = 'top', textOnly = TRUE)) %>%
addLegend(position = "bottomright", pal = mypal, values = mydf$value,
title = "UK value",
opacity = 0.3)
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!!