Code for animating the figure on data sharing in political science

animated-sharing.R

# load packages
library(tidyverse)
library(ggrepel)
library(gganimate)

# set ggplot options
theme_set(theme_bw(base_family = "Gill Sans")) 
update_geom_defaults("label", list(family = theme_get()$text$family))
update_geom_defaults("text", list(family = theme_get()$text$family))

# load data
pred <- data.table::data.table(
  year = c(1995,1996,1997,1998,1999,2000,2001,
           2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,
           2013,2014,2015,2016,2017,2018,2019,2020,2021,2022),
  pct = c(0.0041,0.0048,0.0056,0.0066,0.0077,
          0.0091,0.0108,0.013,0.0159,0.019,0.0218,0.0254,0.0295,
          0.0347,0.0424,0.0525,0.0644,0.0821,0.1002,0.1213,0.1397,
          0.1551,0.1719,0.2027,0.2247,0.2493,0.2731,0.3114),
  lwr90 = c(0.0104,0.0117,0.0132,0.015,0.0171,
            0.0192,0.0221,0.0253,0.0296,0.0338,0.0385,0.0435,0.0497,
            0.0573,0.067,0.0806,0.0973,0.1171,0.1389,0.1613,0.1808,
            0.196,0.2176,0.2498,0.2712,0.2978,0.3212,0.3528),
  upr90 = c(0,0,1e-04,3e-04,5e-04,8e-04,0.0014,
            0.0024,0.0042,0.0061,0.0078,0.0093,0.0119,0.0149,0.0193,
            0.0259,0.0344,0.048,0.063,0.0822,0.1006,0.1124,0.1272,
            0.1564,0.1775,0.2019,0.2232,0.268),
  event = c("Publication of King's (1995) \n \"Replication, Replication\"",NA,NA,NA,NA,NA,NA,NA,
            "The \"Symposium on Replication\" in \n International Studies Perspectives",
            NA,NA,"Dataverse Created",NA,NA,NA,NA,NA,
            "APSA Ethics Revised",NA,"DA-RT Symposium Published in PS",NA,NA,NA,NA,
            NA,NA,NA,"As of 2022"),
  pct_label = c("0%",NA,NA,NA,NA,NA,NA,NA,"2%",NA,
                NA,"3%",NA,NA,NA,NA,NA,"8%",NA,"12%",NA,NA,NA,NA,
                NA,NA,NA,"31%")
)

# quick look because the above is hard to read
glimpse(pred)

# the trick is to make a separate data frame for each frame of the GIF
plot_years <- 1995:2022
to_bind <- list()
for (i in 1:length(plot_years)) {
  to_bind[[i]] <- filter(pred, year <= plot_years[i]) |>
    # label each data frame with 'plot_year'
    mutate(plot_year = plot_years[i])
}

# now bind these many data frames together
anim_data <- bind_rows(to_bind) %>%
  # and keep only the most recent event (to prevent overplotting)
  group_by(plot_year) %>%
  mutate(event = case_when(year >= max(year[!is.na(event)]) ~ event, 
                           TRUE ~  NA)) 

# a baseline plot
x_breaks <- c(1995, 2003, 2006, 2012, 2014, 2022)
gg <- ggplot(anim_data, aes(x = year, y = pct, ymin = lwr90, ymax = upr90)) + 
  geom_label_repel(aes(x = year, label = event), nudge_y = .15, size = 2.5,
                   segment.color ="grey40", direction = "y", segment.size = .3, 
                   family = "Gill Sans") + 
  geom_ribbon(alpha = 0.1) + 
  geom_line() + 
  scale_y_continuous(labels = scales::percent) + 
  scale_x_continuous(breaks = x_breaks, 
                     minor_breaks = NULL) +
  labs(x = "Year",
       y = "Percent with Available Reproduction Archives") + 
  geom_label(aes(x = year, y = pct, label = pct_label))


# animate the plot with gganimate
gg_animated <- gg + 
  # one transition per 'plot_year' data frame created above
  transition_manual(plot_year) +
  labs(title = 'The Evolution of Data-Sharing in Political Science')

# create the animation
animated_plot <- animate(gg_animated, 
                         nframes = 28, 
                         fps = 100/80, 
                         height = 4, 
                         end_pause = 3, 
                         width = 6, 
                         units = "in", 
                         res = 150)

# render in view
animated_plot

# save the animation to a file
anim_save("animated_plot.gif", animation = animated_plot)