rstudio / leaflet

R Interface to Leaflet Maps
http://rstudio.github.io/leaflet/
Other
800 stars 508 forks source link

Add option to reverse order of legend #256

Open azvoleff opened 8 years ago

azvoleff commented 8 years ago

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 commented 5 years ago

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

ateucher commented 5 years ago

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 commented 5 years ago

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 commented 5 years ago

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

ateucher commented 5 years ago

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

mpriem89 commented 5 years ago

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 commented 5 years ago

Thank you @mpriem89 - this is amazing.

jamiecmontgomery commented 4 years ago

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

fawda123 commented 4 years ago

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

kaijagahm commented 4 years ago

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

markhwhiteii commented 3 years ago

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 commented 3 years ago

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.

fernandoroa commented 2 years ago

Maybe using 2 pals, the pal_hack only for addLegend:

pal_hack <- colorNumeric(
  reverse = TRUE,
  palette = "Blues",
  domain = c(0,100)
  , alpha = TRUE,
)

pal <- colorNumeric(
  palette = "Blues",
  domain = c(0,100)
  , alpha = TRUE,
)

In addition:
labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE) )
Harry-Long commented 1 year ago

Maybe using 2 pals, the pal_hack only for addLegend:

pal_hack <- colorNumeric(
  reverse = TRUE,
  palette = "Blues",
  domain = c(0,100)
  , alpha = TRUE,
)

pal <- colorNumeric(
  palette = "Blues",
  domain = c(0,100)
  , alpha = TRUE,
)

In addition:
labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE) )

Wow, smart trick! Thanks @fernandoroa! This works perfect for me!

derekouyang commented 3 months ago

I'd like to flag that I don't think any of the solutions presented here work robustly. I'll explain my case which should be easy to reproduce. My data ranges from 0 to 93. When I do a colorNumeric() palette and plot this, the legend shows, top to bottom, light to dark, and there are automated ticks for 0, 20, 40, 60, 80. The darkest blue is beyond 80, as expected because my max value is 93. Then I try any of the suggestions above, which all essentially flip the bar itself and flip the labels on the ticks. But the result is that the tick for 80 is at the top of the bar, and the blue captured there is not the darkest blue that is on the map itself, i.e., the legend appears to truncate colors above 80.