使用 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屋!