rggplot2dplyrtidyversegganimate

How can I add intersection points on gganimate?


I am setting up an animation of two curves as the slope of one of them changes, and I want to show the changing intersection points at each state in the animation. I know where the intersection points are, but don't know how to include them in the plot at each state.

I tried adding a separate transition_manual for the intersection points at each state, but then it would only show that, and not the second transition.

library(tidyverse)
library(gganimate)

tbl <- tibble(x = seq(-8, 8, by = .01),
             A_1 = 4*x,
             B_1 = x^2,
             A_2 = 3*x,
             B_2 = x^2,
             A_3 = 2*x,
             B_3 = x^2,
             A_4 = x,
             B_4 = x^2,
             A_5 = 0*x,
             B_5 = x^2) %>%
 gather(group, density, A_1:B_5) %>%
 separate(group, c("group", "type"), sep = "_") %>%
 mutate(type = as.numeric(type)) %>%
 mutate(Title = case_when(
   type == 1 ~ "A = 0, B = 4",
   type == 2 ~ "A = 0, B = 3",
   type == 3 ~ "A = 0, B = 2",
   type == 4 ~ "A = 0, B = 1",
   TRUE ~ "A = B = 0"
 ))


  ggplot(tbl) + geom_line(mapping = aes(x = x, y = density, colour = group)) +
 transition_states(Title, transition_length = .5, state_length = 2, wrap = TRUE) +
 labs(title = '{closest_state}') + ylab("f(x)") 

This mostly works the way I want it to, except for not showing the intersection points.


Solution

  • Here's an approach using manual calculation of the intersections. In this case it relies on there being exact intersections among the values calculated, but it could be modified to find the closest matches.

    intersects <- tbl %>%
      spread(group, density) %>%
      mutate(var = A - B) %>%
      # group_by(Title) %>%       # Alternative: find top 2 by Title
      # top_n(2, -abs(var)) %>%   # Alternative: find top 2 by Title 
      #                           # (Won't work in some edge cases...)
      filter(var == 0) %>%  # presumes exact intersection exists in rows
      mutate(intersect = TRUE) %>%
      select(x, type, Title, density = A, intersect)
    
    tbl2 <- tbl %>%
      left_join(intersects)
    
    ggplot(tbl2, aes(x, density, colour = group)) + 
      geom_line() +
      geom_point(data = tbl2 %>% filter(intersect)) +
      transition_states(Title, transition_length = .5, state_length = 2, wrap = TRUE) +
      labs(title = '{closest_state}') + ylab("f(x)") 
    

    enter image description here