Add different legends in different layers on leaflet map in R - r

library(leaflet)
library(htmltools)
library(htmlwidgets)
library(dplyr)
#
df1 <- data.frame(points=c("p1", "p2"), lat=c(49.47259, 49.48095), long=c(-103.7054, -103.6126), value=c(50.34, 100.25))
df2 <- data.frame(points=c("p1", "p2"), lat=c(49.47809, 49.66849), long=c(-103.5614, -103.0224), value=c(300.56, 505.34))
#
pal1 <- colorNumeric(
palette = "PRGn",
domain = df1$value
)
#
pal2 <- colorNumeric(
palette = "PRGn",
domain = df2$value
)
#
n <- leaflet() %>% addTiles(group="1st layer") %>% addTiles(group="2nd layer") %>%
addCircles(data=df1, lng=~long, lat=~lat, weight = 3, radius=250, color = ~pal1(value),
stroke = TRUE, fillOpacity = 0.8,group="1st layer") %>%
addCircles(data=df2, lng=~long, lat=~lat, weight = 3, radius=250, color = ~pal2(value),
stroke = TRUE, fillOpacity = 0.8,group="2nd layer") %>%
addLegend("bottomright", pal = pal1, values = df1$value, title = "legend_df1") %>%
addLegend("topright", pal = pal2, values = df2$value, title = "legend_df2") %>%
addLayersControl(baseGroups=c("1st layer","2nd layer"),
options=layersControlOptions(collapsed = F))
n
I want that when I click on "1st layer" then only "legend_df1" will appear and when I click on "2nd layer" then only "legend_df2" will appear and "legend_df1" will be vanished. Therefore, in each layer different legends will appear, not both legends together. Can anybody please help me out?

This is now possible with overlayGroups
library(leaflet)
df1 <- data.frame(points=c("p1", "p2"), lat=c(49.47259, 49.48095), long=c(-103.7054, -103.6126), value=c(50.34, 100.25))
df2 <- data.frame(points=c("p1", "p2"), lat=c(49.47809, 49.66849), long=c(-103.5614, -103.0224), value=c(300.56, 505.34))
pal1 <- colorNumeric(
palette = "inferno",
domain = df1$value
)
pal2 <- colorNumeric(
palette = "viridis",
domain = df2$value
)
leaflet() %>%
addProviderTiles(providers$CartoDB.DarkMatter) %>%
addCircleMarkers(data=df1, lng=~long, lat=~lat,
color = ~pal1(value),
group="group_1") %>%
addCircleMarkers(data=df2, lng=~long, lat=~lat,
color = ~pal2(value),
group="group_2") %>%
addLegend("bottomright", pal = pal1, title="grp1",
values = df1$value, group="group_1") %>%
addLegend("bottomright", pal = pal2, title="grp2",
values = df2$value, group="group_2") %>%
addLayersControl(overlayGroups = c("group_1","group_2"),
options = layersControlOptions(collapsed = FALSE))

Related

Exchanging map results using leaflet and state_popup

I have a database of medical consultations by cities. I use the leaflet and state_popup function to display the results on a map, as described below:
pal <- colorBin("Blues",domain = DATA$QUANTITY_MEDICAL,bins = c(1, 1000, 5000, 10000, 50000,100000,300000),na.color=NA)
state_popup <- paste0("<strong>CITY: </strong>",
DATA$CITY,
"<br><strong> QUANTITY OF MEDICAL CONSULTATION: </strong>",
DATA$QUANTITY_MEDICAL)
leaflet(data = DATA) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(fillColor = ~pal(QUANTITY_MEDICAL),
fillOpacity = 0.7,
color = "#BDBDC3",
weight = 1,
popup = state_popup) %>%
addLegend("topright","bottomright", pal = pal, values = ~ DATA$QUANTITY_MEDICAL,
title = " QUANTITY OF MEDICAL CONSULTATION ",
opacity = 1)
This script only shows one result at a time (medical consultations). I would like to include information about other medical procedures that I want to include, such as exams or hospitalizations.
I want for each procedure (medical consultation, exams or hospitalization) to include a button that would change the result. In my database (DATA) I already have the columns that separate the procedures I quoted. Is it possible to include this button to change the results on the map?
You are going to have to define groups it seems to me. There is a good link from RStudio on leaflet that may help you.
https://rstudio.github.io/leaflet/showhide.html
Here is some sample code from that site:
quakes <- quakes %>%
dplyr::mutate(mag.level = cut(mag,c(3,4,5,6),
labels = c('>3 & <=4', '>4 & <=5', '>5 & <=6')))
quakes.df <- split(quakes, quakes$mag.level)
l <- leaflet() %>% addTiles()
names(quakes.df) %>%
purrr::walk( function(df) {
l <<- l %>%
addMarkers(data=quakes.df[[df]],
lng=~long, lat=~lat,
label=~as.character(mag),
popup=~as.character(mag),
group = df,
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
labelOptions = labelOptions(noHide = F,
direction = 'auto'))
})
l %>%
addLayersControl(
overlayGroups = names(quakes.df),
options = layersControlOptions(collapsed = FALSE)
)
I have a map I update monthly that has layers of information and I get it like so:
lsl <- unique(origAddress$LIHN_Line) # Gets unique service lines
# Create color palette
lihnpal <- colorFactor(
palette = 'Dark2'
, domain = origAddress$LIHN_Line
)
# create initial leaflet
LIHNMap <- leaflet() %>%
setView(lng = sv_lng, lat = sv_lat, zoom = sv_zoom) %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
addControl("LIHN Service Line Point Map", position = "topright")
# for loop to cycle through adding layers
for(i in 1:length(lsl)){
LIHNMap <- LIHNMap %>%
addCircles(
data = subset(origAddress, origAddress$LIHN_Line == lsl[i])
, group = lsl[i]
, lat = ~lat
, lng = ~lon
, radius = 3
, fillOpacity = 1
, color = ~lihnpal(LIHN_Line)
, label = ~htmlEscape(LIHN_Line)
, popup = ~as.character(
paste(
"<strong>Hospitalist/Private: </strong>"
, hosim
, "<br><strong>Address: </strong>"
, FullAddress
, "<br><strong>Service Line: </strong>"
, LIHN_Line
, "<br><strong>LOS: </strong>"
, LOS
, "<br><strong>SOI: </strong>"
, SOI
, "<br><strong>Encounter: </strong>"
, pt_id
, "<br><strong>Payer Group:</strong>"
, pyr_group2
)
)
)
}
# add layercontrol
LIHNMap <- LIHNMap %>%
addLayersControl(
baseGroups = c("OSM (default)", "Toner", "Toner Lite"),
overlayGroups = lsl,
options = layersControlOptions(
collapsed = TRUE
, position = "topright"
)
)
LIHNMap <- LIHNMap %>%
addAwesomeMarkers(
lng = sv_lng
, lat = sv_lat
, icon = hospMarker
, label = ""
, popup = HospPopup
)
# print map
LIHNMap

renderLeaflet: legend is not rendered in shiny

Using the renderLeaflet (following codes), I am trying to create an interactive map within shiny. I want the map to be updated based on users selections of age group, sex, and year. When age group=60 and sex=both sexes and year= 2010 are selected, everything looks great (please see this screen shot).
However, when the other age groups are selected, the legend remains unchanged and is not rendered (Please see the second screen shot).
Here is my code:
mapdata_ <- reactive ({
nhmap$Per <- round(nhmap$Per, 1)
out_map <- nhmap %>%
filter (
Age_Group %in% input$Age_Group_map,
Sex %in% input$sex_map,
Year %in% input$Year_map)
return(out_map)
})
output$int_map <- renderLeaflet ({
leaflet (mapdata_(),
pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837") ,
pal <- colorBin(palette = pal8, domain = nhmap$Per, bins=4, right =FALSE, na.color = "#808080", alpha = FALSE, reverse = F)
) %>%
addProviderTiles("CartoDB.Positron") %>%
clearControls() %>%
clearShapes()%>%
addPolygons(fillColor = ~pal(Per),
stroke=T,
weight=1,
smoothFactor=0.2,
fillOpacity = 1,
color="black",
popup=~paste(NAME,"<br>",input$sex_map,
input$Age_Group_map,"=",Per,"%"),
highlightOptions = highlightOptions(color = "red",
weight = T,
bringToFront = T),
label=~NAME) %>%
addTiles() %>%
setView(-82.706838, 40.358615, zoom=7) %>%
addLegend(position = "bottomright",
values = ~pal(Per),
pal = pal,
title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)) ,
labFormat = labelFormat())
})

Leaflet with multiple polylines elements leads to huge HTML

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?

Shiny: how to plot several parameters on the same leaflet map?

I'm new to shiny. I want to make a shiny app that shows the spatial distribution of different parameters. I used meuse dataset from sp package.
Here is the code I used
library(sp)
library(rgdal)
library(ggmap)
library(leaflet)
library(dplyr)
library(shiny)
ui <- fluidPage(
mainPanel(
titlePanel("Copper (ppm)"),
leafletOutput("copper"),
titlePanel("Lead (ppm)"),
leafletOutput("lead"),
titlePanel("Zinc (ppm)"),
leafletOutput("zinc")
)
)
server <- function(input,output){
output$copper <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~copper/10,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(copper)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
output$lead <- renderLeaflet({
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~lead/50,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(lead)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
output$zinc <- renderLeaflet({
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~zinc/100,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(zinc)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
}
shinyApp(ui = ui, server = server)
and here is the result I got
I wonder if there is a way to plot all parameters (copper, lead and zinc) on one map. Any suggestions would be appreciated.
UPDATE
Thanks to #Symbolix's answer and suggestion of using checkBoxGroupInput. Instead, I used addCircleMarkers three times so I can plot all the metals on one map and I can switch them on and off
ui <- fluidPage(
mainPanel(
titlePanel("All metals (ppm)"),
leafletOutput("metals")
)
)
server <- function(input,output){
output$metals <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~copper/10,
color ="red",
stroke = FALSE,
fillOpacity = 0.4,
group = "copper",
popup = ~as.character(copper)) %>%
addCircleMarkers(~x,
~y,
radius = ~lead/50,
color ="gren",
stroke = FALSE,
fillOpacity = 0.4,
group = "lead",
popup = ~as.character(lead)) %>%
addCircleMarkers(~x,
~y,
radius = ~zinc/100,
color ="blue",
stroke = FALSE,
fillOpacity = 0.4,
group = "zinc",
popup = ~as.character(zinc)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = c("copper",
"lead",
"zinc"))
})
}
shinyApp(ui = ui, server = server)
Melt your data so that your metals are in one column and you're good to go.
Here I use library(reshape2) to do the melt.
library(sp)
library(rgdal)
library(ggmap)
library(leaflet)
library(dplyr)
library(shiny)
library(reshape2)
ui <- fluidPage(
mainPanel(
titlePanel("Metals"),
leafletOutput("all_metals")
)
)
server <- function(input,output){
output$all_metals <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
## melt df so 'metals' are in one column
## using 'reshape2' library
meuse_melt <- melt(meuse_df, measure.vars = c("copper","lead","zinc"), variable.name = "metal")
## specify factor levels for colours
meuse_melt$metal <- factor(sample.int(5L, nrow(meuse_melt), TRUE))
factpal <- colorFactor(topo.colors(5), meuse_melt$metal)
## now you just need one output
leaflet(meuse_melt) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~value/100,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_melt",
popup = ~metal,
color= ~factpal(metal)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap", "Esri.WorldImagery"), overlayGroups = "meuse_melt")
})
}
shinyApp(ui = ui, server = server)
To save you lines of code you could use mapview which provides multi-layer maps out of the box. If you only want certain attributes you can simply supply their names (or column numbers) to the 'zcol' argument. Alternatively, you can use 'burst = TRUE' to display all layers/columns present in the attribute table.
library(mapview)
library(sp)
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
mapview(meuse, zcol = c("copper", "lead", "zinc"))
## all layers
mapview(meuse, burst = TRUE)
mapview can be used with renderLeaflet.

Popup when hover with leaflet in R?

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!!

Resources