From a66eb0e82a8b6e139b80a03870ea43cc96b175e6 Mon Sep 17 00:00:00 2001 From: Thomas Roh Date: Thu, 4 Jan 2024 10:30:02 -0800 Subject: [PATCH 1/4] adding ex --- inst/examples/examples.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/inst/examples/examples.R b/inst/examples/examples.R index 48ae510..2cf3640 100644 --- a/inst/examples/examples.R +++ b/inst/examples/examples.R @@ -653,7 +653,11 @@ leaflet(quakes) %>% strokeWidth = 2) - +library(leaflet) +library(leaflegend) +data("quakes") +baseSize <- 5 +numPal <- colorNumeric('viridis', 10^(quakes$mag)) leaflet(quakes) |> addTiles() |> addLegendSize( From 73a09b89e57e8c33e462c14bde605f253120640f Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Fri, 15 Mar 2024 09:51:45 -0400 Subject: [PATCH 2/4] Fix partial match --- R/legend.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/legend.R b/R/legend.R index c128e27..12dc335 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1511,7 +1511,7 @@ makeGradient <- function(breaks, colors, height, width, id, fillOpacity, curvePercent <- ifelse(shape == 'stadium', '10%', '0') if (orientation == 'vertical') { htmltools::tagList( - htmltools::tags$def( + htmltools::tags$defs( htmltools::tags$linearGradient( id = id, x1 = 0, y1 = 0, x2 = 0, y2 = 1, @@ -1528,7 +1528,7 @@ makeGradient <- function(breaks, colors, height, width, id, fillOpacity, ) } else { htmltools::tagList( - htmltools::tags$def( + htmltools::tags$defs( htmltools::tags$linearGradient( id = id, x1 = 0, y1 = 0, x2 = 1, y2 = 0, From 642cee09047017f9aaab8243e9f9f0725f862c96 Mon Sep 17 00:00:00 2001 From: Thomas Roh Date: Thu, 2 May 2024 10:28:33 -0700 Subject: [PATCH 3/4] adding in manual color numeric breaks --- R/legend.R | 26 ++++++++---- inst/examples/examples.R | 91 ++++++++++++++++++++++++++++++++++++++++ man/addLeafLegends.Rd | 3 +- 3 files changed, 111 insertions(+), 9 deletions(-) diff --git a/R/legend.R b/R/legend.R index 12dc335..46289bf 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1173,7 +1173,8 @@ addSymbolsSize <- function( #' @param bins #' #' an approximate number of tick-marks on the color gradient for the -#' colorNumeric palette +#' colorNumeric palette if it is of length one; you can also provide a +#' numeric vector as the pre-defined breaks #' #' @param title #' @@ -1445,20 +1446,29 @@ addLegendNumeric <- function(map, length(map[["x"]][["calls"]]) + 1) values <- parseValues(values = values, data = data) rng <- range(values, na.rm = TRUE) - breaks <- pretty(values, bins) + bins <- parseValues(values = bins, data = data) + if (length(bins) > 1) { + if (!all(bins >= rng[1] & bins <= rng[2])) { + stop('Bins are outside range of values.') + } + breaks <- sort(c(rng, bins)) + } else { + breaks <- pretty(values, bins) + } if (breaks[1] < rng[1]) { breaks[1] <- rng[1] } if (breaks[length(breaks)] > rng[2]) { breaks[length(breaks)] <- rng[2] } - colors <- pal(breaks) hasNa <- any(is.na(values)) orientation <- match.arg(orientation) isVertical <- as.integer(orientation == 'vertical') isHorizontal <- as.integer(orientation == 'horizontal') + offsets <- seq(rng[1], rng[2], length.out = 10) if (decreasing) { breaks <- rev(breaks) + offsets <- rev(offsets) stdBreaks <- (1 - (breaks - rng[1]) / diff(rng)) * (height * isVertical + width * isHorizontal) } else { @@ -1481,9 +1491,9 @@ addLegendNumeric <- function(map, orientation = orientation) tickText <- makeTickText(labels = labels, breaks = stdBreaks[i], width = width, height = height, orientation = orientation) - svgGradient <- makeGradient(breaks = breaks, colors = colors, - height = height, width = width, id = id, fillOpacity = fillOpacity, - orientation = orientation, shape) + svgGradient <- makeGradient(breaks = offsets, + pal = pal,height = height, width = width, id = id, + fillOpacity = fillOpacity, orientation = orientation, shape) htmlElements <- assembleLegendWithTicks( width = width + (isVertical * tickLength * 2), height = height + (isHorizontal * tickLength * 2), @@ -1501,11 +1511,11 @@ addLegendNumeric <- function(map, group = group, ...) } -makeGradient <- function(breaks, colors, height, width, id, fillOpacity, +makeGradient <- function(breaks, pal, height, width, id, fillOpacity, orientation, shape) { stops <- (breaks - min(breaks)) / (max(breaks) - min(breaks)) - colors <- colors[order(stops)] + colors <- pal(breaks)[order(stops)] stops <- sort(stops) offsets <- sprintf('%.03f%%', 100 * stops) curvePercent <- ifelse(shape == 'stadium', '10%', '0') diff --git a/inst/examples/examples.R b/inst/examples/examples.R index 2cf3640..67e80d2 100644 --- a/inst/examples/examples.R +++ b/inst/examples/examples.R @@ -835,3 +835,94 @@ leaflet::leaflet(options = leaflet::leafletOptions(zoomControl = FALSE)) |> width = defaultSize, height = defaultSize, position = 'topright') |> addLegendImage(images = pchSvgI, labels = i-1, width = defaultSize, height = defaultSize, position = 'topleft') + +# Test Pre-defined Bins colorNumeric -------------------------------------- +library(leaflet) +data("quakes") +numPal <- colorNumeric('viridis', quakes$mag) +leaflet(quakes) %>% + addTiles() %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + position = 'topright', + orientation = 'horizontal', + shape = 'rect', + decreasing = FALSE, + height = 20, + width = 100 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + bins = c(5,6), + position = 'topright', + orientation = 'horizontal', + shape = 'rect', + decreasing = FALSE, + height = 20, + width = 100 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + bins = ~range(mag), + position = 'topright', + orientation = 'horizontal', + shape = 'rect', + decreasing = FALSE, + height = 20, + width = 100 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + position = 'topright', + orientation = 'vertical', + title = 'Default', + shape = 'rect', + decreasing = FALSE, + height = 100, + width = 20 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + bins = seq(4, 6.4, length.out = 5), + numberFormat = function(x) sprintf('%.2f', x), + position = 'topright', + orientation = 'vertical', + title = htmltools::div('Manual Breaks', style ='margin-bottom:10px'), + shape = 'rect', + decreasing = TRUE, + height = 100, + width = 20 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + bins = ~range(mag), + position = 'topright', + orientation = 'vertical', + title = htmltools::div('Min/Max w/ Formula', style ='margin-bottom:10px'), + numberFormat = function(x) sprintf('%.2f', x), + shape = 'rect', + decreasing = FALSE, + height = 100, + width = 20 + ) %>% + addLegendNumeric( + pal = numPal, + values = ~mag, + bins = c(4, 5.2, 6.4), + position = 'topright', + orientation = 'vertical', + labels = c('Low', 'Mid', 'High'), + title = htmltools::div('Labels', style ='margin-bottom:10px'), + numberFormat = function(x) sprintf('%.2f', x), + shape = 'rect', + decreasing = TRUE, + height = 100, + width = 20 + ) + diff --git a/man/addLeafLegends.Rd b/man/addLeafLegends.Rd index 74c4771..3a2b1ca 100644 --- a/man/addLeafLegends.Rd +++ b/man/addLeafLegends.Rd @@ -120,7 +120,8 @@ addLegendFactor( \item{height}{in pixels} \item{bins}{an approximate number of tick-marks on the color gradient for the -colorNumeric palette} +colorNumeric palette if it is of length one; you can also provide a +numeric vector as the pre-defined breaks} \item{numberFormat}{formatting functions for numbers that are displayed e.g. format, prettyNum} From 3e01a41ae565756472ff6630ddca1ebc3c2f9809 Mon Sep 17 00:00:00 2001 From: Thomas Roh Date: Fri, 3 May 2024 09:47:09 -0700 Subject: [PATCH 4/4] adding tests --- DESCRIPTION | 2 +- NEWS.md | 6 ++++++ R/legend.R | 15 +++++---------- tests/testthat/test-legend.R | 17 ++++++++++++++++- 4 files changed, 28 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1245a66..94ef768 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: leaflegend Type: Package Title: Add Custom Legends to 'leaflet' Maps -Version: 1.2.0 +Version: 1.2.1 Authors@R: c( person("Thomas", "Roh", email = "thomas@roh.engineering", role = c("aut", "cre")), person("Ricardo Rodrigo", "Basa", email = "radbasa@gmail.com", role = c("ctb"))) diff --git a/NEWS.md b/NEWS.md index fca753d..c01eaad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# leaflegend 1.2.1 + +* `addLegendNumeric` now has the ability to use manual tick breaks and labels +when the `bins` argument is a numeric vector greater than length 1. This +only applies to vertically oriented legends. + # leaflegend 1.2.0 * `addLegendNumeric` gains `labelStyle` argument and significant improvements diff --git a/R/legend.R b/R/legend.R index 46289bf..9f4da0a 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1106,8 +1106,7 @@ addSymbols <- function( leaflet::addMarkers(map = map, lng = lng, lat = lat, icon = iconSymbols, data = data, ...) } else { - leaflet::addMarkers(map = map, icon = iconSymbols, - data = data, ...) + leaflet::addMarkers(map = map, icon = iconSymbols, data = data, ...) } } #' @export @@ -1142,10 +1141,9 @@ addSymbolsSize <- function( fillOpacity = fillOpacity, strokeWidth = strokeWidth, width = sizes, data = data, ...) } else { - addSymbols(map = map, shape = shape, color = color, - fillColor = fillColor, opacity = opacity, - fillOpacity = fillOpacity, strokeWidth = strokeWidth, - width = sizes, data = data, ...) + addSymbols(map = map, shape = shape, color = color, fillColor = fillColor, + opacity = opacity, fillOpacity = fillOpacity, strokeWidth = strokeWidth, + width = sizes, data = data, ...) } } @@ -1658,11 +1656,8 @@ addLegendQuantile <- function(map, probs <- attr(pal, 'colorArgs')[['probs']] values <- parseValues(values = values, data = data) if ( is.null(numberFormat) ) { - labels <- sprintf(' %3.0f%%%s%3.0f%%', - probs[-length(probs)] * 100, - between, + 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) diff --git a/tests/testthat/test-legend.R b/tests/testthat/test-legend.R index 0d8322c..8214df6 100644 --- a/tests/testthat/test-legend.R +++ b/tests/testthat/test-legend.R @@ -495,10 +495,21 @@ testthat::test_that('Numeric Legend', { tickWidth = -1) %>% testthat::expect_error() # test results - numVert <- m %>% addLegendNumeric(pal = pal, values = c(1, NA, 3)) + numVert <- m %>% addLegendNumeric(pal = pal, values = c(1, NA, 3), + decreasing = TRUE) numHori <- m %>% addLegendNumeric(pal = pal, values = c(1, NA, 3), orientation = 'horizontal', width = 100, height = 20) + numVert %>% + testthat::expect_no_error() + numHori %>% + testthat::expect_no_error() + m %>% + addLegendNumeric(pal = pal, values = ~x, bins = c(10, 11)) %>% + testthat::expect_error() + m %>% + addLegendNumeric(pal = pal, values = ~x, bins = c(1, 3)) %>% + testthat::expect_no_error() # numVert %>% # getElement('x') %>% # getElement('calls') %>% @@ -629,6 +640,10 @@ testthat::test_that('Categorical Legends', { values = ~x, numberFormat = 'fun') %>% testthat::expect_error() + m %>% addLegendQuantile(pal = palQuantile, + values = ~x, + numberFormat = NULL) %>% + testthat::expect_no_error() # test Bin args m %>% addLegendBin(pal = palBin, orientation = 'up') %>%