将“假”离散或连续图例添加到具有不在数据中的值的图中
Add a “fake” discrete or continuous legend to a plot with values that are not in the data
我有一个国家/地区不同州几个月的数据(百分比变化),我想将其绘制为地图(每个月作为单独的 png)并使用 magick 将其制作成 GIF 动画。
然而,百分比变化(离散值)每个月的最大值和最小值并不相同。如果我简单地绘制每个月最高值的指定红色将代表每个月的不同最大值(例如 1 月的 +240% - 245% 和 2 月的 +260% - 265%)。为了解决这个问题,我在一个向量中收集了所有月份的所有发生百分比变化。这些离散值被分配了颜色(从浅红色 - “0% - 5%” - 到深红色 - “260% - 265%”),例如“240% - 245%”将在 1 月和 2 月显示为相同的红色。
问题是:每张地图绘制的图例不同,因为并非每个月都有每个百分比变化,当然每个月的每个子集中都存在值月份显示在图例中。
是否可以 (1) 为所有地图显示相同的图例(所有离散值从“0-5%”到“260% - 265%”,即使并非每个月都绘制所有值)或者(2)我可以简单地添加一个“假的”连续图例,范围从浅红色到深红色,范围从 0% 到 265%? (我发现 geom_blank() 可能对此有所帮助,但是,我还没有设法让它发挥作用。)
这是一个最小的可重现示例:
install.packages("sf")
install.packages("ggplot2")
install.packages("magick")
install.packages("tidyverse")
install.packages("maps")
library(sf)
library(ggplot2)
library(magick)
library(tidyverse)
library(maps)
states <- st_as_sf(map("state",
plot = FALSE,
fill = TRUE))
labels <- function(start, end) {
vec <- seq(start, end, 5)
paste0(vec,
"%",
" – ",
vec + 5,
"%")
}
lab_jan <- labels(0, (length(states$ID) - 1) * 5)
lab_feb <- labels(20, (length(states$ID) + 3) * 5)
colfun <- colorRampPalette(c("#EE7F74", "#86372E"))
col <- colfun(length(unique(c(lab_jan, lab_feb))))
lab_col <- tibble(label = unique(c(lab_jan, lab_feb)),
color = col)
states_jan <- bind_cols(states,
lab_jan = factor(lab_jan,
levels = lab_jan))
states_feb <- bind_cols(states,
lab_feb = factor(lab_feb,
levels = lab_feb))
jan_01 <- ggplot() +
geom_sf(data = states_jan,
aes(fill = lab_jan)) +
theme_void() +
scale_fill_manual(values = lab_col %>%
filter(label %in% states_jan$lab_jan) %>%
pull(color)) +
#theme(legend.position = "none") +
ggsave("01_jan.png", width = 10)
feb_02 <- ggplot() +
geom_sf(data = states_feb,
aes(fill = lab_feb)) +
theme_void() +
scale_fill_manual(values = lab_col %>%
filter(label %in% states_feb$lab_feb) %>%
pull(color)) +
#theme(legend.position = "none") +
ggsave("02_feb.png", width = 10)
list.files(pattern = '*.png', full.names = TRUE) %>%
image_read() %>%
image_join() %>%
image_animate(fps = 1) %>%
image_write("states.gif")
```
这种方法怎么样:
lab_jan <- labels(0, (length(states$ID) - 1) * 5)
lab_feb <- labels(20, (length(states$ID) + 3) * 5)
lab_all <- union(lab_jan, lab_feb)
states_jan <- bind_cols(states, lab_jan = lab_jan)
states_feb <- bind_cols(states,lab_feb = lab_feb)
states_jan <- states_jan %>%
mutate(lab_jan = factor(lab_jan, levels=lab_all))
states_feb <- states_feb %>%
mutate(lab_feb = factor(lab_feb, levels=lab_all))
jan_01 <- ggplot() +
geom_sf(data = states_jan,
aes(fill = as.numeric(lab_jan))) +
theme_void() +
scale_fill_gradient(low = "#EE7F74", high="#86372E",
limits=c(1, 53),
breaks=c(1,10,20,30,40,50),
labels=lab_all[c(1,10,20,30,40,50)]) +
labs(fill="")
#theme(legend.position = "none") +
# ggsave("01_jan.png", width = 10)
feb_02 <- ggplot() +
geom_sf(data = states_feb,
aes(fill = as.numeric(lab_feb))) +
theme_void() +
scale_fill_gradient(low = "#EE7F74", high="#86372E",
limits=c(1, 53),
breaks=c(1,10,20,30,40,50),
labels=lab_all[c(1,10,20,30,40,50)]) +
labs(fill="")
gridExtra::grid.arrange(jan_01, feb_02, nrow=1)
我有一个国家/地区不同州几个月的数据(百分比变化),我想将其绘制为地图(每个月作为单独的 png)并使用 magick 将其制作成 GIF 动画。
然而,百分比变化(离散值)每个月的最大值和最小值并不相同。如果我简单地绘制每个月最高值的指定红色将代表每个月的不同最大值(例如 1 月的 +240% - 245% 和 2 月的 +260% - 265%)。为了解决这个问题,我在一个向量中收集了所有月份的所有发生百分比变化。这些离散值被分配了颜色(从浅红色 - “0% - 5%” - 到深红色 - “260% - 265%”),例如“240% - 245%”将在 1 月和 2 月显示为相同的红色。
问题是:每张地图绘制的图例不同,因为并非每个月都有每个百分比变化,当然每个月的每个子集中都存在值月份显示在图例中。
是否可以 (1) 为所有地图显示相同的图例(所有离散值从“0-5%”到“260% - 265%”,即使并非每个月都绘制所有值)或者(2)我可以简单地添加一个“假的”连续图例,范围从浅红色到深红色,范围从 0% 到 265%? (我发现 geom_blank() 可能对此有所帮助,但是,我还没有设法让它发挥作用。)
这是一个最小的可重现示例:
install.packages("sf")
install.packages("ggplot2")
install.packages("magick")
install.packages("tidyverse")
install.packages("maps")
library(sf)
library(ggplot2)
library(magick)
library(tidyverse)
library(maps)
states <- st_as_sf(map("state",
plot = FALSE,
fill = TRUE))
labels <- function(start, end) {
vec <- seq(start, end, 5)
paste0(vec,
"%",
" – ",
vec + 5,
"%")
}
lab_jan <- labels(0, (length(states$ID) - 1) * 5)
lab_feb <- labels(20, (length(states$ID) + 3) * 5)
colfun <- colorRampPalette(c("#EE7F74", "#86372E"))
col <- colfun(length(unique(c(lab_jan, lab_feb))))
lab_col <- tibble(label = unique(c(lab_jan, lab_feb)),
color = col)
states_jan <- bind_cols(states,
lab_jan = factor(lab_jan,
levels = lab_jan))
states_feb <- bind_cols(states,
lab_feb = factor(lab_feb,
levels = lab_feb))
jan_01 <- ggplot() +
geom_sf(data = states_jan,
aes(fill = lab_jan)) +
theme_void() +
scale_fill_manual(values = lab_col %>%
filter(label %in% states_jan$lab_jan) %>%
pull(color)) +
#theme(legend.position = "none") +
ggsave("01_jan.png", width = 10)
feb_02 <- ggplot() +
geom_sf(data = states_feb,
aes(fill = lab_feb)) +
theme_void() +
scale_fill_manual(values = lab_col %>%
filter(label %in% states_feb$lab_feb) %>%
pull(color)) +
#theme(legend.position = "none") +
ggsave("02_feb.png", width = 10)
list.files(pattern = '*.png', full.names = TRUE) %>%
image_read() %>%
image_join() %>%
image_animate(fps = 1) %>%
image_write("states.gif")
```
这种方法怎么样:
lab_jan <- labels(0, (length(states$ID) - 1) * 5)
lab_feb <- labels(20, (length(states$ID) + 3) * 5)
lab_all <- union(lab_jan, lab_feb)
states_jan <- bind_cols(states, lab_jan = lab_jan)
states_feb <- bind_cols(states,lab_feb = lab_feb)
states_jan <- states_jan %>%
mutate(lab_jan = factor(lab_jan, levels=lab_all))
states_feb <- states_feb %>%
mutate(lab_feb = factor(lab_feb, levels=lab_all))
jan_01 <- ggplot() +
geom_sf(data = states_jan,
aes(fill = as.numeric(lab_jan))) +
theme_void() +
scale_fill_gradient(low = "#EE7F74", high="#86372E",
limits=c(1, 53),
breaks=c(1,10,20,30,40,50),
labels=lab_all[c(1,10,20,30,40,50)]) +
labs(fill="")
#theme(legend.position = "none") +
# ggsave("01_jan.png", width = 10)
feb_02 <- ggplot() +
geom_sf(data = states_feb,
aes(fill = as.numeric(lab_feb))) +
theme_void() +
scale_fill_gradient(low = "#EE7F74", high="#86372E",
limits=c(1, 53),
breaks=c(1,10,20,30,40,50),
labels=lab_all[c(1,10,20,30,40,50)]) +
labs(fill="")
gridExtra::grid.arrange(jan_01, feb_02, nrow=1)