gganimate chart cuttng off in last frame

55 Views Asked by At

I've created an animation below using gganimate but if you look at the GIF, the last point doesn't get plotted. Could some one help me figure out why this is happening. Also, if you notice, the 4th point on the orange line is plotted with a delay. How can I fix this? Any ideas?

library(ggplot2)
library(gganimate)
library(dplyr)
library(readxl)

### Load the blueberry price data 
blueberries_data <- read_excel("Volume_Price.xlsx")

### Select rows 1 to 42 in the "Value" column and divide by 1,000,000
blueberries_data[1:42, "Value"] <- blueberries_data[1:42, "Value"] / 1000000

blueberries_data$Year <- as.factor(blueberries_data$Year)

### Define line and point colors
line_colors <- c("Price" = "#33d1ae", "Volume" = "#ff9326")
point_colors <- c("Price" = "#33d1ae", "Volume" = "#ff9326")

### Create an animated plot for weekly blueberry prices
p <- ggplot(blueberries_data, aes(x = Week)) +
  geom_line(data = filter(blueberries_data, Year == "Price"), aes(y = Value, color = "Price"), show.legend = TRUE) +
  geom_line(data = filter(blueberries_data, Year == "Volume"), aes(y = Value * 5, color = "Volume"), show.legend = TRUE) +
  geom_point(aes(y = ifelse(Year == "Volume", Value * 5, Value), group = seq_along(Week), color = Year), size = 2, alpha = 1) +
  labs(y = 'Weekly Blueberry Prices', color = "") +
  scale_color_manual(values = line_colors) +
  scale_y_continuous(
    name = "Price",
    sec.axis = sec_axis(~. / 5, name = "Volume"),
    breaks = seq(0, 60, 10)  # Adjust the breaks to extend to 60 on the primary y-axis
  ) +
  lims(x = c(0, 45), y = c(0, 60)) +  # Set x and y-axis limits
  theme(legend.position = "bottom",  # Set legend position
        panel.background = element_rect(fill = "white"),  # Set panel background color to white
        panel.grid.major.y = element_line(color = "grey89"),  # Set major horizontal grid lines to grey
        panel.grid.minor.y = element_blank())  # Remove minor horizontal grid lines

anim_plot <- p + transition_reveal(Week)

animate(anim_plot, fps = 10, duration = 10, end_pause = 40)  # Adjust the frames per second (fps) as needed
anim_save("Blueberry_weekly_prices.gif", last_animation(), width = 2, height = 2)

enter image description here

1

There are 1 best solutions below

0
On

This issue seems to be caused by transition_reveal(). Your issue can be demonstrated using gapminder dataset.

library(ggplot2)
library(gganimate)
library(dplyr)
library(gapminder)
library(gifski)
library(transformr)

mycountries <- c("Afghanistan","India")
df1 <- gapminder %>% dplyr::filter(country %in% mycountries)

### Define line and point colors
line_colors  <- c("#33d1ae", "#ff9326")
point_colors <- c("#33d1ae", "#ff9326")

### Create an animated plot  
p <- ggplot(df1, aes(x = year, y=lifeExp)) + 
  geom_line(aes(color = country, group=country), show.legend = TRUE)  +
  geom_point(aes(group = seq_along(year), color = country), size = 2, alpha = 1) + #
  labs(y = 'Life Expectancy', color = "") +
  scale_color_manual(values = line_colors)   +
  theme(legend.position = "bottom",  # Set legend position
        panel.background = element_rect(fill = "white"),  # Set panel background color to white
        panel.grid.major.y = element_line(color = "grey89"),  # Set major horizontal grid lines to grey
        panel.grid.minor.y = element_blank())  # Remove minor horizontal grid lines


anim_plot <- p + transition_reveal(year)

### animation with some missing points
animate(anim_plot, fps = 10, end_pause = 12, renderer = gifski_renderer() )  # Adjust the frames per second (fps) as needed
anim_save("gap1.gif", last_animation(), width = 2, height = 2)

To fix the issue, (full credit to @Z.Lin and the functions are defined here) you can define transition_reveal2() as shown below.

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

### animation displays all points
anim_plot2 <- p + transition_reveal2(year)
animate(anim_plot2, fps = 10, end_pause = 12, renderer = gifski_renderer() )