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.
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 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")}
})
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!!
When I try to add a legend to a leaflet map for a leaflet map (using the Leaflet for R package) incorporated into a Shiny app, the legend does not show the colors of the color palette. Instead it only shows the colors specified for the NA values, in this case, white.
The app does the following:
First, it filters a set of data based on user inputs
Then it generates a choropleth map from the filtered data
This is the code I used to make the legend:
addLegend(position = "bottomleft",
pal = pal, values = shp.data()$stat.selected,
title = "Legend",
opacity = .5)
Where pal is a quantile color palette as follows
pal <-colorQuantile(c("#B2FF66","#66CC00","#4C9900","#336600","#193300"),
NULL, n = 5, na.color="#FFFFFF")
shp.data() is a reactive expression that is a shapefile filtered based on user inputs and stat_selected is the specific statistic that the user selects for mapping onto colors.
I get the following warnings:
Warning in is.na(x) :
is.na() applied to non-(list or vector) of type 'NULL'
Warning in is.na(values) :
is.na() applied to non-(list or vector) of type 'NULL'
I initially tried to make the legend following the example on the leaflet for R page and used the argument values = ~stat.selected for the addLegend function, but I got this error:
Error in UseMethod("doResolveFormula") :
no applicable method for 'doResolveFormula' applied to an object of class "NULL"
Earlier I had just a simple snippet that showed how to add legends. I did not use the ~ before the legend values as is the norm. I did the traditional dataframe$column and it works nicely.
This is now updated to see how it all fits together. Here is a full-fledged mapping run after creating all of the variable cuts, etc. The final cleansed data frame was called zipData
# create a full popup
# add some HTML for editing the styles
zipData$popUp <- paste('<strong>',zipData$Street, '</strong><br>',
'TIV = $',prettyNum(zipData$tiv, big.mark = ',',preserve.width = 'none'), '<br>',
'City: ', zipData$city, '<br>',
'YrBuilt = ', zipData$YearBuilt, '<br>',
'Construction = ', zipData$ConstructionCode, '<br>',
'Occupancy = ', zipData$OccupancyCode, '<br>',
'Premium = $' , prettyNum(zipData$Premium, big.mark = ',',preserve.width = 'none') , '<br>',
'GrossArea = ', prettyNum(zipData$GrossArea, big.mark = ',', preserve.width = 'none'), '<br>',
'RoofYr = ', zipData$RoofYearBuilt, '<br>')
# set color scale for key factor
colorsConst <- colorFactor(rainbow(4), zipData$ConstructionCode)
# color scales for numerical bins
colorstivValue <- colorFactor(palette = 'Accent', zipData$tivValueLvl)
colorsYrBuilt <- colorFactor(palette = 'Spectral', zipData$yrBuiltLvl)
colorsRoofYrBuilt <- colorFactor(palette = "YlOrRd", zipData$roofYrBuiltLvl)
# begin the leaflet map construction
# create the map opbject
m <- leaflet() %>%
addTiles() %>%
# add different tiles for different color schemes
addProviderTiles(providers$OpenStreetMap, group = 'Open SM') %>%
addProviderTiles(providers$Stamen.Toner, group = 'Toner') %>%
addProviderTiles(providers$CartoDB.Positron, group = 'CartoDB') %>%
addProviderTiles(providers$Esri.NatGeoWorldMap, group = 'NG World') %>%
setView(lng = -90, lat = 30, zoom = 10) %>%
##############################
# this section is for plotting the variables
# each variable below is a layer in the map
# construction
addCircleMarkers(data = zipData, lat = ~Lat, lng = ~Lon,
color = ~colorsConst(ConstructionCode), popup = zipData$popUp,
radius = 5, group = 'Construction') %>%
# tiv
addCircleMarkers(data = zipData, lat = ~Lat, lng = ~Lon,
color = ~colorstivValue(tivLvl), popup = zipData$popUp,
radius = ~tiv/20000, group = 'Bldg Value') %>%
# year built
addCircleMarkers(data = zipData, lat = ~Lat, lng = ~Lon,
color = ~colorsYrBuilt(yrBuiltLvl), popup = zipData$popUp,
radius = ~YearBuilt/250, group = 'Yr Built') %>%
######################################
# layer control
addLayersControl(
baseGroups = c('Open SM', 'Toner', 'Carto DB', 'NG World'),
overlayGroups = c('Construction',
'TIV',
'Yr Built'
),
options = layersControlOptions(collapsed = F)
) %>%
#################################################
add the legends for each of the variables
# construction
addLegend('bottomright', pal = colorsConst, values = zipData$ConstructionCode,
title = 'Construction Code',
opacity = 1) %>%
# tiv
addLegend('bottomleft', pal = colorstivValue, values = zipData$tivLvl,
title = 'TIV',
opacity = 1) %>%
# year built
addLegend('topleft', pal = colorsYrBuilt, values = zipData$yrBuiltLvl,
title = 'Yr Built',
opacity = 1)
m # Print the map
A portion of the map is shown below.
I was able to make the colors showing up by changing the way I was referencing the values column in the arguments of the AddLegend function. I put the stat.selected variable in double brackets, which seemed to fix the problem:
addLegend(position = "bottomleft",
pal = pal, values = shp.data()[[stat.selected]],
title = "Legend",
opacity = 1
)
For clarification, the stat.selected variable comes from the following switch statement:
stat.selected <- isolate(switch(input$var.stat,
"Total employment" = "tot_emp",
"Mean annual wage" = "a_mean",
"Mean hourly wage" = "h_mean",
"Location quotient" = "loc_quotient"
)
where "tot_emp", "a_mean", "h_mean", and "loc_quotient" are column names in the shp.data spatial polygons data frame.
I guess the problem was that I was trying to pass in the column name by variable using a $.
I'm still a fairly novice R user, so if anyone can explain why the example in the Leaflet for R documentation does not work in this case I would appreciate it.
I had the same message
Error in UseMethod("doResolveFormula") : no applicable method for 'doResolveFormula' applied to an object of class "NULL"
with
data <- data.frame(lng1 = c(1, 2, 3),
lng2 = c(2, 3, 4),
lat1 = c(1, 2, 3),
lat2 = c(2, 3, 4),
values = c(1, 2, 3))
pal_grid <- colorNumeric(palette = "YlGn", domain = data$values)
leaflet() %>%
addRectangles(lng1 = data$lng1, lat1 = data$lat1,
lng2 = data$lng2, lat2 = data$lat2,
fillColor = ~pal_grid(data$values),
fillOpacity = 0.2,
weight = 2, opacity = 0.5)
The solution is to provide to leaflet the data that you are using to create the element in the main call to leaflet() or in the call to any element that you add after that.
In the main call to leaflet():
data <- data.frame(lng1 = c(1, 2, 3),
lng2 = c(2, 3, 4),
lat1 = c(1, 2, 3),
lat2 = c(2, 3, 4),
values = c(1, 2, 3))
pal_grid <- colorNumeric(palette = "YlGn", domain = data$values)
leaflet(data = data) %>%
addRectangles(lng1 = data$lng1, lat1 = data$lat1,
lng2 = data$lng2, lat2 = data$lat2,
fillColor = ~pal_grid(data$values),
fillOpacity = 0.2,
weight = 2, opacity = 0.5)
At the moment of add elements:
data <- data.frame(lng1 = c(1, 2, 3),
lng2 = c(2, 3, 4),
lat1 = c(1, 2, 3),
lat2 = c(2, 3, 4),
values = c(1, 2, 3))
pal_grid <- colorNumeric(palette = "YlGn", domain = data$values)
leaflet() %>%
addRectangles(data = data,
lng1 = data$lng1, lat1 = data$lat1,
lng2 = data$lng2, lat2 = data$lat2,
fillColor = ~pal_grid(data$values),
fillOpacity = 0.2,
weight = 2, opacity = 0.5)`