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

Arrow pointing wrong direction using gganimate

我有简单的情节:

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 目录中将其交叉发布为 an issue)。

说明

这种现象的出现是因为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

解决方法

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

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)