Leaflet: Mixing continuous and discrete colors

Question

I have created a map using leaflet in R. It is a map of the United States with polygons being zip code level. I want to color the zip codes using a continuous color palette based on some value. I have followed the example here and have successfully mapped each zip code with a continuous color using the colorNumeric function like this:

# Create a continuous palette function
library(leaflet)
library(rgdal)
library(dplyr)

# From https://raw.githubusercontent.com/datasets/geo-boundaries-world-110m/master/countries.geojson
countries <- readOGR("json/countries.geojson", "OGRGeoJSON")
map <- leaflet(countries)

pal <- colorNumeric(palette = colorRamp(c('#4575B4', '#D73027', '#FFFFBF'), interpolate="linear"), 
                    domain = countries$gdp_md_est)

map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
            color = ~pal(gdp_md_est))

What makes this complicated is that now I want to separately color zip codes (basically replacing the previous color) using a discrete color palette. As a simple example, I want to use the colorNumeric function above to color each zip code based on average weight. Then I would use another zip code level field in my data to make all zip codes' polygons black if I wanted to exclude it for some reason, otherwise it would leave the colors as they already are.

I have found it difficult to use leaflet and colorNumeric to achieve both continuous and discrete coloring of my map. Any help would be greatly appreciated!

Answer 1

Since the sample above is not enough to have a demonstration, I decided to use one of the dummy data that I used for other leaflet related questions. I hope you do not mind that. Given what you said, you need to create two layers in your map. One for a continuous variable, and the other for a discrete variable. This means that you need to create two sets of colors. As you used, you want to use colorNumeric() for the continuous variable. You want to use colorFactor() for the discrete variable. In my sample code, I create a new discrete variable called group. Once you finish creating the color palettes, you want to draw a map. You need to use addPolygons() twice. Make sure that you use group. This is going to appear in the layer control button on the right upper corner. As far as I know, we cannot display one legend only at the moment. I came across this issue before and concluded that we have no choice at the moment. I hope this demonstration is enough for you to make a progress in your task.

library(raster)
library(dplyr)
library(leaflet)

# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)


### Create dummy data
set.seed(111)
mydf <- data.frame(place = unique(UK$NAME_2),
                   value = sample.int(n = 1000, size = n_distinct(UK$NAME_2), replace = TRUE))

### Create a new dummy column for a discrete variable.
mydf <- mutate(mydf, group = cut(value, breaks = c(0, 200, 400, 600, 800, 1000),
                                 labels = c("a", "b", "c", "d", "e"),
                                 include.lowest = TRUE))


### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = mydf$value, na.color = "black")
dispal <- colorFactor("Spectral", domain = mydf$group, na.color = "black")


leaflet() %>% 
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK, group = "continuous",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~conpal(mydf$value),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", mydf$value, "<br>")) %>%
addPolygons(data = UK, group = "discrete",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~dispal(mydf$group),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", mydf$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = mydf$value,
          title = "UK value",
          opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = mydf$group,
          title = "UK group",
          opacity = 0.3)

If you choose the continuous-variable layer, you will see the following map.

If you choose the discrete-variable layer, you will see the following map.

Update

If you want to show both a continuous group and a continuous group together, you need to subset your data beforehand so that there is no overlapping in polygons. Using UK and mydf above, you can try something like this.

### Subset data and create two groups. This is something you gotta do
### in your own way given I have no idea of your own data.

con.group <- mydf[1:96, ]
dis.group <- mydf[97:192, ]


### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = c(min(mydf$value), max(mydf$value)), na.color = "black")
dispal <- colorFactor(palette = "Reds", "Spectral", levels = unique(mydf$group), na.color = "black")


### Subset the polygon data as well

con.poly <- subset(UK, NAME_2 %in% con.group$place)
dis.poly <- subset(UK, NAME_2 %in% dis.group$place)

leaflet() %>% 
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = con.poly, group = "continuous",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~conpal(con.group$value),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Value: ", con.group$value, "<br>")) %>%
addPolygons(data = dis.poly, group = "discrete",
            stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
            fillColor = ~dispal(dis.group$group),
            popup = paste("Region: ", UK$NAME_2, "<br>",
                          "Group: ", dis.group$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = con.group$value,
          title = "UK value",
          opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = dis.group$group,
          title = "UK group",
          opacity = 0.3)