Leaflet: Add option to reverse order of legend

[azvoleff]

I can't find a way to reverse the legend order - is there a way to swap the maximum and minimum values on the legend, so, for example, instead of a vertical legend increasing in value from top to bottom as in the examples here, it would increase from bottom to top?

[jamiecmontgomery]

This would be a great feature - any chance this will be added in the near future?

[ateucher]

Based on this stackoverflow answer, I think this is probably the easiest way to do this right now - pass a custom sort function to the transform argument in labelFormat, and wrap the pal call with rev in addCircleMarkers():

library(sf)
library(sp)
library(leaflet)

data(meuse)
pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) %>% 
  st_transform(4326)

pal <- colorNumeric(
  palette = "YlGnBu",
  domain = pts$cadmium
)

leaflet(pts) %>% 
  addTiles() %>% 
  addCircleMarkers(color = ~rev(pal(cadmium))) %>% 
  addLegend(pal = pal, values = ~cadmium, 
            labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE)))

[jamiecmontgomery]

Thanks @ateucher - I did use that suggested fix but it only swaps the labels, not the associated colors. I'd like both the labels and the color ramps to flip...

[ateucher]

Oh darn you're right! That's not helpful at all...

[ateucher]

@jafflerbach I edited my above comment to add a rev() around the pal() call in addCircleMarkers()... Does that get it closer?

[mpriem89]

Hey everyone, I faced the same issue. My workaround solution was to write my own addLegend() function. It builds on the function from the leaflet R package and adds the option to display the labels and corresponding colors in deceasing order:

addLegend_decreasing <- function (map, position = c("topright", "bottomright", "bottomleft", 
                "topleft"), pal, values, na.label = "NA", bins = 7, colors, 
          opacity = 0.5, labels = NULL, labFormat = labelFormat(), 
          title = NULL, className = "info legend", layerId = NULL, 
          group = NULL, data = getMapData(map), decreasing = FALSE) {
    position <- match.arg(position)
    type <- "unknown"
    na.color <- NULL
    extra <- NULL
    if (!missing(pal)) {
        if (!missing(colors)) 
            stop("You must provide either 'pal' or 'colors' (not both)")
        if (missing(title) && inherits(values, "formula")) 
            title <- deparse(values[[2]])
        values <- evalFormula(values, data)
        type <- attr(pal, "colorType", exact = TRUE)
        args <- attr(pal, "colorArgs", exact = TRUE)
        na.color <- args$na.color
        if (!is.null(na.color) && col2rgb(na.color, alpha = TRUE)[[4]] == 
            0) {
            na.color <- NULL
        }
        if (type != "numeric" && !missing(bins)) 
            warning("'bins' is ignored because the palette type is not numeric")
        if (type == "numeric") {
            cuts <- if (length(bins) == 1) 
                pretty(values, bins)
            else bins   

            if (length(bins) > 2) 
                if (!all(abs(diff(bins, differences = 2)) <= 
                         sqrt(.Machine$double.eps))) 
                    stop("The vector of breaks 'bins' must be equally spaced")
            n <- length(cuts)
            r <- range(values, na.rm = TRUE)
            cuts <- cuts[cuts >= r[1] & cuts <= r[2]]
            n <- length(cuts)
            p <- (cuts - r[1])/(r[2] - r[1])
            extra <- list(p_1 = p[1], p_n = p[n])
            p <- c("", paste0(100 * p, "%"), "")
            if (decreasing == TRUE){
                colors <- pal(rev(c(r[1], cuts, r[2])))
                labels <- rev(labFormat(type = "numeric", cuts))
            }else{
                colors <- pal(c(r[1], cuts, r[2]))
                labels <- rev(labFormat(type = "numeric", cuts))
            }
            colors <- paste(colors, p, sep = " ", collapse = ", ")

        }
        else if (type == "bin") {
            cuts <- args$bins
            n <- length(cuts)
            mids <- (cuts[-1] + cuts[-n])/2
            if (decreasing == TRUE){
                colors <- pal(rev(mids))
                labels <- rev(labFormat(type = "bin", cuts))
            }else{
                colors <- pal(mids)
                labels <- labFormat(type = "bin", cuts)
            }

        }
        else if (type == "quantile") {
            p <- args$probs
            n <- length(p)
            cuts <- quantile(values, probs = p, na.rm = TRUE)
            mids <- quantile(values, probs = (p[-1] + p[-n])/2, 
                 na.rm = TRUE)
            if (decreasing == TRUE){
                colors <- pal(rev(mids))
                labels <- rev(labFormat(type = "quantile", cuts, p))
            }else{
                colors <- pal(mids)
                labels <- labFormat(type = "quantile", cuts, p)
            }
        }
        else if (type == "factor") {
            v <- sort(unique(na.omit(values)))
            colors <- pal(v)
            labels <- labFormat(type = "factor", v)
            if (decreasing == TRUE){
                colors <- pal(rev(v))
                labels <- rev(labFormat(type = "factor", v))
            }else{
                colors <- pal(v)
                labels <- labFormat(type = "factor", v)
            }
        }
        else stop("Palette function not supported")
        if (!any(is.na(values))) 
            na.color <- NULL
    }
    else {
        if (length(colors) != length(labels)) 
            stop("'colors' and 'labels' must be of the same length")
    }
    legend <- list(colors = I(unname(colors)), labels = I(unname(labels)), 
                   na_color = na.color, na_label = na.label, opacity = opacity, 
                   position = position, type = type, title = title, extra = extra, 
                   layerId = layerId, className = className, group = group)
    invokeMethod(map, data, "addLegend", legend)
}

[iwensu0313]

Thank you @mpriem89 - this is amazing.

[jamiecmontgomery]

Thank you @mpriem89 !! This just saved me hours of work and does exactly what I need it to.

[fawda123]

@mpriem89 this is great but I don't think the tick positions are shifted correctly, just the color palette and label order directions.

[kaijagahm]

@mpriem89 I'm just finding this now: thanks for writing this function! It's extremely helpful.

[markhwhiteii]

Is there any update here? The function @mpriem89 wrote isn't working for me, maybe because I'm using addPolygons?

pal <- colorNumeric(
  palette = "viridis",
  domain = map_data$x
)

leaflet(map_data) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addPolygons(
    fillColor = ~pal(x),
    color = "#b2aeae",
    fillOpacity = 0.7, 
    weight = 1, 
    smoothFactor = 0.2
  ) %>%
  addLegend_decreasing(
    pal = pal,
    values = ~x, 
    position = "bottomright"
  )

This reverses the text labels but doesn't do the colors.

[jfunction]

I am experiencing the same issue as @markhwhiteii - not sure why the default is to increase downwards and there's no option to change it. I think the best workaround will be to manually plot reversed colours and to reverse the text labels also - though it feels like a hack and I worry about edge cases.