From a9d10b33eaecee456cd3507ec65996b046b1053e Mon Sep 17 00:00:00 2001 From: Derek Friend Date: Sat, 23 Nov 2024 21:45:51 -0600 Subject: [PATCH] make 'changeColors()' work on a legend --- R/changeColors.R | 82 +++++++++++++++---- .../lib/gradientmaps/changeColors.js | 4 +- .../lib/gradientmaps/gradientmaps.js | 17 ++-- man/changeColors.Rd | 36 +++++++- 4 files changed, 109 insertions(+), 30 deletions(-) diff --git a/R/changeColors.R b/R/changeColors.R index 8db4583..b26641f 100644 --- a/R/changeColors.R +++ b/R/changeColors.R @@ -31,17 +31,30 @@ changeColorsDependencies <- function() { #' uses the 'gradientmap' JavaScript library to change the color scheme on the #' fly #' @param map a mapview or leaflet object. -#' @param className character; the class name to apply the color-change to. The -#' layer(s) must have had this class name assigned to it; see examples +#' @param className character vector; one or more class names to apply the +#' color-change to. The layer(s) must have had this class name assigned to it; +#' see examples. Note that this will be applied to all HTML elements with this +#' class, so the more unique the name, the better. `className` should be +#' missing if `selector` is provided. #' @param colors character vector; the colors that form the new color palette. #' Colors can be either named colors in R (like "red" or "blue") or #' hexadecimal colors +#' @param selector character vector; one or more CSS selectors - any element +#' that matches this selector will have its color changed +#' @param legend boolean; if `TRUE`, the color change will be applied to a +#' legend created using `leaflet::addLegend()`. The legend must have the +#' specified class name, which be done with the `className` parameter of +#' `addLegend()`. Note that the class name of the legend needs to be different +#' than the class name of the map layer - otherwise the color change will be +#' applied to the entire legend rather than just the color bar. See examples. #' @examples #' if (interactive()) { #' library(leaflet) #' +#' # example using 'addWMSTiles()' #' leaflet() |> #' addTiles() |> +#' fitBounds(-126, 29, -99, 49) |> #' addWMSTiles( #' paste0( #' "https://www.mrlc.gov/geoserver/mrlc_display/", @@ -54,12 +67,43 @@ changeColorsDependencies <- function() { #' format = "image/png")) |> #' changeColors("bare_ground", terrain.colors(20)) #' +#' # example using 'addTiles()' #' leaflet() |> #' addTiles(options = tileOptions(className = "base")) |> #' changeColors("base", colorRampPalette(c("red", "white"))(50)) +#' +#' # example using 'addRasterImage()' and 'addLegend()' +#' r <- raster::raster(xmn = -2.8, xmx = -2.79, ymn = 54.04, ymx = 54.05, +#' nrows = 30, ncols = 30, crs = "EPSG:4326", vals = 1:900) +#' old_pal <- colorNumeric(topo.colors(50), c(0, 1000)) +#' new_pal <- heat.colors(50) +#' leaflet() |> +#' addTiles() |> +#' addRasterImage(r, colors = old_pal, opacity = 0.8, +#' options = tileOptions(className = "base")) |> +#' addLegend(pal = old_pal, values = c(0, 1000), +#' className = "info legend base-legend") |> +#' changeColors("base", new_pal) |> +#' changeColors("base-legend", new_pal, legend = TRUE) #' } #' @export -changeColors <- function(map, className, colors) { +changeColors <- function(map, className, colors, selector = NULL, + legend = FALSE) { + if (missing(className)) { + if (is.null(selector)) { + stop("when 'className' is missing 'selector' must not be NULL") + } + } else { + if (!is.null(selector)) { + warning(paste0("both 'className' and 'selector' were provided;", + "'selector' will be ignored")) + } + selector <- paste0(".", className) + } + + if (legend) { + selector <- paste0(selector, " > div:first-child > span") + } if (inherits(map, "mapview")) map <- mapview2leaflet(map) @@ -74,22 +118,26 @@ changeColors <- function(map, className, colors) { cols <- paste0(col2hex(colors), collapse = ", ") if (inherits(map, "leaflet_proxy")) { - leaflet::invokeMethod(map, - leaflet::getMapData(map), - "changeColors", - className, - cols) + for (selector_i in selector) { + leaflet::invokeMethod(map, + leaflet::getMapData(map), + "changeColors", + selector_i, + cols) + } } else { - map <- htmlwidgets::onRender( - map, - sprintf( - "function(el, x){ - GradientMaps.applyGradientMapToClass('%s', '%s'); - }", - className, - cols + for (selector_i in selector) { + map <- htmlwidgets::onRender( + map, + sprintf( + "function(el, x){ + GradientMaps.applyGradientMapToSelector('%s', '%s'); + }", + selector_i, + cols + ) ) - ) + } } return(map) } diff --git a/inst/htmlwidgets/lib/gradientmaps/changeColors.js b/inst/htmlwidgets/lib/gradientmaps/changeColors.js index 8bede99..c55410b 100644 --- a/inst/htmlwidgets/lib/gradientmaps/changeColors.js +++ b/inst/htmlwidgets/lib/gradientmaps/changeColors.js @@ -1,3 +1,3 @@ -LeafletWidget.methods.changeColors = function(className, colors){ - GradientMaps.applyGradientMapToClass(className, colors); +LeafletWidget.methods.changeColors = function(selector, colors){ + GradientMaps.applyGradientMapToSelector(selector, colors); } diff --git a/inst/htmlwidgets/lib/gradientmaps/gradientmaps.js b/inst/htmlwidgets/lib/gradientmaps/gradientmaps.js index d186431..b5014ae 100644 --- a/inst/htmlwidgets/lib/gradientmaps/gradientmaps.js +++ b/inst/htmlwidgets/lib/gradientmaps/gradientmaps.js @@ -5,9 +5,9 @@ https://github.com/awgreenblatt/gradientmaps/blob/master/gradientmaps.js I made a few changes. I commented out a few lines that were causing NA areas (which should be transparent) to be re-colored. I added the comment "//CHANGED" to the lines I modified. I also added a function called -'addSVGComponentTransferFilterToClass()', which is largely the same as +'addSVGComponentTransferFilterToSelector()', which is largely the same as 'addSVGComponentTransferFilter()', that applys the color change to all elements -with a given class. +with a given selector. */ @@ -329,14 +329,15 @@ window.GradientMaps = function(scope) { // I modified the original function ("addSVGComponentTransferFilter") to change The // colors via a 'style' element that applies the filter to elements with a given - // class, rather than modifying the specific element we want to change the colors + // selector, rather than modifying the specific element we want to change the colors // for. - addSVGComponentTransferFilterToClass: function(className, colors) { //CHANGED + addSVGComponentTransferFilterToSelector: function(selector, colors) { //CHANGED var filter = null; var svg = null; var svgns = 'http://www.w3.org/2000/svg'; - var style = document.getElementById('gradientmap-filter-' + className); + + var style = document.getElementById('gradientmap-filter-' + selector.replace(/\s/g, '')); var styleIsNew = true; var filterID = null; var svgIsNew = false; @@ -402,18 +403,18 @@ window.GradientMaps = function(scope) { document.body.appendChild(svg); var filterDecl = 'url(#' + filterID + ')'; - style.innerHTML = "." + className + " { filter: " + filterDecl + "; }"; + style.innerHTML = selector + " { filter: " + filterDecl + "; }"; if (styleIsNew) document.body.appendChild(style); }, - applyGradientMapToClass: function(className, gradient) { + applyGradientMapToSelector: function(selector, gradient) { debugger; var stops = this.calcStopsArray(gradient); var nSegs = this.findMatchingDistributedNSegs(stops); var colors = this.calcDistributedColors(stops, nSegs); - this.addSVGComponentTransferFilterToClass(className, colors); + this.addSVGComponentTransferFilterToSelector(selector, colors); }, diff --git a/man/changeColors.Rd b/man/changeColors.Rd index 9f497fe..9115be4 100644 --- a/man/changeColors.Rd +++ b/man/changeColors.Rd @@ -4,17 +4,30 @@ \alias{changeColors} \title{Change the color palette of a map layer} \usage{ -changeColors(map, className, colors) +changeColors(map, className, colors, selector = NULL, legend = FALSE) } \arguments{ \item{map}{a mapview or leaflet object.} -\item{className}{character; the class name to apply the color-change to. The -layer(s) must have had this class name assigned to it; see examples} +\item{className}{character vector; one or more class names to apply the +color-change to. The layer(s) must have had this class name assigned to it; +see examples. Note that this will be applied to all HTML elements with this +class, so the more unique the name, the better. `className` should be +missing if `selector` is provided.} \item{colors}{character vector; the colors that form the new color palette. Colors can be either named colors in R (like "red" or "blue") or hexadecimal colors} + +\item{selector}{character vector; one or more CSS selectors - any element +that matches this selector will have its color changed} + +\item{legend}{boolean; if `TRUE`, the color change will be applied to a +legend created using `leaflet::addLegend()`. The legend must have the +specified class name, which be done with the `className` parameter of +`addLegend()`. Note that the class name of the legend needs to be different +than the class name of the map layer - otherwise the color change will be +applied to the entire legend rather than just the color bar. See examples.} } \description{ Given a class name that corresponds to a map layer or layers, @@ -25,8 +38,10 @@ Given a class name that corresponds to a map layer or layers, if (interactive()) { library(leaflet) + # example using 'addWMSTiles()' leaflet() |> addTiles() |> + fitBounds(-126, 29, -99, 49) |> addWMSTiles( paste0( "https://www.mrlc.gov/geoserver/mrlc_display/", @@ -39,8 +54,23 @@ if (interactive()) { format = "image/png")) |> changeColors("bare_ground", terrain.colors(20)) + # example using 'addTiles()' leaflet() |> addTiles(options = tileOptions(className = "base")) |> changeColors("base", colorRampPalette(c("red", "white"))(50)) + + # example using 'addRasterImage()' and 'addLegend()' + r <- raster::raster(xmn = -2.8, xmx = -2.79, ymn = 54.04, ymx = 54.05, + nrows = 30, ncols = 30, crs = "EPSG:4326", vals = 1:900) + old_pal <- colorNumeric(topo.colors(50), c(0, 1000)) + new_pal <- heat.colors(50) + leaflet() |> + addTiles() |> + addRasterImage(r, colors = old_pal, opacity = 0.8, + options = tileOptions(className = "base")) |> + addLegend(pal = old_pal, values = c(0, 1000), + className = "info legend base-legend") |> + changeColors("base", new_pal) |> + changeColors("base-legend", new_pal, legend = TRUE) } }