在 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 设置不同的 enterexit 属性。我希望 geom_text 使用 enter_flyexit_fly(让 geom_point 继续使用 enter_fadeexit_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()