Removing Colors on a Map in R

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?

Thank you!

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

score 2 · Answer 1 · answered Sep 17 '22 at 07:36

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, Sep 17 '22 at 16:08

score 2 · Accepted Answer · answered Sep 18 '22 at 21:17

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, Sep 18 '22 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, Sep 18 '22 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, Sep 19 '22 at 00: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, Sep 19 '22 at 01:30
@ kat: I recently thought of this problem I have been trying to solve : https://stackoverflow.com/questions/75264427/r-collapsing-and-expanding-networks ... 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, Jan 28 '23 at 00:06

score 0 · Answer 3 · answered Sep 19 '22 at 01:33

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!

Removing Colors on a Map in R

3 Answers3