Search code examples
rggplot2gganimate

Adding list outside of ggplot2 which changes as time progresses - gganimate

I have created an animated plot using ggplot2 and then gganimate. The plot shows points changing in time and I have highlighted in red, a point of interest, and in yellow, points that stick around with the red point over time.

I am trying to have outside of the plot on the right hand side, what the red and yellow points are (as in their identity in the dataframe) and change according to the time point. as you see some yellow points disappear etc - however I cannot make this work. I have tried geom_text(),`` labs() with no luck.

The code for the plot is:

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())

Attached is the gif. I would like the words of interest that are closest to the red point (say top 5 for example) to cycle on the right hand side in a list as they do on the scatter plot to reflect what is actually changing around the red point. I have tried adding code such as (to the main ggplot code)

# geom_text(aes(label = "{highlight_orange$X[highlight_orange$time == round(frame_time)][1]}"),
    #        hjust = -0.35,#adjust position
     #       size = 3,
      #      check_overlap = TRUE)

with absolutely no luck - it needs to be in a neat list as well and not overlapping of course. any help is much appreciated. thank you.

enter image description here

Reproducible table (shortened for select words)

         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
Solution

  • Not sure I understood correctly if this is what you are trying to do. From your question it seems that you would like to show a list with the words in highlight_orange in a list next to the plot. And you would like for the words to move around if they change from one frame to the next.

    If this is the case, I kind of found a way to do this. But the only thing is bothering me is that I could not set a different enter and exit property for the geom_text. I would like geom_text to use enter_fly and exit_fly (and let geom_point keep using enter_fade and exit_shrink).

    Apparently it is possible to do this, but I could not figure out how to do this...

    Anyway, I will put my answer here as is because maybe it helps you.

    # 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()

    enter image description here