如何在gganimate上添加交点?

时间:2019-06-20 14:03:30

标签: r ggplot2 dplyr tidyverse gganimate

我要设置两条曲线的动画,因为其中一条的斜率会发生变化,并且我想显示动画中每种状态下变化的相交点。我知道交点在哪里,但不知道如何在每个状态下将它们包括在图中。

我尝试为每个状态的交点添加一个单独的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)") 

除了不显示相交点之外,这大部分都可以按照我想要的方式进行。

2 个答案:

答案 0 :(得分: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)") 

enter image description here

答案 1 :(得分:0)

这里的想法是,您需要添加一列,该列在每个帧之间都具有交集(此处为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)") 

reprex package(v0.3.0)于2019-06-20创建