使用colorRampPalette合并调色板并使用传单进行绘图 [英] merging palettes with colorRampPalette and plotting with leaflet

问题描述

我正在尝试合并两个要在leaflet中使用的colorRampPalette方案，并且一直遵循这个不错的

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't seem to get it to work for my work, reproducible example below. I'm using RdYlGn palette and I want numbers below the threshold to be dark green and numbers above the threshold to more red (skipping some of the inner colors).

在我的例子中，我的下界是nc$PERIMETER< 1.3，因此我希望该值下的数字为绿色，而所有上面的数字都为红色(颜色#FDAE61起).

For my example my cut-off is nc$PERIMETER < 1.3 so I want numbers under this value to be green and everything above more red (color #FDAE61 onwards).

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

x <- sum(nc$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(nc$PERIMETER) - x)

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

mypal <- colorNumeric(palette = rampcols, domain = nc$PERIMETER)
previewColors(colorNumeric(palette = rampcols, domain = NULL), values = 1:length(nc$PERIMETER))

在预览中看似有效(1.3下的21个值应为绿色):

looking at the preview it seems to have worked (21 values under 1.3 should be green):

对其进行绘图:

leaflet() %>%
  addTiles() %>%
  addPolygons(data = nc,
              fillOpacity = 0.7,
              fillColor = ~mypal(PERIMETER),
              popup = paste("PERIMETER: ", nc$PERIMETER) )

可以尝试，但不能给出正确的颜色，突出显示的颜色高于阈值(1.3)，因此不应为绿色，而是绿色:

plots ok but doesn't give the right color, the one highlighted is above the threshold (1.3) and so shouldn't be green but it is:

我认为我创建调色板的方式是错误的，但是预览似乎表明我做对了吗?

I thought the way I was creating the palettes was wrong but the preview seems to suggest I've done it right?

有人有什么想法吗?谢谢

anyone have any ideas? thanks

推荐答案

自从我写了这个答案以来，我对这个问题有些负责.我不知道传单是如何将颜色分配给多边形的.但我认为我们目睹了您的方法无效.基于我以前的想法，我为您做了以下工作.我创建了一个新的连续变量(即ranking).此信息是PERIMETER中值的顺序.这样，PERIMETER的最小值(即0.999)肯定会获得第一种颜色.在这里的上一个答案中，我建议使用colorFactor()，但这使您很难创建图例.因此，这里是其他信息.创建图例时，我在colorNumeric()中使用了ranking并创建了一个调色板，即mypal2.我们使用相同的信息来填充多边形并添加图例，但是我们使用不同的函数(colorFactor或colorNumeric).一旦有了图例，就必须更改标签格式.因此，我们使用labelFormat().我正在使用ranking作为索引，并在PERIMETER中获取值.

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]))

如果我将阈值级别设置为2.3(小于2.3)，我就会明白.

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

这篇关于使用colorRampPalette合并调色板并使用传单进行绘图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！