Arrow pointing wrong direction using gganimate

Question

I have simple plot:

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

that looks like this:

And I want to animate it with gganimate like so:

temp_animate <-
  temp_plot +
  transition_reveal(x)

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

However, when I do, the arrow is pointing the wrong direction right up until the very last frame (paused to make it clear that it is correct at that point).

I've tried playing with the values in arrow (including various angles, including negative) but nothing that I do seems to correct the orientation of the arrow (which should point along the current vector in each frame).

How can I get the arrow to point in the correct direction throughout? (I am cross-posting this as an issue in the github directory).

Answer 1

Explanation

This phenomenon arises because transition_reveal tweens values to get the transition position (where the arrowhead is located) in each frame. Whenever the calculated transition position coincides with an actual point on the dataset, there would be two sets of coordinates for the same location. This results in the reversed arrow.

(In your example, the arrow is reversed all the way because the default number of frames is the same as the number of rows in your data, so each calculated transition position is a duplicate of an existing data point. If the frame number is some other number, e.g. 137, the arrow would reverse in some frames & point straight in others.)

We can demonstrate this phenomenon with a smaller dataset:

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

Workaround

The key function here is expand_data from the ggproto object TransitionReveal. I wrote a modified version that adds a check for duplicated positions before returning the expanded dataset:

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

We can define an alternate version of transition_reveal that uses the above instead:

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

Demonstrate with the original data:

temp_plot + transition_reveal2(x)