R Leaflet - Use Date or Character Legend Labels with Colornumeric() Palette

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

Sample Image

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:

Sample Image

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

sample

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

Sample Image

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

Sample Image

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:

Sample Image

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.

Sample Image

If you choose the discrete-variable layer, you will see the following map.

Sample Image

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)

Sample Image



Related Topics



Leave a reply



Submit