Reputation: 159
I have data (percentage changes) for several months for different states of a country that I want to plot as a map (each month as a separate png) and animate it as a GIF with magick.
The percentage changes (discrete values), however, do not have the same maximum and minimum value in each month. If I would simply plot each month the specified red color for the highest value would stand for different maximum values in each month (for example +240% - 245% in January and +260% - 265% in February). To tackle this issue I gathered all occurring percentage changes of all months in a vector. These discrete values got assigned colors (from light red - "0% - 5%" - to dark red - "260% - 265%") so that e.g. "240% - 245%" would show as the same red in January as well as in February.
The problem is: the legends that are plotted with each map differ since not every percentage change is present in each month and of course only values that exist in each subset for each month are shown in the legend.
Is it possible to (1) show the same legend for all maps (with all discrete values from "0-5%" to "260% - 265%" even though not all the values are plotted each month) or (2) can I simply add a "fake" continuous legend ranging from light red to dark red that ranges from 0% to 265%? (I found geom_blank() might be helpful for that, however, I have not managed to make it work.)
Here is a minimal reproducible example:
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")
```
Upvotes: 0
Views: 310
Reputation: 21937
How about this approach:
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)
Upvotes: 1