使用 gganimate 指向错误方向的箭头

Question

我有简单的情节：

sample_data <-
  data.frame(
    x = 1:100
    , y = 1:100
  )

temp_plot <-
  ggplot(sample_data
         , aes(x = x
               , y = y)) +
  geom_line(
    size = 3
    , arrow = arrow()
    , lineend = "round"
    , linejoin = "round"
  ) +
  theme_minimal()

看起来像这样：

gganimate我想像这样制作它的动画：

temp_animate <-
  temp_plot +
  transition_reveal(x)

anim_save("temp_animate.gif"
          , temp_animate
          , "~/Downloads/"
          , end_pause = 10)

然而，当我这样做时，箭头一直指向错误的方向，直到最后一帧（暂停以表明该方向是正确的）。

我尝试过使用 中的值arrow（包括各种角度，包括负值），但我所做的似乎都没有纠正箭头的方向（它应该沿着每帧中的当前向量指向）。

如何让箭头始终指向正确的方向？（我将其作为问题交叉发布到 github 目录中）。

Answer 1

解释

出现这种现象的原因是transition_reveal补间值以获得每个帧中的过渡位置（箭头所在的位置）。每当计算出的过渡位置与数据集上的实际点重合时，同一位置就会有两组坐标。这导致反向箭头。

（在您的示例中，箭头一直反向，因为默认帧数与数据中的行数相同，因此每个计算的过渡位置都是现有数据点的重复。如果帧数是某个其他数字，例如 137，箭头在某些帧中会反转，而在其他帧中会指向直线。）

我们可以用较小的数据集来证明这种现象：

p <- ggplot(data.frame(x = 1:4, y = 1:4),
            aes(x, y)) +
  geom_line(size = 3, arrow = arrow(), lineend = "round", linejoin = "round") +
  theme_minimal() +
  transition_reveal(x)

animate(p + ggtitle("4 frames"), nframes = 4, fps = 1) # arrow remains reversed till the end
animate(p + ggtitle("10 frames"), nframes = 10, fps = 1) # arrow flips back & forth throughout

解决方法

这里的关键函数expand_data来自 ggproto 对象TransitionReveal。我编写了一个修改版本，在返回扩展数据集之前添加了对重复位置的检查：

TransitionReveal2 <- ggproto(
  "TransitionReveal2", TransitionReveal,
  expand_panel = function (self, data, type, id, match, ease, enter, exit, params, 
                           layer_index) {    
    row_vars <- self$get_row_vars(data)
    if (is.null(row_vars)) 
      return(data)
    data$group <- paste0(row_vars$before, row_vars$after)
    time <- as.numeric(row_vars$along)
    all_frames <- switch(type,
                         point = tweenr:::tween_along(data, ease, params$nframes, 
                                                      !!time, group, c(1, params$nframes),
                                                      FALSE, params$keep_last),
                         path = tweenr:::tween_along(data, ease, params$nframes, 
                                                     !!time, group, c(1, params$nframes),
                                                     TRUE, params$keep_last),
                         polygon = tweenr:::tween_along(data, ease, params$nframes, 
                                                        !!time, group, c(1, params$nframes),
                                                        TRUE, params$keep_last),
                         stop(type, " layers not currently supported by transition_reveal", 
                              call. = FALSE))
    all_frames$group <- paste0(all_frames$group, "<", all_frames$.frame, ">")
    all_frames$.frame <- NULL
    
    # added step to filter out transition rows with duplicated positions
    all_frames <- all_frames %>%
      filter(!(.phase == "transition" &
                 abs(x - lag(x)) <= sqrt(.Machine$double.eps) &
                 abs(y - lag(y)) <= sqrt(.Machine$double.eps)))
    
    all_frames
  }
)

transition_reveal我们可以定义使用上面的替代版本：

transition_reveal2 <- function (along, range = NULL, keep_last = TRUE) {
  along_quo <- enquo(along)
  gganimate:::require_quo(along_quo, "along")
  ggproto(NULL, TransitionReveal2, # instead of TransitionReveal
          params = list(along_quo = along_quo, range = range, keep_last = keep_last))
}

用原始数据演示：

temp_plot + transition_reveal2(x)