tomroh / leaflegend

Provides extensions to the leaflet R package to customize legends with images, text styling, orientation, sizing, and symbology.
https://leaflegend.delveds.com
Other
34 stars 3 forks source link

Change label format of addLegendQuantile() ? #84

Closed shahreyar-abeer closed 4 months ago

shahreyar-abeer commented 4 months ago

First of all thank you for this great package!

At the moment, addLegendQuantile() labels have a default formatting. It can either be one of the two types as in the screenshot. I want to make the labels with only the values and not show the percentage. So the labels will be

in the example below. Is this possible?

image
tomroh commented 4 months ago

For that type of customization, it is better to use addLegendFactor with your customized binning:

breaks <- quantile(x = 1:10, probs = seq(0, 1, .25))
cut(1:10, breaks, labels = 
    sprintf('(%s-%s)', breaks[-length(breaks)], breaks[-1]), 
  include.lowest = TRUE)
shahreyar-abeer commented 4 months ago

I see. Thanks for the quick response.

I have created a custom addLegendQuantile() function with labels like I want and am using that function. This is how it looks.

addLegendQuantile <- function(
    map,
    pal,
    values,
    title = NULL,
    labelStyle = '',
    shape = 'rect',
    orientation = c('vertical', 'horizontal'),
    width = 24,
    height = 24,
    numberFormat = function(x) {
      prettyNum(x, big.mark = ',', scientific = FALSE,
                digits = 1)
    },
    opacity = 1,
    fillOpacity = opacity,
    group = NULL,
    className = 'info legend leaflet-control',
    naLabel = 'NA',
    between = ' - ',
    data = leaflet::getMapData(map),
    ...
) {
  stopifnot( attr(pal, 'colorType') == 'quantile' )
  stopifnot( width >= 0 && height >= 0 )
  orientation <- match.arg(orientation)
  probs <- attr(pal, 'colorArgs')[['probs']]
  values <- leaflegend:::parseValues(values = values, data = data)
  if ( is.null(numberFormat) ) {
    labels <- sprintf(' %3.0f%%%s%3.0f%%', probs[-length(probs)] * 100, between,
                      probs[-1] * 100)
  } else {
    breaks <- stats::quantile(x = values, probs = probs, na.rm = TRUE)
    labels <- numberFormat(breaks)
    labels <- glue("{labels[-length(labels)]} - {labels[-1]}")

  }
  colors <- unique(pal(sort(values)))
  htmlElements <- leaflegend:::makeLegendCategorical(shape = shape, labels = labels,
                                                     colors = colors,
                                                     labelStyle = labelStyle,
                                                     height = height, width = width,
                                                     opacity = opacity,
                                                     fillOpacity = fillOpacity,
                                                     orientation = orientation,
                                                     title = title,
                                                     hasNa = any(is.na(values)),
                                                     naLabel = naLabel,
                                                     naColor = pal(NA))
  leaflegend:::leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                                    className = className, group = group, ...)
}