R语言 在最后一帧中截断图形

xqnpmsa8  于 2023-11-14  发布在  其他
关注(0)|答案(1)|浏览(145)

我用gganimate创建了下面的动画,但是如果你看一下GIF,最后一个点没有被绘制出来。有人能帮我弄清楚为什么会发生这种情况吗?另外,如果你注意到,橙子线上的第四个点被延迟绘制出来了。我怎么才能解决这个问题?有什么想法吗?

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)

字符串


的数据

anauzrmj

anauzrmj1#

此问题似乎是由transition_reveal()引起的。您的问题可以使用gapminder数据集进行演示。

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)

字符串
要解决这个问题,(完全归功于@Z.Lin,函数在这里定义)您可以定义transition_reveal2(),如下所示。

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

相关问题