Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
I woke up to Axios’ “1 Big Thing” ridgeline chart showing the crazy that was the 2019 news cycle:
and, I decided to reproduce it in {ggplot2}.
Getting The Data
First, I had to find the data. The Axios chart is interactive, so I assumed the visualization was built on-load. It was, but the data was embedded in a javascript file vs loaded as JSON via an XHR request:
which was easy enough to turn into JSON anyone can use.
library(ggalt)library(hrbrthemes) # hrbrmstr/hrbrthemeslibrary(tidyverse)jsonlite::fromJSON("https://rud.is/dl/2019-axios-news.json") %>% as_tibble() -> xdfxdf## # A tibble: 31 x 3## name avg data ## ## 1 Gov't shutdown 20.5 ## 2 Mexico-U.S. border 22.8 ## 3 Green New Deal 11.3 ## 4 Blackface 9.61 ## 5 N. Korea-Hanoi Summit 11.2 ## 6 Boeing 737 Max 4.79 ## 7 Brexit 28.5 ## 8 Israel 42.1 ## 9 SpaceX 24.1 ## 10 Game of Thrones 16.8 ## # … with 21 more rows
This is pretty tidy already, but we’ll need to expand the data
column and give each week an index:
unnest(xdf, data) %>% group_by(name) %>% mutate(idx = 1:n()) %>% ungroup() %>% mutate(name = fct_inorder(name)) -> xdf # making a factor foe strip/panel ordering xdf## # A tibble: 1,581 x 4## name avg data idx## ## 1 Gov't shutdown 20.5 69 1## 2 Gov't shutdown 20.5 100 2## 3 Gov't shutdown 20.5 96 3## 4 Gov't shutdown 20.5 100 4## 5 Gov't shutdown 20.5 19 5## 6 Gov't shutdown 20.5 9 6## 7 Gov't shutdown 20.5 17 7## 8 Gov't shutdown 20.5 3 8## 9 Gov't shutdown 20.5 2 9## 10 Gov't shutdown 20.5 1 10## # … with 1,571 more rows
We’ll take this opportunity to find the first week of each month (via rle()
) so we can have decent axis labels:
# get index placement for each month axis labelsprintf("2019-%02s-1", 1:51) %>% as.Date(format = "%Y-%W-%w") %>% format("%b") %>% rle() -> monsmons## Run Length Encoding## lengths: int [1:12] 4 4 4 5 4 4 5 4 5 4 ...## values : chr [1:12] "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" ...month_idx <- cumsum(mons$lengths)-3month_idx## [1] 1 5 9 14 18 22 27 31 36 40 44 48
We’ve got all we need to make a {ggplot2} version of the chart. Here’s the plan:
- use
geom_area()
and map colour and fill toavg
(like Axios did), using an medium alpha value so we can still see below the overlapped areas - also use an
xspline()
stat withgeom_area()
so we get smooth lines vs pointy ones - use
geom_hline()
vs an axis line so we can map a colour aesthetic toavg
as well - make a custom x-axis scale so we can place the labels we just made
- expand the y-axis upper limit to avoid cutting off any part of the geoms
- use the
inferno
viridis palette, but not the extremes of it - make facets/panels on the
name
, positioning the labels on the left - finally, tweak strip positioning so we get overlapped charts
ggplot(xdf, aes(idx, data)) + geom_area(alpha = 1/2, stat = "xspline", aes(fill = avg, colour = avg)) + geom_hline( data = distinct(xdf, name, avg), aes(yintercept = 0, colour = avg), size = 0.5 ) + scale_x_continuous( expand = c(0,0.125), limits = c(1, 51), breaks = month_idx, labels = month.abb ) + scale_y_continuous(expand = c(0,0), limits = c(0, 105)) + scale_colour_viridis_c(option = "inferno", direction = -1, begin = 0.1, end = 0.9) + scale_fill_viridis_c(option = "inferno", direction = -1, begin = 0.1, end = 0.9) + facet_wrap(~name, ncol = 1, strip.position = "left", dir = "h") + labs( x = NULL, y = NULL, fill = NULL, colour = NULL, title = "1 big thing: The insane news cycles of 2019", subtitle = "Height is search interest in a given topic, indexed to 100.\nColor is average search interest between Dec. 30, 2018–Dec. 20, 2019", caption = "Source: Axios \nData: Google News Lab. Orig. Chart: Danielle Alberti/Axios" ) + theme_ipsum_es(grid="X", axis = "") + theme(strip.text.y = element_text(angle = 180, hjust = 1, vjust = 0)) + theme(panel.spacing.y = unit(-0.5, "lines")) + theme(axis.text.y = element_blank()) + theme(legend.position = "none")
To produce this finished product:
FIN
The chart could be tweaked a bit more to get even closer to the Axios finished product.
Intrepid readers can also try to use {plotly} to make an interactive version.
Somehow, I get the feeling 2020 will have an even more frenetic news cycle.
var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' }; (function(d, t) {var s = d.createElement(t); s.type = 'text/javascript'; s.async = true;s.src = '//cdn.viglink.com/api/vglnk.js';var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r); }(document, 'script'));R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.