animated bar chart race in r

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

gap <- gapminder %>%
  filter(continent == "Asia") %>%
  group_by(year) %>%
  # The * 1 makes it possible to have non-integer ranks while sliding
  mutate(rank = min_rank(-gdpPercap) * 1) %>%
  ungroup()

p <- ggplot(gap, aes(rank, group = country, 
                     fill = as.factor(country), color = as.factor(country))) +
  geom_tile(aes(y = gdpPercap/2,
                height = gdpPercap,
                width = 0.9), alpha = 0.8, color = NA) +

  # text in x-axis (requires clip = "off" in coord_*)
  # paste(country, " ")  is a hack to make pretty spacing, since hjust > 1 
  #   leads to weird artifacts in text spacing.
  geom_text(aes(y = 0, label = paste(country, " ")), vjust = 0.2, hjust = 1) +

  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +

  labs(title='{closest_state}', x = "", y = "GFP per capita") +
  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(year, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

animate(p, fps = 25, duration = 20, width = 800, height = 600)

View another examples Add Own solution

4.67

Cookies 95 points

                                    gap_smoother &lt;- gapminder %&gt;%
  filter(continent == &quot;Asia&quot;) %&gt;%
  group_by(country) %&gt;%
  # Do somewhat rough interpolation for ranking
  # (Otherwise the ranking shifts unpleasantly fast.)
  complete(year = full_seq(year, 1)) %&gt;%
  mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %&gt;%
  group_by(year) %&gt;%
  mutate(rank = min_rank(-gdpPercap) * 1) %&gt;%
  ungroup() %&gt;%

  # Then interpolate further to quarter years for fast number ticking.
  # Interpolate the ranks calculated earlier.
  group_by(country) %&gt;%
  complete(year = full_seq(year, .5)) %&gt;%
  mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %&gt;%
  # &quot;approx&quot; below for linear interpolation. &quot;spline&quot; has a bouncy effect.
  mutate(rank =      approx(x = year, y = rank,      xout = year)$y) %&gt;%
  ungroup()  %&gt;% 
  arrange(country,year)

Thank you! 3