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

问题描述

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

绘制它:

leaflet() %>%addTiles() %>%addPolygons(数据 = nc，填充不透明度 = 0.7，fillColor = ~mypal(PERIMETER),popup = paste("PERIMETER: ", nc$PERIMETER) )

绘图正常，但颜色不正确，突出显示的颜色高于阈值 (1.3)，因此不应该是绿色，但它是:

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

有人有什么想法吗?谢谢

解决方案

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

库(sf)图书馆(传单)库(RColorBrewer)#调色板我正在使用调色板 <- rev(brewer.pal(11, "RdYlGn"))# [1] "#006837" "#1A9850" "#66BD63" "#A6D96A" "#D9EF8B" "#FFFFBF" "#FEE08B" "#FDAE61" "#F46D43" "#D73027" "#A50026"previewColors(colorNumeric(调色板 = 调色板，域 = 0:10)，值 = 0:10)# 准备形状文件nc2 <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>%st_transform(st_crs(4326))# 添加序列信息以创建 108 个类别# 颜色因子().我对数据进行了排序并添加了序列信息.排列(nc2，周界)%>%变异(排名= 1:n())->nc2x <- sum(nc2$PERIMETER <1.3)x # 低于阈值的值数 = 21### 创建一个不对称的颜色范围## 为小于 1.3 的值制作颜色向量(21 种颜色)rc1 <- colorRampPalette(colors = c("#006837", "#1A9850"), space = "Lab")(x) #21## 为大于 1.3 的值制作颜色向量rc2 <- colorRampPalette(colors = c("#FDAE61", "#A50026"), space = "Lab")(length(nc2$PERIMETER) - x)##结合两个调色板rampcols <- c(rc1, rc2)# 创建一个调色板来填充多边形mypal <- colorFactor(调色板 = rampcols，域 = 因子(nc2$ranking))previewColors(colorNumeric(palette = rampcols, domain = NULL), values = 1:length(nc$PERIMETER))# 再次为具有排名的图例创建调色板.但这次与# 颜色数字()mypal2 <- colorNumeric(调色板 = rampcols，域 = nc2$ranking)传单() %>%addTiles() %>%addPolygons(数据= nc2，填充不透明度 = 0.7，fillColor = ~mypal(nc2$ranking),popup = paste("PERIMETER: ", nc2$PERIMETER)) %>%addLegend(position = "bottomright", pal = mypal2, values = nc2$ranking,标题=周界"，不透明度 = 0.7，labFormat = labelFormat(transform = function(x) nc2$PERIMETER[x]))

如果我将阈值级别设置为 2.3(小于 2.3)，我会得到这个.

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

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

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

plotting it:

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

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

解决方案

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.

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