Trying to create animated bar plot with sliding bars that overtake each other.

[andrews]

Hey guys. I've been struggling to create an animated data over time bar chart for months now. My goal is to have bars that slide and overtake each other depending on their values. I've got a basic version of this working using geom_tile. Here's my current plot:

https://i.imgur.com/8OHoHpZ.mp4

The problems I can't seem to solve are:

1. I need the graph to only focus on the top 10 ranking values at any time. Right now it is squishing all values onto the screen which makes them very small and overwhelming to the viewer.

The image below is what I'm trying to achieve. It only shows the top 10 bars on screen. The bars below that slide out of view, keeping the plot simple visually.

Gyazo Screen Video

2. Including images for each bar. You can also see this effect in the example above. (Picture of a person, company logo etc.)
I think I can accomplish this with geom_image? I've gotten images to work with a static plot but I'm not sure how to make it work with an animated geom_tile plot.

3. Scale the plot to the maximum current value on screen, not the maximum value of all time. Currently most of my bars are very small due to the plot being scaled by the highest value ever seen in the data.

I greatly appreciate any help. Very sorry if these are obvious questions. I've looked around quite a but but can't seem to find answers to these. I'm sure you can tell I'm a big noob with R and RStudio.

If anyone can tell me how to solve even one of these issues it would be a huge help to me. Thank you for your time!

Here's my plot's R code:

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

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

animatedPlot <- ggplot(dataForAnim, aes(rank, group = country, 
                     fill = as.factor(country), color = as.factor(country), height=.5)) +
  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.5, size = 32),
        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')

animatedPlot

[woodward]

You can set x and y axis limits in scale. Is x = rank? It's better to put the aesthetics in the geom not in the ggplot() then it's more obvious what is happening. Why do you need coord_flip? It makes things confusing.

  scale_x_continuous(limits = c(max(rank)-10, max(rank))) +
  scale_y_continuous(labels = scales::comma, limits = c(min(gdpPercap/2), max(gdpPercap/2))) +

[andrews]

Hey. Thanks for the response I really appreciate it! x is = rank and I've moved it to the geom aes as you've suggested. Most of this code is not originally mine so I can't explain it too well. It looks like coord_flip is necessary to keep the bars horizontal instead of vertical? I removed it and they became vertical, but maybe there is a better way to do it? I've also added your code for scale x continuous and scale y continuous but am getting the error: Error in max(rank) : invalid 'type' (closure) of argument. I'm not sure what is causing this. Here's my updated R code:

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

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

animatedPlot <- ggplot(dataForAnim, aes(group = country, 
                     fill = as.factor(country), color = as.factor(country), height=.5)) +
  geom_tile(aes(x = rank, 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(x = rank, y = 0, label = paste(country, " ")), vjust = 0.2, hjust = 1) +
  
  coord_flip(clip = "off", expand = FALSE) +
  scale_x_continuous(limits = c(max(rank)-10, max(rank))) +
  scale_y_continuous(labels = scales::comma, limits = c(min(gdpPercap/2), max(gdpPercap/2))) +
  scale_x_reverse() +
  guides(color = FALSE, fill = FALSE) +
  
  labs(title='{closest_state}', x = "", y = "GDP per capita") +
  theme(plot.title = element_text(hjust = 0.5, size = 32),
        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')

animatedPlot

[woodward]

coord_flip(xlim) lets you fix axes bounds, and view_follow() lets you box the currently plotted data. However there is a bug that spawns extra axes and causes flickering when you combine these two things view_follow() + coord_flip() creates issues in axes titles/text · Issue #336 · thomasp85/gganimate · GitHub
coord_flip(clip = "off") is also a problem since while it shows the country names, it also shows bars outside the x axis limits.

[woodward]

Here's a hack that does it. It works by modifying the data and labels for countries that are not in the top 10, so they are plotted but not visible. The flickering above is caused by a bug when combining coord_flip and view_follow, so we can't use view_follow, and the axis must be fixed, so show GDP as a fraction of max instead.

library(tidyverse)
library(gganimate)
library(gapminder)
library(av)

theme_set(theme_classic())

dataForAnim <- gapminder %>%
  filter(continent == "Americas") %>%
  group_by(year) %>%
  mutate(
    rank = as.numeric(min_rank(-gdpPercap)),
    label = if_else(rank > 10, "", paste(country, " ")),
    label2 = if_else(rank > 10, "", paste(" $", format(gdpPercap, nsmall = 0, big.mark = ","))),
    gdpPercap = if_else(rank > 10, gdpPercap[rank == 10], gdpPercap),
    gdpPercap2 = gdpPercap / max(gdpPercap) * 100, # percentage of max
    rank = if_else(rank > 10, 10, rank),
  ) %>%
  ungroup()

animatedPlot <- ggplot(data = dataForAnim) + # this is the data
  geom_tile(
    mapping = aes( # these aesthetics change with the data
      x = rank,
      y = gdpPercap2 / 2,
      height = gdpPercap2,
      fill = as.factor(country) # group is not needed
      # colour = as.factor(country)
    ),
    width = 0.9, # these aesthetics are constant
    alpha = 1 # hide bars for rank > 10
  ) +

  # 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(
        mapping = aes(
            x = rank,
            y = 0,
            label = label
        ),
        vjust = 0.2,
        hjust = 1
    ) +
    geom_text(
        mapping = aes(
            x = rank,
            y = gdpPercap2,
            label = label2
        ),
        vjust = 0.2,
        hjust = 0
    ) +

  coord_flip(
    clip = "off",
    expand = FALSE,
    xlim = c(0.45, 10.55) # show rank 1 to 10
  ) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() + # put rank 1 at the top
  guides(color = FALSE, fill = FALSE) +

  labs(title = "{closest_state}", x = "", y = "GDP per capita (% of max)") +
  theme(
    plot.title = element_text(hjust = 0.5, size = 32),
    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, 3, 1, 4, "cm")
  ) +

  transition_states(year, transition_length = 4, state_length = 1) +
  ease_aes("cubic-in-out")

print(animatedPlot)

^{Created on 2019-12-09 by the reprex package (v0.3.0)}

[woodward]

See also

Animated plot with a moving facet zoom via gganimate and ggforce?

[andrews]

Wow, that looks fantastic. You even cleaned up and simplified the code. Thank you so much! So if I'm understanding correctly, all countries below rank 10 are sitting in the rank 10 position but are invisible? Also, and I apologize if this is an obvious question, but in your updated code in geom_tile it says:

alpha = 1 # hide bars for rank > 10

why does setting the alpha to 1 hide the bars greater than rank 10?

A few other questions:

1. Is it not practical to show the actual value ranges on the x axis due to the flickering bug? It's not a big deal if it isn't possible as the rank of the bars themselves is the main thing I'm hoping to showcase.

2. In the example plot I posted in the original question (posted it again below), I notice that the rank 10 bar can slide down off the screen and another takes its place. I'm wondering if they are actually plotting 11 bars then rendering at a slightly taller than target aspect ratio and manually cropping out the 11th bar to create that effect? They've also moved their x axis to the top of the plot which makes me suspect this could be the case as well.

Thank you so much for your help!

[woodward]

Hi Andrew

The countries with rank >10 are hidden behind the rank = 10 bar. If you put alpha < 1 you can see them hiding there. You can make them NA but then they disappear and appear and you get gaps.

You can show the actual GDP values on the x axis or you can scale the x axis to the maximum GDP value for that year, but not both. You can do both if you use view_follow() but the get the duplicated axes and flickering bug as in the linked github issue above. There might be another way but I couldn't find one. The thing is that gganimate natively doesn't allow animation of axes.

Because you use clip = "off" any bars that slide down below the x axis are still visible, which is ugly. In your example I think they plotted all bars but just clipped the axes. This is what I did in a similar animation using plotly, which allow quite a bit more control.
https://dairynz.shinyapps.io/breeding_worth/

Good luck!

[raytong]

Hi @andrews. It is an interesting question. I would like to provide my version of code using geom_col. For problem 1, use view_follow to limit the display of the top 10 countries. For problem 2, use geom_image from package ggimage to render the images. For problem 3, calculate the height of the bars against the max of the year to fix the height of the highest bar.

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

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

dataForAnim %>%
  ggplot() +
  geom_col(aes(max(rank) - rank, height, fill = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8))) +
  geom_text(aes(max(rank) - rank, -0.03, label = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 1) +
  geom_text(aes(max(rank) - rank, height + 0.1, label = gdpPercap, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 0) +
  geom_image(aes(max(rank) - rank, height + 0.05), image = "https://www.r-project.org/logo/Rlogo.png") +
  coord_flip() +
  guides(fill = FALSE, alpha = FALSE) +
  labs(title='{closest_state}', x = NULL, y = NULL) +
  scale_y_continuous(limits = c(-0.4, 1.5)) +
  theme_void() +
  transition_states(year, transition_length = 200000, state_length = 2000, wrap = FALSE) +
  view_follow(fixed_x = c(15, 24), fixed_y = c(-0.4, 1.5))

[andrews]

Amazing! That solves all the issues I had. Thank you so much! Do you have any idea how to remove the decimals from the interpolated GDP values? I've tried a few things but haven't had any luck so far. I've also tried to do some comma formatting to the GDP values but it doesn't interpolate at all after the formatting is applied.

[raytong]

@andrews. It can be done by making a custom geom_numeric function which modified from geom_text.

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

geom_numeric <- function(mapping = NULL, data = NULL,
                         stat = "identity", position = "identity",
                         ...,
                         parse = FALSE,
                         nudge_x = 0,
                         nudge_y = 0,
                         check_overlap = FALSE,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE)
{
  if (!missing(nudge_x) || !missing(nudge_y)) {
    if (!missing(position)) {
      stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE)
    }
    
    position <- position_nudge(nudge_x, nudge_y)
  }
  
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomNumeric,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      parse = parse,
      check_overlap = check_overlap,
      na.rm = na.rm,
      ...
    )
  )
}

GeomNumeric <- ggproto("GeomNumeric", Geom,
                       required_aes = c("x", "y", "label"),
                       
                       default_aes = aes(
                         colour = "black", size = 3.88, angle = 0, hjust = 0.5,
                         vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2
                       ),
                       
                       draw_panel = function(data, panel_params, coord, parse = FALSE,
                                             na.rm = FALSE, check_overlap = FALSE) {
                         lab <- data$label
                         if (parse) {
                           lab <- scales::comma(as.numeric(lab), accuracy = 1)
                         }
                         
                         data <- coord$transform(data, panel_params)
                         if (is.character(data$vjust)) {
                           data$vjust <- compute_just(data$vjust, data$y)
                         }
                         if (is.character(data$hjust)) {
                           data$hjust <- compute_just(data$hjust, data$x)
                         }
                         
                         grid::textGrob(
                           lab,
                           data$x, data$y, default.units = "native",
                           hjust = data$hjust, vjust = data$vjust,
                           rot = data$angle,
                           gp = grid::gpar(
                             col = alpha(data$colour, data$alpha),
                             fontsize = data$size * .pt,
                             fontfamily = data$family,
                             fontface = data$fontface,
                             lineheight = data$lineheight
                           ),
                           check.overlap = check_overlap
                         )
                       },
                       
                       draw_key = draw_key_text
)

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

dataForAnim %>%
  ggplot() +
  geom_col(aes(max(rank) - rank, height, fill = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8))) +
  geom_text(aes(max(rank) - rank, -0.03, label = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 1) +
  geom_numeric(aes(max(rank) - rank, height + 0.1, label = gdpPercap, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 0, parse = TRUE) +
  geom_image(aes(max(rank) - rank, height + 0.05), image = "https://www.r-project.org/logo/Rlogo.png") +
  coord_flip() +
  guides(fill = FALSE, alpha = FALSE) +
  labs(title='{closest_state}', x = NULL, y = NULL) +
  scale_y_continuous(limits = c(-0.4, 1.5)) +
  theme_void() +
  transition_states(year, transition_length = 200000, state_length = 2000, wrap = FALSE) +
  view_follow(fixed_x = c(15, 24), fixed_y = c(-0.4, 1.5))

[Andrzej]

Hi, this is amazing but how to add a clock to this chart with year below it, like in Post 1 ?

[raytong]

@Andrzej. For adding clock, rescale the height to make the coordination in equal scale. Draw the circle with geom_circle from geforce package. Pre-calculate the coordinate of the hand of the clock in the data. Draw the hand with geom_segment. Finally, adjust the aspect.ratio to make the circle orbit.

library(tidyverse)
library(ggimage)
library(gganimate)
library(gapminder)
library(ggforce)
library(transformr)
library(av)
theme_set(theme_classic())

geom_numeric <- function(mapping = NULL, data = NULL,
                         stat = "identity", position = "identity",
                         ...,
                         parse = FALSE,
                         nudge_x = 0,
                         nudge_y = 0,
                         check_overlap = FALSE,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE)
{
  if (!missing(nudge_x) || !missing(nudge_y)) {
    if (!missing(position)) {
      stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE)
    }
    
    position <- position_nudge(nudge_x, nudge_y)
  }
  
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomNumeric,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      parse = parse,
      check_overlap = check_overlap,
      na.rm = na.rm,
      ...
    )
  )
}

GeomNumeric <- ggproto("GeomNumeric", Geom,
                       required_aes = c("x", "y", "label"),
                       
                       default_aes = aes(
                         colour = "black", size = 3.88, angle = 0, hjust = 0.5,
                         vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2
                       ),
                       
                       draw_panel = function(data, panel_params, coord, parse = FALSE,
                                             na.rm = FALSE, check_overlap = FALSE) {
                         lab <- data$label
                         if (parse) {
                           lab <- scales::comma(as.numeric(lab), accuracy = 1)
                         }
                         
                         data <- coord$transform(data, panel_params)
                         if (is.character(data$vjust)) {
                           data$vjust <- compute_just(data$vjust, data$y)
                         }
                         if (is.character(data$hjust)) {
                           data$hjust <- compute_just(data$hjust, data$x)
                         }
                         
                         grid::textGrob(
                           lab,
                           data$x, data$y, default.units = "native",
                           hjust = data$hjust, vjust = data$vjust,
                           rot = data$angle,
                           gp = grid::gpar(
                             col = alpha(data$colour, data$alpha),
                             fontsize = data$size * .pt,
                             fontfamily = data$family,
                             fontface = data$fontface,
                             lineheight = data$lineheight
                           ),
                           check.overlap = check_overlap
                         )
                       },
                       
                       draw_key = draw_key_text
)

dataForAnim <- gapminder %>%
  filter(continent == "Americas") %>%
  group_by(year) %>%
  # The * 1 makes it possible to have non-integer ranks while sliding
  mutate(rank = min_rank(-gdpPercap) * 1) %>%
  mutate(height = gdpPercap / max(gdpPercap) * 25) %>%
  ungroup() %>%
  mutate(degree = (year - min(year)) / (max(year) - min(year)) * 360,
         clockx = 18 + 0.7 * cos(pi * (degree/180)),
         clocky = 20 + 0.7 * sin(pi * (degree/180)))

dataForAnim %>%
  ggplot() +
  geom_col(aes(max(rank) - rank, height, fill = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8))) +
  geom_text(aes(max(rank) - rank, -0.75, label = country, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 1) +
  geom_numeric(aes(max(rank) - rank, height + 2.5, label = gdpPercap, alpha = ifelse(max(rank) - rank < 15, 0, 0.8)), hjust = 0, parse = TRUE) +
  geom_image(aes(max(rank) - rank, height + 1.25), image = "https://www.r-project.org/logo/Rlogo.png") +
  geom_text(aes(x = 16, y = 20, label = as.character(year)), size = 5) +
  geom_circle(aes(x0 = 18, y0 = 20, r = 1)) +
  geom_segment(aes(x = 18, y = 20, xend = clockx, yend = clocky)) +
  coord_flip() +
  guides(fill = FALSE, alpha = FALSE) +
  scale_y_continuous(limits = c(-10, 30)) +
  theme_void() +
  theme(aspect.ratio = 0.25) +
  transition_states(year, transition_length = 200000, state_length = 2000, wrap = FALSE) +
  view_follow(fixed_x = c(15, 25), fixed_y = c(-10, 30))

[Andrzej]

Thank you @raytong, this is what I wanted.

Apologies for naive question but in the first 1 post this external (youtube) gif looks so "enriched", in R it is not so colourful (maybe a resolution is different) ?

regards,

Andrzej

[raytong]

@Andrzej. It can be done by adjust color tone and alpha. And make some modifications on the geom function. You can explore more on these fields.