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?

Quinten · Answer

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}

userpmmm · Answer

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.

antonoyaro8 · Answer

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 Answers