· 6 years ago · Nov 24, 2019, 01:40 AM
1### Overlay an animated .gif on a R plot of FRED GDP data - <Mathew.Binkley@Vanderbilt.edu>
2
3### We need the following packages for this example.
4packages <- c("lubridate", "fredr", "shape", "forecast", "ggplot2",
5 "ggthemes", "zoo", "tidyverse", "tis", "showtext", "tsibble",
6 "tsibbledata", "feasts", "fable", "dplyr", "tsbox",
7 "magick", "here", "magrittr")
8
9### Install packages if needed, then load them quietly
10new.packages <- packages[!(packages %in% installed.packages()[,"Package"])]
11if(length(new.packages)) install.packages(new.packages, quiet=TRUE)
12invisible(lapply(packages, "library", character.only=TRUE))
13
14### Edit "FRED_API_key.R" and add your personal API key to access the FRED database.
15###You may request an API key at: https://research.stlouisfed.org/useraccount/apikeys
16fredr_set_key("INSERT_YOUR_FRED_API_KEY_HERE")
17
18### Load data from FRED.
19Series = "GDP"
20data <- as_tsibble(fredr(series_id = Series, frequency = "q"))
21
22Date <- data %>% pull('date')
23Date <- decimal_date(Date)
24Values <- data %>% pull('value')
25
26### Now convert the dataframe into a time series
27Values.ts <- ts(Values, frequency=12)
28Values.decomposed <- as_tibble(mstl(Values.ts))
29
30#Seasonal <- Values.decomposed %>% pull('Seasonal12')
31Trend <- Values.decomposed %>% pull('Trend')
32#Remainder <- Values.decomposed %>% pull('Remainder')
33
34### Define the .png file for the graph
35png_Filename = "Confused_Travolta_GDP_Blank.png"
36png_Width = 800
37png_Height = round((9/16)*png_Width)
38png(filename = png_Filename, width = png_Width, height = png_Height, type = c("cairo"))
39
40### Make the plot
41plot(Date, Trend + Remainder, type="l",
42 col="black",
43 lty=3,
44 main="Incredible Economic Growth\nThanks to Trump!!!",
45 xlab="Year",
46 ylab="Billions of Dollars",
47 xlim=c(2010, 2019.5), ylim=c(14000, 22000))
48
49### Add a line on Trump's election day
50abline(v=2017.05, col="blue", lty=2)
51
52### Some labels and arrows...
53text(2016.5, 15500, "Obama", col="darkblue")
54Arrows(2017.05, 15000, 2016.05, 15000, col="darkblue", arr.type="triangle")
55
56text(2017.5, 15500, "Trump", col="darkred")
57Arrows(2017.05, 15000, 2018.05, 15000, col="darkred", arr.type="triangle")
58
59### Close the graph and save
60dev.off()
61
62### Re-open the graph we just created and use it as the background of our animation
63plot <- image_read(png_Filename)
64background <- image_background(image_scale(plot, "800"), "white", flatten = TRUE)
65
66### Let's add a "Confused Travolta" on the graph...
67anim <- image_read("https://i.imgur.com/e1IneGq.jpg") %>%
68 image_scale("150")
69
70### Combine and flatten frames
71frames <- image_composite(background, anim, offset = "+150+70")
72
73### Turn frames into animation
74### Note: The actual rendering can take minutes sometimes. Just be patient.
75animation <- image_animate(frames, fps=25)
76print(animation)
77
78### Save gif
79image_write(animation, "animated_chart_travolta.gif")