R Leaflet - use date or character legend labels with colorNumeric() palette
From the leaflet page on legends:
You can also conveniently customize the label appearance by passing labFormat=labelFormat(). labelFormat() has parameters that customize the separator between ranges, the number of digits to render, and prefix/suffix for each label. If your label formatting needs extend beyond what labelFormat() can provide, you can also use a custom function as the labFormat argument; see the Details section in ?addLegend for a description.
Therefore, we can modify the source code for the labelFormat
function to include a custom function to convert dates
myLabelFormat = function(
prefix = '', suffix = '', between = ' – ', digits = 3, big.mark = ',',
transform = identity, dates = FALSE ## new 'dates' argument
) {
formatNum = function(x) {
format(
round(transform(x), digits), trim = TRUE, scientific = FALSE,
big.mark = big.mark
)
}
## added 'formatDate' function
formatDate = function(x) {
d = as.Date(x, origin="1970-01-01")
}
function(type, ...) {
switch(
type,
numeric = (function(cuts) {
if(dates){
## will format numbers into dates if dates == TRUE
paste0(formatDate(cuts))
}else{
paste0(prefix, formatNum(cuts), suffix)
}
})(...),
bin = (function(cuts) {
n = length(cuts)
paste0(prefix, formatNum(cuts[-n]), between, formatNum(cuts[-1]), suffix)
})(...),
quantile = (function(cuts, p) {
n = length(cuts)
p = paste0(round(p * 100), '%')
cuts = paste0(formatNum(cuts[-n]), between, formatNum(cuts[-1]))
# mouse over the legend labels to see the values (quantiles)
paste0(
'<span title="', cuts, '">', prefix, p[-n], between, p[-1], suffix,
'</span>'
)
})(...),
factor = (function(cuts) {
paste0(prefix, as.character(transform(cuts)), suffix)
})(...)
)
}
}
Which, as @Nice points out can be shortened to
myLabelFormat = function(...,dates=FALSE){
if(dates){
function(type = "numeric", cuts){
as.Date(cuts, origin="1970-01-01")
}
}else{
labelFormat(...)
}
}
With this new function we can call it as normal
data = structure(list(timestamp = structure(c(1434056453, 1434148216, 1434153635, 1434245436, 1434358840,
1434364288, 1434369611, 1434461435, 1434466830, 1434558725), class = c("POSIXct", "POSIXt"), tzone = ""),
lon = c(-119.8777, -119.9614, -119.8769, -119.8775, -120.2283,
-120.2285, -119.8429, -120.0954, -120.3957, -120.4421),
lat = c(34.4041,34.376, 34.4061, 34.4021, 34.4696,
34.4697, 34.1909, 34.4328, 34.4554, 34.4456),
ID = as.factor(c("Z11","Z05","Z01", "Z04", "Z11", "Z04","Z01","Z05","Z05","Z11"))),
.Names = c("timestamp", "lon", "lat", "ID"),
row.names = c(1:10),
class = "data.frame")
data$julian <- as.numeric(as.Date(data$timestamp))
library(leaflet)
pal = colorNumeric( palette = rainbow(7), domain = data$julian)
m = leaflet(data)
m %>% addTiles() %>%
addCircles(~lon, ~lat, color = ~pal(julian)) %>%
addLegend("bottomright", pal = pal, values = ~julian,
title = "Time", opacity = 1,
labFormat = myLabelFormat(dates=TRUE))
How put labels in the palette of leaflet instead of numeric values
You need the labFormat
argument, instead of labels. In ?addLegend
you have an explanation.
This works as you want:
library(leaflet)
df <- data.frame(x = rnorm(100), y = rexp(100, 2), z = runif(100))
pal <- colorBin("PuOr", df$z, bins = c(0, .1, .4, .9, 1))
labeller_function <- function(type, breaks) {
return(c('A', 'B', 'C', 'D'))
}
leaflet(df) %>%
addTiles() %>%
addCircleMarkers(~x, ~y, color = ~pal(z), group = "circles") %>%
addLegend(pal = pal, values = ~z, group = "circles", position = "bottomleft",
labFormat = labeller_function) %>%
addLayersControl(overlayGroups = c("circles"))
Manually adding legend values in leaflet
You could change it from a yellow -> purple scale and make your own scale:
map %>%
addLegend("bottomright",
colors = c("#FFC125", "#FFC125", "#8A4117", "#7D0552", "#571B7E"),
labels = c("less", "", "", "", "more"),
title = "(e.g.) % voting UKIP at GE2015",
opacity = 1)
If you get the correct colors then it should look similar. Not the answer you were looking for, but it's a good workaround. Your output would look like this:
Spend more time looking for better color transition and you could get a legend that looks similar to the yellow-purple color pallet you have up top.
Create Custom Labels in Leaflet Legend
The labels argument are a vector of text labels in the legend corresponding to colors argument rather than pal argument within addLegend()
library(rgdal)
# From http://data.okfn.org/data/datasets/geo-boundaries-world-110m
countries <- readOGR("https://rstudio.github.io/leaflet/json/countries.geojson")
map <- leaflet(countries) %>% addTiles()
pal <- colorNumeric(
palette = "YlGnBu",
domain = countries$gdp_md_est
)
map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~pal(gdp_md_est)
) %>%
addLegend("bottomright", colors = c('red', 'orange', 'yellow', 'green', 'blue'), values = ~gdp_md_est,
title = "Est. GDP (2010)",
labels = c("Less Dense", "", "", "", "More Dense"),
opacity = 1
)
This example uses sample data, because I could not access your data
reverse order in R leaflet continuous legend
Unfortunately the accepted answer to this will get the numbers out of alignment (in fact exactly reversed) from the colours they represent.
Here's the original proposed solution, which I say is incorrect:
map <- leaflet() %>% addProviderTiles('Esri.WorldTopoMap')
x <- 1:100
pal <- colorNumeric(c("#d7191c","#fdae61","#ffffbf","#abd9e9", "#2c7bb6"), x)
map %>% addLegend('topright', pal=pal, values=x)
# This solution shows 100 as red
map %>% addLegend('topright',
pal = pal,
values = x,
labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE)))
But if you've been using the pal()
function to draw anything on your map, you now have it exactly wrong.
# But 100 is blue, not red
plot(1, 1, pch = 19, cex = 3, col = pal(100))
I think the solution is to define to functions that allocate colours to numbers, one in reverse for the legend, and one for actually drawing things:
pal_rev <- colorNumeric(c("#d7191c","#fdae61","#ffffbf","#abd9e9", "#2c7bb6"), x, reverse = TRUE)
map %>% addLegend('topright',
pal = pal_rev,
values = x,
labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE)))
This gives us a legend that matches anything we will have drawn ie 100 is now correctly shown to be blue:
Leaflet: Mixing continuous and discrete colors
Since the sample above is not enough to have a demonstration, I decided to use one of the dummy data that I used for other leaflet related questions. I hope you do not mind that. Given what you said, you need to create two layers in your map. One for a continuous variable, and the other for a discrete variable. This means that you need to create two sets of colors. As you used, you want to use colorNumeric()
for the continuous variable. You want to use colorFactor()
for the discrete variable. In my sample code, I create a new discrete variable called group
. Once you finish creating the color palettes, you want to draw a map. You need to use addPolygons()
twice. Make sure that you use group
. This is going to appear in the layer control button on the right upper corner. As far as I know, we cannot display one legend only at the moment. I came across this issue before and concluded that we have no choice at the moment. I hope this demonstration is enough for you to make a progress in your task.
library(raster)
library(dplyr)
library(leaflet)
# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)
### 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 a new dummy column for a discrete variable.
mydf <- mutate(mydf, group = cut(value, breaks = c(0, 200, 400, 600, 800, 1000),
labels = c("a", "b", "c", "d", "e"),
include.lowest = TRUE))
### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = mydf$value, na.color = "black")
dispal <- colorFactor("Spectral", domain = mydf$group, na.color = "black")
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK, group = "continuous",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~conpal(mydf$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$value, "<br>")) %>%
addPolygons(data = UK, group = "discrete",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~dispal(mydf$group),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = mydf$value,
title = "UK value",
opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = mydf$group,
title = "UK group",
opacity = 0.3)
If you choose the continuous-variable layer, you will see the following map.
If you choose the discrete-variable layer, you will see the following map.
Update
If you want to show both a continuous group and a continuous group together, you need to subset your data beforehand so that there is no overlapping in polygons. Using UK
and mydf
above, you can try something like this.
### Subset data and create two groups. This is something you gotta do
### in your own way given I have no idea of your own data.
con.group <- mydf[1:96, ]
dis.group <- mydf[97:192, ]
### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = c(min(mydf$value), max(mydf$value)), na.color = "black")
dispal <- colorFactor(palette = "Reds", "Spectral", levels = unique(mydf$group), na.color = "black")
### Subset the polygon data as well
con.poly <- subset(UK, NAME_2 %in% con.group$place)
dis.poly <- subset(UK, NAME_2 %in% dis.group$place)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = con.poly, group = "continuous",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~conpal(con.group$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", con.group$value, "<br>")) %>%
addPolygons(data = dis.poly, group = "discrete",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~dispal(dis.group$group),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Group: ", dis.group$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = con.group$value,
title = "UK value",
opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = dis.group$group,
title = "UK group",
opacity = 0.3)
Related Topics
What Is the Internal Implementation of Lists
Specify Position of Geom_Text by Keywords Like "Top", "Bottom", "Left", "Right", "Center"
How to Speed Up or Vectorize a for Loop
Drawing a Stratified Sample in R
Finding the Index of a Max Value in R
Error When Plotting Sf Object --- Error: Could Not Find Function "Geom_Sf"
R Issue with Rounding Milliseconds
R - Compute Cross Product of Vectors (Physics)
Makecluster Function in R Snow Hangs Indefinitely
Collapse a Data.Frame into a Vector
How to Multiply a Single Column in a Data.Frame by a Number
User Defined Colour Palette in R and Ggpairs
Merge Records Over Time Interval
How to Rename Element's List Indexed by a Loop in R
A Vector to an Upper Triangle Matrix by Row in R