Как я могу добавить точки пересечения в gganimate?

Question

Я настраиваю анимацию из двух кривых при изменении наклона одной из них, и я хочу показать изменяющиеся точки пересечения в каждом состоянии анимации. Я знаю, где находятся точки пересечения, но не знаю, как включить их в график в каждом штате.

Я попытался добавить отдельный файл transition_manual для точек пересечения в каждом состоянии, но тогда это только показало бы это, а не второй переход.

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

В основном это работает так, как я хочу, за исключением того, что не отображаются точки пересечения.

Answer 1

Вот подход с использованием ручного расчета пересечений. В этом случае он основан на точных пересечениях между вычисленными значениями, но его можно изменить, чтобы найти самые близкие совпадения.

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

Answer 2

Идея в том, что вам нужно добавить столбец, который имеет пересечение для каждого кадра (здесь, например, Title).

library(tidyverse)
library(gganimate)

#data:
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"))

#pseudo-intersection points for each frame:
intersection <- tbl %>% 
  distinct(Title) %>% 
  mutate(x1 = c(0,0,0,0,0),
         y1 = c(0,0,0,0,0),
         x2 = c(4,3,2,1,NA),
         y2 = c(16,9,5,2,NA))

#plot:
tbl %>% 
  right_join(intersection, by="Title") %>% 
  ggplot(.) + geom_line(mapping = aes(x = x, y = density, colour = group)) +
              geom_point(mapping = aes(x = x1, y = y1, colour = "green")) +
              geom_point(mapping = aes(x = x2, y = y2, colour = "green")) +
              transition_states(Title, transition_length = 0.5, state_length = 2, wrap = TRUE) +
              labs(title = '{closest_state}') + ylab("f(x)") 

^{Создано в 2019-06-20 пакетом Представить (v0.3.0)}