Animated sorted bar chart: problem with overlapping bars

Question

I created an animated bar chart which displays the scored goals by some players. Below the whole code is displayed how I came to the output.

The animation works as wished. However, bars with the same value overlap.

I would like to prevent the bars from overlapping. The best case would be for the player who scored first to be displayed above other players at the same rank.

The order of players who scored equally at the beginning of the animation does not matter.

library(tidyverse)
library(gganimate)
theme_set(theme_classic())

df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6), 
                 Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6), 
                 Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
                 Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
                 stringsAsFactors = F)

gap <- df %>%
  group_by(Gameday) %>%
  mutate(rank = min_rank(-Goals) * 1,
     Value_rel = Goals/Goals[rank==1],
     Value_lbl = paste0(" ", Goals)) %>%
  filter(rank <=10) %>%
  ungroup()

p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
                 fill = as.factor(Player), color = as.factor(Player))) +
  geom_tile(aes(y = Goals/2,
            height = Goals,
            width = 0.9), alpha = 0.8, color = NA) +
  geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
  geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +
  labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
  theme(plot.title = element_text(hjust = 0, size = 22),
       axis.ticks.y = element_blank(),  # These relate to the axes post-flip
       axis.text.y  = element_blank(),  # These relate to the axes post-flip
       plot.margin = margin(1,1,1,4, "cm")) +
  transition_states(Gameday, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

p

The code outputs following plot:

Additional note:

At the end, the bars should be displayed according to the example below. Preferably the bars should not be on the same height, to increase the readability.

Thank you very much for your effort!

Answer 1

Edited solution based on clarification:

gap %>%

  # for each player, note his the rank from his previous day
  group_by(Player) %>%
  arrange(Gameday) %>%
  mutate(prev.rank = lag(rank)) %>%
  ungroup() %>%

  # for every game day,
  # sort players by rank & break ties by previous day's rank
  group_by(Gameday) %>%
  arrange(rank, prev.rank) %>%
  mutate(x = seq(1, n())) %>%
  ungroup() %>%

  ggplot(aes(x = x, y = Goals, fill = Player, color = Player)) +
  # geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
  geom_col() +
  geom_text(aes(y = 0, label = Player), hjust = 1) +
  geom_text(aes(label = Value_lbl), hjust = 0) +

  # rest of the code below is unchanged from the question
  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +
  labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
  theme(plot.title = element_text(hjust = 0, size = 22),
        axis.ticks.y = element_blank(), 
        axis.text.y  = element_blank(),
        plot.margin = margin(1,1,1,4, "cm")) +
  transition_states(Gameday, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

Original solution:

gap %>%

  # for each player, note his the rank from his previous day
  group_by(Player) %>%
  arrange(Gameday) %>%
  mutate(prev.rank = lag(rank)) %>%
  ungroup() %>%

  # for every game day & every rank,
  # reduce tile width if there are multiple players sharing that rank, 
  # sort players in order of who reached that rank first, 
  # & calculate the appropriate tile midpoint depending on how many players are there
  group_by(Gameday, rank) %>%
  mutate(n = n_distinct(Player)) %>%
  mutate(width = 0.9 / n_distinct(Player)) %>%
  arrange(prev.rank) %>%
  mutate(x = rank + 0.9 * (seq(1, 2 * n() - 1, by = 2) / 2 / n() - 0.5)) %>%
  ungroup() %>%

  ggplot(aes(x = x, fill = Player, color = Player)) +
  geom_tile(aes(y = Goals/2, height = Goals, width = width)) +
  geom_text(aes(y = 0, label = Player), hjust = 1) +
  geom_text(aes(y = Goals, label = Value_lbl), hjust = 0) +

  # rest of the code below is unchanged from the question
  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +
  labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
  theme(plot.title = element_text(hjust = 0, size = 22),
        axis.ticks.y = element_blank(), 
        axis.text.y  = element_blank(),
        plot.margin = margin(1,1,1,4, "cm")) +
  transition_states(Gameday, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

Note: This isn't perfect. I imagine the simple logic above for determining player order within the same day / rank won't be ideal if there are too many players / too many days, since it only looks backwards by one day. But it works for this example, & I don't know enough about football (at least I think this is football?) to extrapolate about your use case.

Answer 2

A simpler solution: you just need the rank to be the order of both goals and players' name (no need to remember rank last week or worry about the number of players - as long as their names are different, the bars won't be overlapped)

library(tidyverse)
library(gganimate)
theme_set(theme_classic())

df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6), 
                 Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6), 
                 Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
                 Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
                 stringsAsFactors = F)

gap <- df %>%
  group_by(Gameday) %>%
  mutate(rank1 = min_rank(-Goals) * 1,
         Value_rel = Goals/Goals[rank1==1],
         Value_lbl = paste0(" ", Goals)) %>%
  filter(rank1 <=10) %>%
  ungroup() %>%
  
  group_by(Gameday) %>%
  arrange(rank1, Player) %>%
  mutate(rank = seq(1, n())) %>%
  ungroup() 

p <- ggplot(gap, aes(rank, group = Player, stat = "identity",
                     fill = as.factor(Player), color = as.factor(Player))) +
  geom_tile(aes(y = Goals/2,
                height = Goals,
                width = 0.9), alpha = 0.8, color = NA) +
  geom_text(aes(y = 0, label = paste(Player, " ")), vjust = 0.2, hjust = 1) +
  geom_text(aes(y=Goals,label = Value_lbl, hjust=0)) +
  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +
  labs(title = "Gameday {closest_state}", x="", y = "Goals scored") +
  theme(plot.title = element_text(hjust = 0, size = 22),
        axis.ticks.y = element_blank(),  # These relate to the axes post-flip
        axis.text.y  = element_blank(),  # These relate to the axes post-flip
        plot.margin = margin(1,1,1,4, "cm")) +
  transition_states(Gameday, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

p