在图像层中设置不同的填充比例
gganimate different fill scales in image layers
我将使用 mtcars 数据集作为示例。我想根据填充颜色在相同数据点的一个变量 (cyl) 和另一个变量 (hp) 之间转换。但是,比例设置为 4:335 之间的整个范围。因此,当显示 cyl 时,所有点看起来都一样,因为它们的颜色是 "squashed",由于没有更好的术语,是 hp 的上限。我想要发生的是,填充 cyl 时的色标是 4:8,而显示 hp 时的色标是 52:335。这是一个最小的例子
library(ggplot2)
library(gganimate)
library(RColorBrewer)
library(grDevices)
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
anim <- ggplot(mtcars, aes(mpg, disp)) +
geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = cyl)) +
geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = hp)) +
scale_fill_gradientn(colours = myPalette(100))+
transition_layers(layer_length = 1, transition_length = 2) +
enter_fade() + enter_grow()
anim
一个选项是对一个变量使用填充,对另一个变量使用颜色,因为一些点形状使用填充而其他点使用颜色。我对结果不是 100% 满意,它可能需要一些调整才能使磅值匹配:
anim <- ggplot(mtcars, aes(mpg, disp)) +
geom_point(shape = 16, size = 3, show.legend = T, aes(colour = cyl)) +
geom_point(shape = 21, size = 3, stroke = 0, show.legend = T, aes(fill = hp)) +
scale_fill_gradientn(colours = myPalette(100))+
scale_colour_gradientn(colours = myPalette(100))+
transition_layers(layer_length = 1, transition_length = 2) +
enter_fade() + enter_grow()
这是另一种方法。这里需要更多的预处理,但我认为这种方法仍有一些价值,因为它更适合在 >2 个变量之间转换以用于更广泛的用例。
定义新数据集,将收集的列和填充值缩放到一个公共范围 (0-1):
library(dplyr)
# modify dataset
mtcars2 <- mtcars %>%
select(mpg, disp, cyl, hp) %>%
tidyr::gather(key, value, -mpg, -disp) %>%
group_by(key) %>%
mutate(scaled.value = (value - min(value)) / diff(range(value))) %>%
ungroup()
> head(mtcars2)
# A tibble: 6 x 5
mpg disp key value scaled.value
<dbl> <dbl> <chr> <dbl> <dbl>
1 21 160 cyl 6 0.5
2 21 160 cyl 6 0.5
3 22.8 108 cyl 4 0
4 21.4 258 cyl 6 0.5
5 18.7 360 cyl 8 1
6 18.1 225 cyl 6 0.5
由于在动画过程中相同的图例比例会应用于不同的值,因此我们需要为它们设置不同的标签。我们可以在图中包含额外的几何层来模拟这一点,同时抑制实际的填充图例。
# may need further tweaking, depending on the actual plot's dimensions; this worked
# sufficiently for me
legend.position <- c("xmin" = max(mtcars2$mpg) - 0.05 * diff(range(mtcars2$mpg)),
"xmax" = max(mtcars2$mpg) - 0.02 * diff(range(mtcars2$mpg)),
"ymin" = max(mtcars2$disp) - 0.2 * diff(range(mtcars2$disp)),
"ymax" = max(mtcars2$disp) - 0.01 * diff(range(mtcars2$disp)))
生成情节:
anim1 <- ggplot(mtcars2, aes(mpg, disp)) +
geom_point(aes(fill = scaled.value, group = interaction(mpg, disp, scaled.value)),
shape = 21, colour = "black", size = 3, stroke = 0.5) +
# pseudo legend title
geom_text(aes(x = legend.position[["xmin"]],
y = legend.position[["ymax"]],
label = key),
vjust = -1, hjust = 0, check_overlap = TRUE) +
# pseudo legend labels (tweak number of breaks, font size, etc., as needed)
geom_text(data = . %>%
group_by(key) %>%
summarise(y = list(modelr::seq_range(scaled.value, n = 5)),
label = list(modelr::seq_range(value, n = 5))) %>%
ungroup() %>%
tidyr::unnest() %>%
mutate(y = legend.position[["ymin"]] +
y * (legend.position[["ymax"]] - legend.position[["ymin"]])),
aes(x = legend.position[["xmax"]], y = y, label = as.character(round(label))),
hjust = 0, nudge_x = 0.5, size = 3, check_overlap = TRUE) +
# pseudo colour bar
annotation_custom(grob = grid::rasterGrob(rev(myPalette(100)),
width = unit(1, "npc"), height = unit(1, "npc")),
xmin = legend.position[["xmin"]],
xmax = legend.position[["xmax"]],
ymin = legend.position[["ymin"]],
ymax = legend.position[["ymax"]]) +
scale_fill_gradientn(colours = myPalette(100), guide = FALSE) +
labs(title = "{closest_state}") +
transition_states(key) +
enter_fade() +
enter_grow()
# reducing nframes to speed up the animation, since there are only two states anyway
animate(anim1, nframes = 20)
我将使用 mtcars 数据集作为示例。我想根据填充颜色在相同数据点的一个变量 (cyl) 和另一个变量 (hp) 之间转换。但是,比例设置为 4:335 之间的整个范围。因此,当显示 cyl 时,所有点看起来都一样,因为它们的颜色是 "squashed",由于没有更好的术语,是 hp 的上限。我想要发生的是,填充 cyl 时的色标是 4:8,而显示 hp 时的色标是 52:335。这是一个最小的例子
library(ggplot2)
library(gganimate)
library(RColorBrewer)
library(grDevices)
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
anim <- ggplot(mtcars, aes(mpg, disp)) +
geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = cyl)) +
geom_point(shape = 21, colour = "black", size = 3, stroke = 0.5, show.legend = T, aes(fill = hp)) +
scale_fill_gradientn(colours = myPalette(100))+
transition_layers(layer_length = 1, transition_length = 2) +
enter_fade() + enter_grow()
anim
一个选项是对一个变量使用填充,对另一个变量使用颜色,因为一些点形状使用填充而其他点使用颜色。我对结果不是 100% 满意,它可能需要一些调整才能使磅值匹配:
anim <- ggplot(mtcars, aes(mpg, disp)) +
geom_point(shape = 16, size = 3, show.legend = T, aes(colour = cyl)) +
geom_point(shape = 21, size = 3, stroke = 0, show.legend = T, aes(fill = hp)) +
scale_fill_gradientn(colours = myPalette(100))+
scale_colour_gradientn(colours = myPalette(100))+
transition_layers(layer_length = 1, transition_length = 2) +
enter_fade() + enter_grow()
这是另一种方法。这里需要更多的预处理,但我认为这种方法仍有一些价值,因为它更适合在 >2 个变量之间转换以用于更广泛的用例。
定义新数据集,将收集的列和填充值缩放到一个公共范围 (0-1):
library(dplyr)
# modify dataset
mtcars2 <- mtcars %>%
select(mpg, disp, cyl, hp) %>%
tidyr::gather(key, value, -mpg, -disp) %>%
group_by(key) %>%
mutate(scaled.value = (value - min(value)) / diff(range(value))) %>%
ungroup()
> head(mtcars2)
# A tibble: 6 x 5
mpg disp key value scaled.value
<dbl> <dbl> <chr> <dbl> <dbl>
1 21 160 cyl 6 0.5
2 21 160 cyl 6 0.5
3 22.8 108 cyl 4 0
4 21.4 258 cyl 6 0.5
5 18.7 360 cyl 8 1
6 18.1 225 cyl 6 0.5
由于在动画过程中相同的图例比例会应用于不同的值,因此我们需要为它们设置不同的标签。我们可以在图中包含额外的几何层来模拟这一点,同时抑制实际的填充图例。
# may need further tweaking, depending on the actual plot's dimensions; this worked
# sufficiently for me
legend.position <- c("xmin" = max(mtcars2$mpg) - 0.05 * diff(range(mtcars2$mpg)),
"xmax" = max(mtcars2$mpg) - 0.02 * diff(range(mtcars2$mpg)),
"ymin" = max(mtcars2$disp) - 0.2 * diff(range(mtcars2$disp)),
"ymax" = max(mtcars2$disp) - 0.01 * diff(range(mtcars2$disp)))
生成情节:
anim1 <- ggplot(mtcars2, aes(mpg, disp)) +
geom_point(aes(fill = scaled.value, group = interaction(mpg, disp, scaled.value)),
shape = 21, colour = "black", size = 3, stroke = 0.5) +
# pseudo legend title
geom_text(aes(x = legend.position[["xmin"]],
y = legend.position[["ymax"]],
label = key),
vjust = -1, hjust = 0, check_overlap = TRUE) +
# pseudo legend labels (tweak number of breaks, font size, etc., as needed)
geom_text(data = . %>%
group_by(key) %>%
summarise(y = list(modelr::seq_range(scaled.value, n = 5)),
label = list(modelr::seq_range(value, n = 5))) %>%
ungroup() %>%
tidyr::unnest() %>%
mutate(y = legend.position[["ymin"]] +
y * (legend.position[["ymax"]] - legend.position[["ymin"]])),
aes(x = legend.position[["xmax"]], y = y, label = as.character(round(label))),
hjust = 0, nudge_x = 0.5, size = 3, check_overlap = TRUE) +
# pseudo colour bar
annotation_custom(grob = grid::rasterGrob(rev(myPalette(100)),
width = unit(1, "npc"), height = unit(1, "npc")),
xmin = legend.position[["xmin"]],
xmax = legend.position[["xmax"]],
ymin = legend.position[["ymin"]],
ymax = legend.position[["ymax"]]) +
scale_fill_gradientn(colours = myPalette(100), guide = FALSE) +
labs(title = "{closest_state}") +
transition_states(key) +
enter_fade() +
enter_grow()
# reducing nframes to speed up the animation, since there are only two states anyway
animate(anim1, nframes = 20)