merging palettes with colorRampPalette and plotting with leaflet

Question

I\'m trying to merge two colorRampPalette schemes to use in leaflet and have been following this nice example. That example works fine but I can\'

Answer 1

I somewhat feel responsible for this question since I wrote that answer. I cannot tell how leaflet is assigning colors to polygons. But I think we witnessed that your approach is not working. Based on my previous idea, I did the following for you. I created a new continuous variable (i.e., ranking). This information is the order of values in PERIMETER. In this way, the minimum value of PERIMETER (i.e., 0.999) is getting the first color for sure. In my previous answer here, I suggested using colorFactor(), but that gave you a hard time to create a legend. So here is additional information. When I created a legend, I used ranking in colorNumeric() and created a palette, which is mypal2. We are using identical information to fill in polygons and add a legend, but we use different functions (either colorFactor or colorNumeric). Once we have the legend, we gotta change the label format. Hence we use labelFormat(). I am using ranking as indices and getting values in PERIMETER.

library(sf)  
library(leaflet)
library(RColorBrewer)

#palette im using
palette <- rev(brewer.pal(11, "RdYlGn"))
# [1] "#006837" "#1A9850" "#66BD63" "#A6D96A" "#D9EF8B" "#FFFFBF" "#FEE08B" "#FDAE61" "#F46D43" "#D73027" "#A50026"
previewColors(colorNumeric(palette = palette, domain = 0:10), values = 0:10)


# preparing the shapefile
nc2 <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
       st_transform(st_crs(4326))


# Add sequence information in order to create 108 categories for
# colorFactor(). I sorted the data and added the sequence information.

arrange(nc2, PERIMETER) %>% 
mutate(ranking = 1:n()) -> nc2

x <- sum(nc2$PERIMETER < 1.3)   
x # number of values below threshold = 21


### Create an asymmetric color range
## Make vector of colors for values smaller than 1.3 (21 colors)
rc1 <- colorRampPalette(colors = c("#006837", "#1A9850"), space = "Lab")(x)    #21 

## Make vector of colors for values larger than 1.3 
rc2 <- colorRampPalette(colors = c("#FDAE61", "#A50026"), space = "Lab")(length(nc2$PERIMETER) - x)

## Combine the two color palettes
rampcols <- c(rc1, rc2)

# Create a palette to fill in the polygons
mypal <- colorFactor(palette = rampcols, domain = factor(nc2$ranking))
previewColors(colorNumeric(palette = rampcols, domain = NULL), values = 1:length(nc$PERIMETER))


# Create a palette for a legend with ranking again. But this time with
# colorNumeric()

mypal2 <- colorNumeric(palette = rampcols, domain = nc2$ranking)

leaflet() %>%
addTiles() %>%
addPolygons(data = nc2,
            fillOpacity = 0.7,
            fillColor = ~mypal(nc2$ranking),
            popup = paste("PERIMETER: ", nc2$PERIMETER)) %>% 
addLegend(position = "bottomright", pal = mypal2, values = nc2$ranking,
          title = "PERIMETER",
          opacity = 0.7,
          labFormat = labelFormat(transform = function(x) nc2$PERIMETER[x]))

If I set up the threshold level at 2.3 (less than 2.3), I get this.