0

我正在使用 ggstance 包中的 geom_colh 创建条形图比赛动画。现在，动画非常不稳定，看起来不是一个连续的动画，而是一个接一个的图像。下面是当前动画的样子：

在此处输入图像描述

相反，我希望酒吧在相互通过时从一个位置“滑行”到另一个位置。以下是我目前拥有的代码的代表：

library(tidyverse)
library(dplyr)
library(ggplot2)
library(gganimate)
library(ggstance)
library(zoo)
library(gifski)
library(shadowtext)

stats <- read_csv(url("https://raw.githubusercontent.com/samhoppen/Fantasy-Evaluator/main/Data/Animation%20Test%20Data.csv")) %>% 
  mutate(unique_id = paste0(player_name, recent_team))
all_weeks <- read_csv(url("https://raw.githubusercontent.com/samhoppen/Fantasy-Evaluator/main/Data/Animation%20Weeks%20Data.csv"))

NFL_pri <- stats$team_color
names(NFL_pri) <- stats$unique_id
NFL_sec <- stats$team_color2
names(NFL_sec) <- stats$unique_id

rb_ani <- ggplot(data = stats, aes(group = player_name)) +
  geom_colh(aes(x = tot_fpts, y = rank, color = unique_id, fill = unique_id), position = 'identity', 
            size = 2, width = 0.8) + 
  scale_x_continuous(expand = expansion(mult = c(0, 0.05))) +
  scale_y_reverse(expand = expansion(mult = c(0.01, 0.01)))+
  geom_shadowtext(aes(x = name_loc, y = rank, label = player_name, color = unique_id), 
                  bg.color = 'white', size = 5.5, na.rm = T, bg.r = 0.075, show.legend = FALSE) +
  scale_color_manual(values = NFL_sec)+
  scale_fill_manual(values = NFL_pri)+ 
  labs(title = "Highest-scoring Fantasy Running Backs of the Past Decade",
       subtitle = paste0("{all_weeks$week_name[as.numeric(previous_state)]}"),
       caption = "Figure: @SamHoppen | Data: @nflfastR",
       y = "",
       x = "Total Fantasy Points")+
  theme(legend.position = "none",
        plot.title = element_text(size = 24, face = "bold", margin = margin(0,0,10,0)),
        plot.subtitle = element_text(size = 12, margin = margin(0,0,10,0)),
        plot.caption = element_text(size = 12)) +
  transition_states(states = week_order, transition_length = 2, state_length = 1, wrap = F) +
  view_follow(fixed_y = TRUE) +
  enter_fly(y_loc = -21) +
  exit_fly(y_loc = -21) +
  ease_aes('linear')

anim <- animate(rb_ani, nframes = 100, fps = 5,renderer = gifski_renderer(), height = 900, width = 1600)

我尝试更改过渡长度/状态长度、删除主题项、删除颜色、删除 stat = 'identity' 参数、更改组变量和帧数/fps。我不知道下一步该尝试什么。任何建议都会很棒！

4

1 回答 1

2

这里的部分挑战是每周的排名非常不稳定。为了使动画流畅，您需要使动画相当长，或者选择几周的子集来计算排名。在这里，我仅限于第 30-39 周，并添加了更多帧。

我还做了一些更多的数据清理，以给所有玩家在每周的排名，即使他们没有被包括在stats那一周。

在此处输入图像描述

animate(
  stats %>%
    # Some week_name missing from stats, will use week_order to get from all_weeks
    select(-week_name) %>%
    left_join(all_weeks %>% select(week_order, week_name), by = "week_order") %>%
    

    # add every week for each player, and fill in any missing tot_fpts or team_colors
    select(week_order, week_name, player_name, tot_fpts, 
           unique_id, team_color, team_color2) %>%
    complete(week_order, player_name) %>%
    fill(tot_fpts, .direction = "down") %>%
    fill(unique_id, team_color, team_color2, .direction = "downup") %>%

    # only keep players who had >0 max_tot_fpts and weeks 30-39
    group_by(player_name) %>%
    mutate(max_tot_fpts = max(tot_fpts)) %>%
    filter(max_tot_fpts > 0, week_order >= 30, week_order < 40) %>% 
  

    # smooth out tot_fpts
    mutate(tot_fpts_smooth = spline(x = week_order, y = tot_fpts, xout = week_order)$y) %>%

    # Calc rank for every week, only keep top 20
    group_by(week_order) %>%
    arrange(-tot_fpts_smooth, player_name) %>%
    mutate(rank = row_number()) %>%
    ungroup() %>% 
    filter(rank <= 20) %>% 
    
    ggplot(aes(group = player_name, y = rank)) +
    geom_tile(aes(x = tot_fpts/2, height = 0.9, width = tot_fpts,
                  color = unique_id, fill = unique_id)) +
    geom_shadowtext(aes(x = tot_fpts, y = rank, label = player_name, color = unique_id), 
                    bg.color = 'white', size = 3.5, na.rm = T, bg.r = 0.075, 
                    show.legend = FALSE, hjust = 1.1) +
    
    # geom_text(aes(x = tot_fpts, label = paste(player_name, " ")), vjust = 0.2, hjust = 1) +
    scale_y_reverse(breaks = 1:20, minor_breaks = NULL) +
    scale_color_manual(values = NFL_sec)+
    scale_fill_manual(values = NFL_pri)+ 
    labs(title = "Highest-scoring Fantasy Running Backs of the Past Decade",
         subtitle = paste0("{all_weeks$week_name[as.numeric(previous_state)]}"),
         caption = "Figure: @SamHoppen | Data: @nflfastR",
         y = "",
         x = "Total Fantasy Points")+
    theme_minimal() +
    theme(legend.position = "none",
          plot.title = element_text(size = 14, face = "bold", margin = margin(0,0,10,0)),
          plot.subtitle = element_text(size = 12, margin = margin(0,0,10,0)),
          plot.caption = element_text(size = 12)) +
    
    transition_states(week_order, state_length = 0) +
    view_follow(fixed_y = TRUE) +
    enter_fly(y_loc = -21) +
    exit_fly(y_loc = -21) +
    
    ease_aes('linear'),
  fps = 20, duration = 4, width = 400, height = 300)
于 2021-04-04T18:32:25.347 回答