在 ggplot2 之外添加随时间变化的列表 - gganimate
Adding list outside of ggplot2 which changes as time progresses - gganimate
我使用 ggplot2 创建了一个动画图,然后使用 gganimate。该图显示了随时间变化的点,我用红色突出显示了一个兴趣点,并用黄色突出显示了随着时间的推移与红点保持一致的点。
我试图在右侧的图之外,红色和黄色点是什么(如它们在数据框中的标识)并根据时间点进行更改。如您所见,一些黄点消失等 - 但是我无法完成这项工作。我试过 geom_text(),`` labs() 但没有成功。
情节的代码是:
library(gifski)
library(gganimate)
library(ggplot2)
labels = 'word1'
highlight_red<- words[words$X %in% labels,]#dataframe with word of interest
labels2<-c("word2", "word3")
highlight_orange<-words[words$X %in% labels2,]#dataframe with word of interest
p <- ggplot(words, aes(x_coord, y=y_coord, col = time)) +
theme_void()+
labs(title ="{words$time[words$time == round(frame_time)][1]}") +
theme(plot.title = element_text(size = 50, face = "bold", colour = "grey", margin = margin(t = 10, b = -20)))+
geom_point(alpha = 1)+
geom_point(data=highlight_red,
aes(x_coord, y=y_coord),
color='red',
size=3)+
geom_point(data=highlight_orange,
aes(x_coord, y=y_coord),
color='orange',
size=3, alpha=0.8)+
guides(size=FALSE) +
theme(legend.title = element_blank()) +
coord_fixed(ratio = 1)
p<-p+
transition_time(time)+
shadow_wake(wake_length = 0, alpha = FALSE)+
enter_fade() +
exit_shrink()
animate(p, duration = 5, fps = 20, renderer = gifski_renderer())
附上gif。我希望最接近红点的感兴趣的词(例如前 5 个)在列表的右侧循环,就像它们在散点图上所做的那样,以反映红点周围实际发生的变化。我尝试添加代码,例如(到主 ggplot 代码)
# geom_text(aes(label = "{highlight_orange$X[highlight_orange$time == round(frame_time)][1]}"),
# hjust = -0.35,#adjust position
# size = 3,
# check_overlap = TRUE)
绝对没有运气 - 它也需要在一个整洁的列表中,当然不能重叠。任何帮助深表感谢。谢谢。
可重现 table(缩短为 select 个单词)
X x_coord y_coord time
1 word1 27.065716 59.019010 1
2 word2 22.936882 61.470710 1
3 word3 25.227564 62.780384 1
4 word4 27.878267 61.130566 1
5 word5 22.929253 61.345573 1
6 word6 14.307319 -44.314228 1
8760 word1 6.607143 -56.996240 2
8844 word2 -64.222240 -9.363668 2
10370 word3 -63.630585 -8.037662 2
10501 word4 -13.532422 -50.246193 2
13788 word5 5.143321 -56.445950 3
14583 word6 -67.655820 -29.041885 3
22566 word1 -48.322063 -24.847290 4
26496 word3 3.340046 14.917225 5
27050 word6 2.397841 -53.621520 6
28818 word3 -19.618414 37.386040 6
30582 word5 -15.498601 -51.142025 6
31513 word4 -3.114899 -14.631951 6
32772 word1 -4.706020 -9.429874 6
不确定我是否理解正确这是否是您要尝试做的。从你的问题来看,你似乎想在情节旁边的列表中显示一个包含 highlight_orange
中的单词的列表。如果单词从一帧更改到下一帧,您希望它们四处移动。
如果是这种情况,我找到了一种方法来做到这一点。但唯一困扰我的是我无法为 geom_text
设置不同的 enter
和 exit
属性。我希望 geom_text
使用 enter_fly
和 exit_fly
(让 geom_point
继续使用 enter_fade
和 exit_shrink
)。
显然 it is possible to do this,但我不知道该怎么做...
无论如何,我会按原样把我的答案放在这里,因为也许它对你有帮助。
# get max y and y (for positioning list in plot)
max.y <- ceiling(max(words$y_coord))
max.x <- ceiling(max(words$x_coord))
# calculate x/y position of list of words
highlight_orange <- highlight_orange %>%
dplyr::group_by(time) %>%
# position in list
dplyr::mutate(rank = row_number()) %>%
# compute x, y position in plot (I had to do trial and error with the y offset so the words would not overlap)
dplyr::mutate(x_pos=max.x, y_pos=max.y - 4*(rank-1)) %>% dplyr::ungroup()
p <- ggplot(words, aes(x_coord, y=y_coord, col = time)) +
theme_void()+
labs(title ="{words$time[words$time == round(frame_time)][1]}") +
theme(plot.title = element_text(size = 50, face = "bold", colour = "grey", margin = margin(t = 10, b = -20)))+
geom_point(alpha = 1)+
geom_point(data=highlight_red,
aes(x=x_coord, y=y_coord),
color='red',
size=3)+
geom_point(data=highlight_orange,
aes(x=x_coord, y=y_coord),
color='orange',
size=3, alpha=0.8)+
geom_text(data=highlight_orange, aes(x=x_pos, y=y_pos, label=X, group=X), hjust=0, vjust=0.5, colour='black') +
guides(size=FALSE, col=FALSE) +
theme(legend.title = element_blank()) +
# set "clip=off" so you can draw the text outside of the plotting area
coord_fixed(ratio = 1, clip = "off")
# I think you can set different enter/exit for each layer. But I could not figure out how...
p + transition_time(time) + shadow_wake(wake_length = 0, alpha = FALSE) +
enter_fade() + exit_shrink()
我使用 ggplot2 创建了一个动画图,然后使用 gganimate。该图显示了随时间变化的点,我用红色突出显示了一个兴趣点,并用黄色突出显示了随着时间的推移与红点保持一致的点。
我试图在右侧的图之外,红色和黄色点是什么(如它们在数据框中的标识)并根据时间点进行更改。如您所见,一些黄点消失等 - 但是我无法完成这项工作。我试过 geom_text(),`` labs() 但没有成功。
情节的代码是:
library(gifski)
library(gganimate)
library(ggplot2)
labels = 'word1'
highlight_red<- words[words$X %in% labels,]#dataframe with word of interest
labels2<-c("word2", "word3")
highlight_orange<-words[words$X %in% labels2,]#dataframe with word of interest
p <- ggplot(words, aes(x_coord, y=y_coord, col = time)) +
theme_void()+
labs(title ="{words$time[words$time == round(frame_time)][1]}") +
theme(plot.title = element_text(size = 50, face = "bold", colour = "grey", margin = margin(t = 10, b = -20)))+
geom_point(alpha = 1)+
geom_point(data=highlight_red,
aes(x_coord, y=y_coord),
color='red',
size=3)+
geom_point(data=highlight_orange,
aes(x_coord, y=y_coord),
color='orange',
size=3, alpha=0.8)+
guides(size=FALSE) +
theme(legend.title = element_blank()) +
coord_fixed(ratio = 1)
p<-p+
transition_time(time)+
shadow_wake(wake_length = 0, alpha = FALSE)+
enter_fade() +
exit_shrink()
animate(p, duration = 5, fps = 20, renderer = gifski_renderer())
附上gif。我希望最接近红点的感兴趣的词(例如前 5 个)在列表的右侧循环,就像它们在散点图上所做的那样,以反映红点周围实际发生的变化。我尝试添加代码,例如(到主 ggplot 代码)
# geom_text(aes(label = "{highlight_orange$X[highlight_orange$time == round(frame_time)][1]}"),
# hjust = -0.35,#adjust position
# size = 3,
# check_overlap = TRUE)
绝对没有运气 - 它也需要在一个整洁的列表中,当然不能重叠。任何帮助深表感谢。谢谢。
可重现 table(缩短为 select 个单词)
X x_coord y_coord time
1 word1 27.065716 59.019010 1
2 word2 22.936882 61.470710 1
3 word3 25.227564 62.780384 1
4 word4 27.878267 61.130566 1
5 word5 22.929253 61.345573 1
6 word6 14.307319 -44.314228 1
8760 word1 6.607143 -56.996240 2
8844 word2 -64.222240 -9.363668 2
10370 word3 -63.630585 -8.037662 2
10501 word4 -13.532422 -50.246193 2
13788 word5 5.143321 -56.445950 3
14583 word6 -67.655820 -29.041885 3
22566 word1 -48.322063 -24.847290 4
26496 word3 3.340046 14.917225 5
27050 word6 2.397841 -53.621520 6
28818 word3 -19.618414 37.386040 6
30582 word5 -15.498601 -51.142025 6
31513 word4 -3.114899 -14.631951 6
32772 word1 -4.706020 -9.429874 6
不确定我是否理解正确这是否是您要尝试做的。从你的问题来看,你似乎想在情节旁边的列表中显示一个包含 highlight_orange
中的单词的列表。如果单词从一帧更改到下一帧,您希望它们四处移动。
如果是这种情况,我找到了一种方法来做到这一点。但唯一困扰我的是我无法为 geom_text
设置不同的 enter
和 exit
属性。我希望 geom_text
使用 enter_fly
和 exit_fly
(让 geom_point
继续使用 enter_fade
和 exit_shrink
)。
显然 it is possible to do this,但我不知道该怎么做...
无论如何,我会按原样把我的答案放在这里,因为也许它对你有帮助。
# get max y and y (for positioning list in plot)
max.y <- ceiling(max(words$y_coord))
max.x <- ceiling(max(words$x_coord))
# calculate x/y position of list of words
highlight_orange <- highlight_orange %>%
dplyr::group_by(time) %>%
# position in list
dplyr::mutate(rank = row_number()) %>%
# compute x, y position in plot (I had to do trial and error with the y offset so the words would not overlap)
dplyr::mutate(x_pos=max.x, y_pos=max.y - 4*(rank-1)) %>% dplyr::ungroup()
p <- ggplot(words, aes(x_coord, y=y_coord, col = time)) +
theme_void()+
labs(title ="{words$time[words$time == round(frame_time)][1]}") +
theme(plot.title = element_text(size = 50, face = "bold", colour = "grey", margin = margin(t = 10, b = -20)))+
geom_point(alpha = 1)+
geom_point(data=highlight_red,
aes(x=x_coord, y=y_coord),
color='red',
size=3)+
geom_point(data=highlight_orange,
aes(x=x_coord, y=y_coord),
color='orange',
size=3, alpha=0.8)+
geom_text(data=highlight_orange, aes(x=x_pos, y=y_pos, label=X, group=X), hjust=0, vjust=0.5, colour='black') +
guides(size=FALSE, col=FALSE) +
theme(legend.title = element_blank()) +
# set "clip=off" so you can draw the text outside of the plotting area
coord_fixed(ratio = 1, clip = "off")
# I think you can set different enter/exit for each layer. But I could not figure out how...
p + transition_time(time) + shadow_wake(wake_length = 0, alpha = FALSE) +
enter_fade() + exit_shrink()