Let the snail crawl: Animated density curves

Previously, I’ve plotted a ridgeline based on a variable’s density through time. It might look nice but it’s quite obvious that time can be visualized in a more fitting way - by time itself, in an animated plot that is. So, let’s fire up the {gganimate} package again.

My goal is to show a moving kernel density curve as it moves through time, based on a moving window of 30 days sliding from the past to the present. It would also be nice to see earlier stages as shadows in the animated plot. But first, let’s get the data again:

temp <- tempfile()
download.file("https://www.owid.de/plus/cowidplus2020/data/unigram-results.csv.zip",
              temp)
con <- unz(temp, "unigram-results.csv")
res <- read.table(con, sep = ",", header = T)
unlink(temp)
scroll_box(kable_styling(kable(res)),
           width = "100%", height = "400px")

We will only need the columns date and top100share, which is a simple measure of lexical diversity. It’s the total frequency of the 100 most frequent types (different words) in the corpus on that day divided by the total frequency (column tok). So, on January 1^st, 2020, approx. 43% of all tokens (running words) belonged to the 100 most frequent word forms.

The frequency curve should then show us the distribution of top100share in the 30 days that fall into the window at any given point in time. So, we cannot simply use date as the “transition variable” for {gganimate} because we need 30 data points for each curve and not only one (which would not work anyhow). My solution might be a bit expensive, but it works:

• Create an empty dataframe slw.df.
• For each day di in the dataset, select the 30 day window starting with day di and save it in ret.
• Assign di to the column begin in ret.
• Write ret into the dataframe slw.df.

slw.df, the dataframe holding the sliding window data, is going to be much longer than our source dataframe, but we can now use the column begin as the “transition variable” because each animation step will get all values for the 30 days starting with the date in begin. Let’s do it:

library(data.table)
max.rows <- nrow(res) - 30
slw.df <- lapply(1:nrow(res), FUN = function (di) {
  if (di < max.rows) {
    ret <- res[di:(di + 30),]
    ret$begin <- as.Date(paste(min(ret$date)))
    ret
  }
})
slw.df <- rbindlist(slw.df)
nrow(slw.df) / nrow(res)

## [1] 26.46698

So, our plotting dataframe slw.df is approx. 26 times longer than our original dataset res. It might not be very parsimonious but it does the trick. If you have an idea how to do this more efficiently, let me know.

Now for creating the plot:

• By setting the fill aesthetic to factor(begin), the density curve changes its color while progressing through time. We have to switch of the legend, though (this is done by guides(fill = F).
• The curve will be transparently filled.
• We have a transition through time, based on the variable begin.
• The shadows of previous time steps are even more transparent and the color of the line (not the fill) changes to grey.

library(ggplot2)
library(gganimate)
gg <- ggplot(slw.df, aes(x = top100share, fill = factor(begin))) +
  geom_density(alpha = .5) +
  transition_time(begin) +
  ease_aes('cubic-in-out') +
  labs(title='30 days since {frame_time}', x = "", y = "Kernel density top100 frequency share") +
  shadow_mark(alpha = alpha/4, color = alpha("grey", .25)) +
  guides(fill = F) +
  theme(title = element_text(size = 18),
        axis.text.x = element_text(size = 14),
        axis.text.y = element_text(size = 14))

All we have to do now is animating the plot. For a preview, I like to use low parameters for frames per second fps and duration because rendering takes several minutes for higher fps and duration settings. If you want to see a higher-resolution rendering, you can check out my tweet related to this blog post. I’ve used fps = 25 and duration = 20 for the video you’re seeing there.

animate(gg, fps = 5, duration = 10, width = 500, height = 350, rewind = F)

But also on a much lower temporal resolution, we’re seeing that the density curve is crawling to the right during March and April and crawls back afterwards. Basically, this animation transports the same information as the ridgeline plot which was divided by weeks. However, it encodes time by animation stages and the moving window adds some smoothness to the process. Also, it incorporates more data points into each density curve.