Last active
January 31, 2024 11:36
-
-
Save carlislerainey/b87600c3314e1829a10b43d0c4617762 to your computer and use it in GitHub Desktop.
Code for animating the figure on data sharing in political science
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment