How to animate moving filled sections of a geom_bar/geom_col with gganimate?

Question

I have two states of data in a common data frame, filtered by the Group variable, the first level called Original which looks like:

df |> 
  filter(Group == "Original") |> 
  ggplot(aes(original_rank, count)) +
  geom_bar(stat = "identity", aes(fill = transformed_rank)) +
  scale_fill_manual(values = RColorBrewer::brewer.pal(10, "RdYlGn"),
                    name = "Original Rank",
                    guide = guide_legend(byrow = TRUE))

Which is basically some unequal count data across ten ranks.

The second plot uses these original counts which I normalised to make them equal sized, and looks like:

df |> 
  filter(Group == "Transformed Internal") |> 
  ggplot(aes(original_rank, count)) +
  geom_bar(stat = "identity", aes(fill = transformed_rank)) +
  scale_fill_manual(values = RColorBrewer::brewer.pal(10, "RdYlGn"),
                    name = "Original Rank",
                    guide = guide_legend(byrow = TRUE))

So in the dataset, if you grouped the data frame by the Group variable and summed the number in count, it would be the same across two groups.

What I would like to do in gganimate, is to show how the original data is gradually transformed into the normalised data in a seamless transition, however my attempts haven't produced anything successful.

With geom_bar, I have created something like:

df |> 
  ggplot(aes(original_rank, count)) +
  geom_bar(stat = "identity", aes(fill = transformed_rank)) +
  scale_fill_manual(values = RColorBrewer::brewer.pal(10, "RdYlGn"),
                    name = "Original Rank",
                    guide = guide_legend(byrow = TRUE)) +
  labs(title = "{closest_state}") +
  transition_states(Group)

But it doesn't seem like the ranks move across the different ranks. Rank 1 seems to move okay but it's the only rank which fully stays inside its own rank in the transformed data.

With geom_tile (taking some inspiration from here):

df |> 
  ggplot(aes(original_rank, count, fill = transformed_rank)) +
  geom_tile(aes(y = count/2, height = count, width = 0.9)) +
  scale_fill_manual(values = RColorBrewer::brewer.pal(10, "RdYlGn"),
                    name = "IMD 2019 Decile",
                    guide = guide_legend(byrow = TRUE)) +
  labs(title = "{closest_state}") +
  transition_states(Group)

Again it doesn't really transform, and the second state doesn't have properly measured bars, which I think has to do with the y aes being transformed by dividing by 2 and the bars being filled instead of being whole, but I don't know how to fix this.

Sample data:

df <- structure(list(original_rank = structure(c(1L, 2L, 3L, 4L, 4L, 
5L, 5L, 6L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L, 9L, 10L, 10L, 1L, 
1L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 5L, 5L, 6L, 6L, 7L, 7L, 8L, 9L, 
9L, 10L), levels = c("1", "2", "3", "4", "5", "6", "7", "8", 
"9", "10"), class = "factor"), transformed_rank = structure(c(1L, 
2L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L, 9L, 
10L, 10L, 1L, 2L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 6L, 7L, 7L, 8L, 
8L, 9L, 9L, 9L, 10L, 10L), levels = c("1", "2", "3", "4", "5", 
"6", "7", "8", "9", "10"), class = "factor"), count = c(179L, 
2562L, 5886L, 1468L, 9084L, 1091L, 8698L, 1463L, 10170L, 5367L, 
4699L, 6707L, 3381L, 6510L, 3642L, 10054L, 1663L, 8398L, 10165L, 
179L, 2562L, 5886L, 1468L, 9084L, 1091L, 8698L, 1463L, 10170L, 
5367L, 4699L, 6707L, 3381L, 6510L, 3642L, 10054L, 1663L, 8398L, 
10165L), Group = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), levels = c("Original", 
"Transformed Internal"), class = "factor")), row.names = c(NA, 
-38L), class = c("tbl_df", "tbl", "data. Frame"))

Answer 1

If you are essentially just looking for your first plot to change into the second plot, you could do this by having all combinations of original and transformed ranks, with the non-present combinations having a count of 0, then simply do a time transition between the two states. This requires a bit of data manipulation:

library(tidyverse)
library(gganimate)

df2 <- df |>
  filter(Group == "Original") %>%
  complete(expand(., original_rank, transformed_rank), 
           fill = list(count = 0, Group = 'Original')) |>
  bind_rows(df |>
              filter(Group == "Transformed Internal") %>%
              complete(expand(., original_rank, transformed_rank), 
                    fill = list(count = 0, Group = "Transformed Internal"))) |>
  mutate(time = as.numeric(Group)) %>%
  arrange(time, original_rank, transformed_rank) %>%
  group_by(original_rank, transformed_rank, time) %>%
  summarize(count = sum(count)) %>%
  reframe(count = approx(time, count, xout = seq(1, 2, 0.01))$y,
          time = seq(0, 1, length = 101))

Then you can create the animation quite easily as follows:

p <- ggplot(df2, aes(original_rank, count)) +
  geom_bar(stat = "identity", aes(fill = transformed_rank),
           position = position_stack()) +
  scale_fill_manual(values = RColorBrewer::brewer.pal(10, "RdYlGn"),
                    name = "Original Rank",
                    guide = guide_legend(byrow = TRUE)) +
  transition_time(time = time)

animate(p, nframes = 150, fps = 25, start_pause = 0, end_pause = 25,
        renderer = magick_renderer())