将调色板与 colorRampPalette 合并并使用 leaflet 绘图
merging palettes with colorRampPalette and plotting with leaflet
我正在尝试合并两个 colorRampPalette
方案以在 leaflet
中使用并且一直在关注这个不错的 。该示例工作正常,但我似乎无法让它为我的工作工作,下面是可重现的示例。我正在使用 RdYlGn
调色板,我希望低于阈值的数字为深绿色,高于阈值的数字为更红(跳过一些内部颜色)。
对于我的示例,我的截止值是 nc$PERIMETER
< 1.3,所以我希望低于该值的数字为绿色,高于该值的所有数字都为红色(颜色 #FDAE61
起)。
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 个值应该是绿色的):
绘制它:
leaflet() %>%
addTiles() %>%
addPolygons(data = nc,
fillOpacity = 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
.
中获取值
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),我会得到这个。
我正在尝试合并两个 colorRampPalette
方案以在 leaflet
中使用并且一直在关注这个不错的 RdYlGn
调色板,我希望低于阈值的数字为深绿色,高于阈值的数字为更红(跳过一些内部颜色)。
对于我的示例,我的截止值是 nc$PERIMETER
< 1.3,所以我希望低于该值的数字为绿色,高于该值的所有数字都为红色(颜色 #FDAE61
起)。
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 个值应该是绿色的):
绘制它:
leaflet() %>%
addTiles() %>%
addPolygons(data = nc,
fillOpacity = 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
.
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),我会得到这个。