My eye was caught by this tweet by Robin Wigglesworth of the Financial Times with an Alan Smith animation of the US Treasury yield curve from 2005 to 2009. It’s a nice graphic and it made me wonder what it would look like over a longer period.
The “yield curve” is the name given to the graphic showing the different annual rates paid on investors who in effect lend money to the US Treasury. In normal circumstances, investors who are prepared to make the loan on a long term basis demand higher effective interest rates as compensation for risk associated with inflation and future interest rates. When the situation goes in the other direction, and higher effective returns come from shorter term investments, it’s commonly seen as a sign of a coming recession. This isn’t because the “inverted yield curve” causes the recession, but because (amongst other things) it reflects investors’ fears that interest rates are about to be cut (in response to lower economic growth), hence best to lock in the return you can get now.
Animation options
Anyway, here is my version of the animation, now with 29 years of daily data, streaming from You Tube (because it was too large to embed directly in my web page):
Alternatively, here’s a streamlined social-media-friendly version (as a GIF) that has monthly averages and scoots through a bit quicker.
I’m not sure these are great graphics. For one thing, with three frames for every day with data reported, the daily version is over 20,000 frames long and even at 25 frames per second that’s a pretty tedious thing to watch - 14.5 minutes in fact. More generally, it suffers from the common problems of animated statistical graphics:
- you have to be looking at just the right time to see the interesting things - like the yield inversion and other volatility in that 2006 to 2008 period
- some changes over time are actually less obvious to the viewer than if they could be presented on a single page.
In the original FT article, there’s a more focused animation by Smith, this one showing just the last 15 months, emphasising the yield inverstion at the end of that period. It’s quite effective in telling a very pointed story, rather than trying to show a long history in a single animation.
Static alternatives
Animations aren’t always the best. In fact, it’s surely significant that I loathe video tutorials because I can’t flick my eye directly to the part I want but have to sit through the whole thing - even at high speed this is frustrating. Animations can have a similar problem.
For showing the longer history at a glance, consider this alternative presentation, still related to the animation’s visual structure. This has all 8,000 or so yield curves from those 29 years on a single static chart, each one drawn with 10% opacity to avoid colouring the page solid.
What I like about this version is that because it’s all there at once, you can make the comparisons across a broader period of time than is possible with the animation. You can see:
- The secular decrease in rates over this time period
- The period around 2005 when there were no 30 year rates for some reason
- The different yield inversions in context - showing as upwards swooshes in blue, green and yellow (for different periods) at the left of the graph
Plus it’s very pretty.
Finally, how about a much more traditional time series line chart. I actually find this the easiest to interpret of them all.
- The secular decrease is obvious again.
- The carefully chosen colours let you compare the different terms quite easily.
- This is the most dramatic depictiton of the way the shorter term yields hit the floor after 2008.
- Easiest chart of them all to interpret because of the familiar convention of the horizontal axis meaning time
- Still very pretty.
Reflections
So what do I think?
Sometimes static graphs are beter than animations. Sometimes an old fashioned time series plot is better than less standard innovations. To make an animation tell a good story you often need more polishing, annotation and framing, not less.
More information on yield curves is easy to find on the Internet, and the piece in the Financial Times that Wigglesworth was referring to is worth a read. Here’s one of their very professional graphics:
One of the things that makes a difference to this, and to the animations in the same story, is the careful use of annotations to tell a story. That’s definitely what it takes to get a graphic to the next level, but it’s not something I’ve got time for right now.
Here’s the code for this (apart from that last one from the FT) - all pretty straightforward. Grabbing the data is easy with Wickham’s rvest R package, and animations are so much easier than a few years ago thanks to Thomas Pedersen’s gganimate. And let’s not forget the Viridis colours, originally developed for Python by Nathaniel Smith and Stefan van der Walt, and ported into an R package by Simon Garnier. In these graphics I use three variants of the Viridis colour schemes to represent different variables - the difference between long and short term yields at any one point in time, year, and the term of the yield. In each case, the variable I am trying to show is fundamentally ordered, and Viridis is at its best in showing that ordered nature in its colour.
#------------------------------load up functionality and import data-------------
library(rvest)
library(tidyverse)
library(scales)
library(gganimate)
library(svglite)
library(frs)
library(lubridate)
the_caption <- "Data from https://www.treasury.gov/, analysis by freerangestats.info"
# we read in the data a year at a time because although there is a page with all 29 years of data,
# it was too difficult to read in all at once ie it crashed my humble laptop. So we define a function
# to get one year's data:
read_a_year <- function(y){
url_stub <- "https://www.treasury.gov/resource-center/data-chart-center/interest-rates/pages/TextView.aspx?data=yieldYear&year=XXXX"
url <- gsub("XXXX", y, url_stub)
yield_page <- read_html(url)
yield_data <- as_tibble(html_table(yield_page, fill = TRUE)[[2]] )
return(yield_data)
}
# bring in the data one year at a time.
yields_l <- lapply(1990:2019, read_a_year)
# clean and reshape the data with some handy variables for charting
periods <- tibble(
period = paste(c(1,2,3,6,1,2,3,5,7,10,20,30), rep(c("mo", "yr"), c(4,8))),
period_n = c(30, 60, 90, 180, 365.25 * c(1,2,3,5,7,10,20,30))
)
yields <- do.call("rbind", yields_l) %>%
mutate(Date = as.Date(Date, format = c("%m/%d/%y"))) %>%
gather(period, value, -Date) %>%
mutate(value = suppressWarnings(as.numeric(value))) %>%
left_join(periods, by = "period") %>%
group_by(Date) %>%
mutate(ratio_5_30 = value[period == "30 yr"] / value[period == "5 yr"],
yield_av = mean(value, na.rm = TRUE, tr = 0.2),
yield_30yr = value[period == "30 yr"],
yield_3mo = value[period == "3 mo"],
diff303 = yield_30yr - yield_3mo) %>%
ungroup() %>%
filter(!is.na(value))
#----------------All dates in one chart---------------------
col_br <- tibble(
lab = c(1990, 2000, 2010),
date = as.Date(paste0(c(1990, 2000, 2010), "-03-01"))
) %>%
mutate(date_n = as.numeric(date))
p2 <- yields %>%
# filter(Date < as.Date("1990-01-31")) %>%
ggplot(aes(x = period_n, y = value, group = Date, colour = as.numeric(Date))) +
geom_path(alpha = 0.1) +
scale_colour_viridis_c("",
breaks = pull(col_br, date_n),
labels = pull(col_br, lab)) +
scale_y_continuous("Treasury yield curve rate") +
scale_x_continuous("", breaks = periods[c(10:12), ]$period_n,
labels = periods[c(10:12), ]$period) +
labs(caption = the_caption)
print(p2)
#--------------animated MP4 version----------
d <- yields #%>%
filter(Date < as.Date("1991-02-28"))
a <- d %>%
ggplot(aes(x = period_n, y = value)) +
geom_segment(data = distinct(d, Date, yield_3mo, yield_30yr),
x = 90, xend = 10958, aes(y = yield_3mo, yend = yield_30yr),
colour = "grey50") +
geom_line(size = 1.5, aes(colour = diff303)) +
scale_y_continuous("Treasury yield curve rate") +
scale_x_continuous("", breaks = periods[c(10:12), ]$period_n,
labels = periods[c(10:12), ]$period) +
scale_colour_viridis_c("Premium for long term lending:\n30 year yield minus 3 month yield",
option= "A", direction = -1) +
labs(title = "US Treasury Yield Curve Rates, 1990 to 2019",
subtitle = 'Date: {frame_time}',
caption = the_caption) +
transition_time(Date)
# Save the frames in the file system and then manually knit into an animation, because
# there are so many and so large that I like to keep control of the two steps:
dir.create("tmp")
res <- 150
animate(a, nframes = length(unique(d$Date)) * 3, dev = "png", fps = 30,
type = "cairo-png", antialias = "subpixel",
width = 6 * res, height = 4.3 * res, res = res,
renderer = file_renderer(dir = "tmp", overwrite = TRUE))
od <- setwd("tmp")
system("ffmpeg -i gganim_plot%04d.png -pix_fmt yuv420p -s 900x646 -c:v libx264 -r 30 movie.mp4")
setwd(od)
#----------------traditional time series version-----------
p3 <- yields %>%
mutate(period = fct_reorder(period, period_n)) %>%
ggplot(aes(x = Date, y = value, colour = period)) +
geom_line() +
scale_colour_viridis_d(option = "C") +
labs(x = "", colour = "Term", y = "Treasury yield curve rate",
caption = the_caption) +
ggtitle("US Treasury Yield Curve Rates, 1990 to 2019")
print(p3)
#-----------------Gif version for Twitter------------
# shorter version with just one main observation per month
d2 <- yields %>%
mutate(mon = month(Date),
yr = year(Date)) %>%
group_by(mon, yr, period_n) %>%
summarise(value = mean(value),
yield_3mo = mean(yield_3mo),
yield_30yr = mean(yield_30yr),
diff303 = mean(diff303)) %>%
ungroup() %>%
mutate(Date = as.Date(paste(yr, mon, 15, sep = "-"), format = "%Y-%m-%d"))
a2 <- d2 %>%
ggplot(aes(x = period_n, y = value)) +
geom_segment(data = distinct(d, Date, yield_3mo, yield_30yr),
x = 90, xend = 10958, aes(y = yield_3mo, yend = yield_30yr),
colour = "grey50") +
geom_line(size = 1.5, aes(colour = diff303)) +
scale_y_continuous("Treasury yield curve rate") +
scale_x_continuous("", breaks = periods[c(10:12), ]$period_n,
labels = periods[c(10:12), ]$period) +
scale_colour_viridis_c("Premium for long term lending:\n30 year yield minus 3 month yield",
option= "A", direction = -1) +
labs(title = "US Treasury Yield Curve Rates, 1990 to 2019",
subtitle = 'Date: {frame_time}',
caption = the_caption) +
transition_time(Date)
res <- 150
animate(a, nframes = length(unique(d2$Date)) * 6, dev = "png", fps = 15,
type = "cairo-png", antialias = "subpixel",
width = 6 * res, height = 4.3 * res, res = res)
anim_save("0151-yield-anim150.gif")thankr::shoulders() %>%
mutate(maintainer = str_squish(gsub("<.+>", "", maintainer)),
maintainer = ifelse(maintainer == "R-core", "R Core Team", maintainer)) %>%
group_by(maintainer) %>%
summarise(`Number packages` = sum(no_packages),
packages = paste(packages, collapse = ", ")) %>%
arrange(desc(`Number packages`)) %>%
knitr::kable() %>%
clipr::write_clip()| maintainer | Number packages | packages |
|---|---|---|
| Hadley Wickham | 15 | assertthat, dplyr, forcats, ggplot2, gtable, haven, httr, lazyeval, modelr, plyr, rvest, scales, stringr, tidyr, tidyverse |
| R Core Team | 11 | base, compiler, datasets, graphics, grDevices, grid, methods, stats, tools, utils, nlme |
| Gábor Csárdi | 4 | cli, crayon, pkgconfig, progress |
| Kirill Müller | 4 | DBI, hms, pillar, tibble |
| Lionel Henry | 4 | purrr, rlang, svglite, tidyselect |
| Winston Chang | 4 | extrafont, extrafontdb, R6, Rttf2pt1 |
| Yihui Xie | 4 | evaluate, knitr, rmarkdown, xfun |
| Jim Hester | 3 | glue, withr, readr |
| Thomas Lin Pedersen | 3 | farver, gganimate, tweenr |
| Yixuan Qiu | 3 | showtext, showtextdb, sysfonts |
| Dirk Eddelbuettel | 2 | digest, Rcpp |
| Jennifer Bryan | 2 | cellranger, readxl |
| Simon Urbanek | 2 | audio, Cairo |
| Achim Zeileis | 1 | colorspace |
| Alex Hayes | 1 | broom |
| Charlotte Wickham | 1 | munsell |
| David Gohel | 1 | gdtools |
| Deepayan Sarkar | 1 | lattice |
| Gabor Csardi | 1 | prettyunits |
| James Hester | 1 | xml2 |
| Jeremy Stephens | 1 | yaml |
| Jeroen Ooms | 1 | jsonlite |
| Joe Cheng | 1 | htmltools |
| Kamil Slowikowski | 1 | ggrepel |
| Kevin Ushey | 1 | rstudioapi |
| Marek Gagolewski | 1 | stringi |
| Matthew Lincoln | 1 | clipr |
| Max Kuhn | 1 | generics |
| Michel Lang | 1 | backports |
| Peter Ellis | 1 | frs |
| Rasmus Bååth | 1 | beepr |
| Stefan Milton Bache | 1 | magrittr |
| Vitalie Spinu | 1 | lubridate |