Removing Colors on a Map

Question

Using the following link as a guide (https://github.com/r-spatial/leafgl/issues/18), I made this map that I really like in R:

library(sf)  
library(leaflet)
library(leafgl)
library(colourvalues)
library(leaflet.extras)


nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
  st_transform(st_crs(4326)) %>% 
  st_cast('POLYGON')

leaflet(data = nc) %>% addPolygons( stroke = FALSE) %>% addTiles(group = "OSM") %>%  addProviderTiles(provider = providers$OpenStreetMap) %>% addPolygons(data = nc, weight=1, popup = ~NAME,
                label = ~NAME, group = "name", col = 'blue') %>% 
    addSearchFeatures(targetGroups  = 'name', options = searchFeaturesOptions(zoom=10, openPopup=TRUE))

The only thing that I would like to change - I would like to remove the blue color/shading from this map. That is, I would like the user to be able to search for a name on this map (e.g. Edgecombe) - and once the user searchers for this name, ONLY the corresponding region "lights up" in this blue shading.

I tried to do this by manually removing the color option from the leaflet statement:

leaflet(data = nc) %>% addPolygons( stroke = FALSE) %>% addTiles(group = "OSM") %>%  addProviderTiles(provider = providers$OpenStreetMap) %>% addPolygons(data = nc, weight=1, popup = ~NAME,
                label = ~NAME, group = "name" %>% 
    addSearchFeatures(targetGroups  = 'name', options = searchFeaturesOptions(zoom=10, openPopup=TRUE))

But nothing has changed.

Does anyone have any ideas on how to this?

EDIT: I am looking for something like this - is this possible?

Kat · Accepted Answer · 2022-09-18 21:17:39Z

This is a bit over the top, but I couldn't find an R or native Leaflet method of adding events, so I improvised. This will require htmlwidgets. I didn't call the library; I just appended it to the function.

For this to work correctly, the countys' paths need to be ordered when rendering. The easiest way to make this happen is to order the data by county. I did this in the trace, not in the data itself.

I also changed the weight from 1 to 2; otherwise, you could barely see the outline.

In the Javascript, I added a lot of comments. If there is anything that's still unclear, let me know.

I only made it so that the outline would show when you searched for the county. If there is something else you want, let me know!

leaflet(data = nc) %>% addPolygons(stroke = FALSE, fill = F) %>%
  addTiles(group = "OSM")%>% 
  addProviderTiles(provider = providers$OpenStreetMap) %>% 
  addPolygons(data = nc %>% arrange(NAME),  # <--------- I'm new!! order the paths!
              weight=2, popup = ~NAME, fill = F,
              label = ~NAME, group = "name", col = 'transparent') %>%
  addSearchFeatures(targetGroups  = 'name',
                    options = searchFeaturesOptions(zoom=10, 
                                                    openPopup=TRUE)) %>% 
  htmlwidgets::onRender(
    "function(el, x){
      traces = x.calls[3].args[4]; /* this is an object with the county names */
      function outliner(tellMe) {  /* function called when popups change */
        paths = document.querySelectorAll('svg > g > path'); /* find all paths */
        arr = [];       /* store indices that are transparent (where the counties are) */
        for(j = 0; j < paths.length; j++) {
          showMe = paths[j].getAttribute('stroke');
          if(showMe == 'transparent') {
            arr.push(j); /* indices of which paths are relevant */
          }
        }
        chng = [];       /* capture indices to connect counties to their paths */
        if(tellMe) {                              /* if tellMe exists, not false */
          init = traces.indexOf(tellMe);          /* initial, is there more than one path? */
          finit = traces.lastIndexOf(tellMe);
          if(init !== finit) {                    /* there is more than one path! */
            for(k = init; k <= finit; k++) {
              chng.push(k + arr[0]);     /* index plus offset to get the right path */
            }
          } else { chng = init + arr[0]}          /* index plus offset to get the right path */
        }
        if(chng == -1) {tellMe == false}          /* if nonsense captured, don't change the map */
        for(i = arr[0]; i < arr[arr.length - 1]; i++) {     /* look at every path, remove or add outline */
          if(tellMe) {                            /* does it exist and not false */
            if(typeof(chng) == 'number'){         /* county represented by a single path */
              if(i === chng){
                pathic(i)                         /* if popup outline */
              } else {
                unpath(i)                         /* no outline */
              }
            } else if(typeof(chng) == 'object') { /* more than one path for county */
              if(chng.indexOf(i) !== -1) {
                pathic(i)                         /* if popup outline */
              } else {
                unpath(i)                         /* no outline */
              }
            }
          } else {unpath(i)}                      /* no outline */
         }                                        /* end for */
        }                                         /* end outliner */
        function pathic(ind) {                    /* I outline things */
          paths[ind].setAttribute('stroke', 'blue');
        }
        function unpath(ind) {                    /* I remove outlines */
          paths[ind].setAttribute('stroke', 'transparent');
        }
        $('div.leaflet-pane.leaflet-popup-pane').bind(\"DOMSubtreeModified\", function() {
          if(this.innerHTML) {    /* add the event to the DOM */
            which = $('div.leaflet-popup-content').text(); 
            outliner(which);                      /* if popup, what does it say? */
          } else {
            outliner(false)                       /* no popup! */
          }
      })}")

You can see here that it removes the previously searched county's outline.

I just wonder - is it possible to add some "color shading" to the selected region so that it stands out better? — stats_noob, Commented Sep 18, 2022 at 22:42
@ Kat: When it comes to R programming, I think you have some of the most (if not the most) highest quality answers on stackoverflow. Each of your answers is like a learning tutorial that is incredibly informative and educational. I wish more people could know about the great work you have done and the great work you are doing on stackoverflow - whenever I have a question, I now check answers you have given on stackoverflow in case the question I have has already been answered. Thank you Kat - you are truly inspirational and your work is a blessing. Thank you so much! — stats_noob, Commented Sep 18, 2022 at 22:46
Thank you!! As far as the shading, first remove fill = F from the trace for NC counties. (This will add the opacity to the path elements.) Next, in the JS, towards the end are two functions pathic(ind) and unpath(ind). They either set the color to blue (the attribute is stroke for SVG lines) or transparent. You'll add one line to each of these functions to change the attribute fill. In pathic, on a new line, add paths[ind].setAttribute('fill', 'blue'); In unpath, on a new line, add paths[ind].setAttribute('fill', 'transparent');. — Kat, Commented Sep 19, 2022 at 0:48
@ Kat: I followed your instructions and everything works perfectly! I will post the code I ran as an answer in case someone wants to see it in full! Thanks again! — stats_noob, Commented Sep 19, 2022 at 1:30
@ kat: I recently thought of this problem I have been trying to solve : stackoverflow.com/questions/75264427/… ... It involves a network graph that shrinks or expands depending on user actions... i have been researching if its possible to use javascript functions (just like you provided here) to accomplish this task. can you please take a look at it if you have time? thank you so much! — stats_noob, Commented Jan 28, 2023 at 0:06

Quinten · Accepted Answer · 2022-09-17 07:36:35Z

You could use fill=FALSE in your addPolygons functions like this:

library(sf)  
library(leaflet)
library(leafgl)
library(colourvalues)
library(leaflet.extras)

nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
  st_transform(st_crs(4326)) %>% 
  st_cast('POLYGON')
#> Warning in st_cast.sf(., "POLYGON"): repeating attributes for all sub-geometries
#> for which they may not be constant

leaflet(data = nc) %>% 
  addPolygons( stroke = FALSE, fill = FALSE) %>% 
  addTiles(group = "OSM") %>%  
  addProviderTiles(provider = providers$OpenStreetMap) %>% 
  addPolygons(data = nc, weight=1, popup = ~NAME, label = ~NAME, group = "name", col = 'blue', fill = FALSE) %>% 
  addSearchFeatures(targetGroups  = 'name', options = searchFeaturesOptions(zoom=10, openPopup=TRUE))

^{Created on 2022-09-17 with reprex v2.0.2}

@ Quinten: Thank you! This is close to what I am looking for! I will post clarifications in the question! Thank you so much! — stats_noob, Commented Sep 17, 2022 at 16:08

stats_noob · Accepted Answer · 2022-09-19 01:33:02Z

Based on the wonderful answer provided by @Kat, I have posted the code that "shades in" the selected area of the map:

library(sf)  
library(leaflet)
library(leafgl)
library(colourvalues)
library(leaflet.extras)
library(dplyr)

nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
    st_transform(st_crs(4326)) %>% 
    st_cast('POLYGON')


map = leaflet(data = nc) %>% addPolygons(stroke = FALSE, fill = F) %>%
    addTiles(group = "OSM")%>% 
    addProviderTiles(provider = providers$OpenStreetMap) %>% 
    addPolygons(data = nc %>% arrange(NAME),  # <--------- I'm new!! order the paths!
                weight=2, popup = ~NAME, 
                label = ~NAME, group = "name", col = 'transparent') %>%
    addSearchFeatures(targetGroups  = 'name',
                      options = searchFeaturesOptions(zoom=10, 
                                                      openPopup=TRUE)) %>% 
     htmlwidgets::onRender(
        "function(el, x){
      traces = x.calls[3].args[4]; /* this is an object with the county names */
      function outliner(tellMe) {  /* function called when popups change */
        paths = document.querySelectorAll('svg > g > path'); /* find all paths */
        arr = [];       /* store indices that are transparent (where the counties are) */
        for(j = 0; j < paths.length; j++) {
          showMe = paths[j].getAttribute('stroke');
          if(showMe == 'transparent') {
            arr.push(j); /* indices of which paths are relevant */
          }
        }
        chng = [];       /* capture indices to connect counties to their paths */
        if(tellMe) {                              /* if tellMe exists, not false */
          init = traces.indexOf(tellMe);          /* initial, is there more than one path? */
          finit = traces.lastIndexOf(tellMe);
          if(init !== finit) {                    /* there is more than one path! */
            for(k = init; k <= finit; k++) {
              chng.push(k + arr[0]);     /* index plus offset to get the right path */
            }
          } else { chng = init + arr[0]}          /* index plus offset to get the right path */
        }
        if(chng == -1) {tellMe == false}          /* if nonsense captured, don't change the map */
        for(i = arr[0]; i < arr[arr.length - 1]; i++) {     /* look at every path, remove or add outline */
          if(tellMe) {                            /* does it exist and not false */
            if(typeof(chng) == 'number'){         /* county represented by a single path */
              if(i === chng){
                pathic(i)                         /* if popup outline */
              } else {
                unpath(i)                         /* no outline */
              }
            } else if(typeof(chng) == 'object') { /* more than one path for county */
              if(chng.indexOf(i) !== -1) {
                pathic(i)                         /* if popup outline */
              } else {
                unpath(i)                         /* no outline */
              }
            }
          } else {unpath(i)}                      /* no outline */
         }                                        /* end for */
        }                                         /* end outliner */
        function pathic(ind) {                    /* I outline things */
          paths[ind].setAttribute('stroke', 'blue');
          paths[ind].setAttribute('fill', 'blue')
        }
        function unpath(ind) {                    /* I remove outlines */
          paths[ind].setAttribute('stroke', 'transparent');
          paths[ind].setAttribute('fill', 'transparent');
        }
        $('div.leaflet-pane.leaflet-popup-pane').bind(\"DOMSubtreeModified\", function() {
          if(this.innerHTML) {    /* add the event to the DOM */
            which = $('div.leaflet-popup-content').text(); 
            outliner(which);                      /* if popup, what does it say? */
          } else {
            outliner(false)                       /* no popup! */
          }
      })}")

Thanks again @Kat!

Collectives™ on Stack Overflow

Removing Colors on a Map

3 Answers 3

Not the answer you're looking for? Browse other questions tagged
r
r-leaflet
or ask your own question.

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Not the answer you're looking for? Browse other questions tagged rr-leaflet or ask your own question.

Linked

Related

Not the answer you're looking for? Browse other questions tagged
r
r-leaflet
or ask your own question.