As a continuation of my last post, I made-over another viz I saw on Twitter. This time, it was a chart from Eno Center for Transportation using Federal Highway Administration data. Unfortunately, I cannot find the original chart.
Setup
- I chose my fonts and colors to match the Eno branding.
- Then I included a tribble of data I copied and pasted from the FHWA PDF. While I could have read this in and munged it in R, I went with a quicker drop-in.
library(tidyverse)
library(lubridate)
library(showtext)
library(ggtext)
# Fonts
font_add_google(name = "Spartan", family = "spartan")
font_add_google(name = "Roboto", family = "roboto")
showtext_auto()
# Colors
bg_gray <- "#f4f4f4"
axis_line_gray <- "#B8B8B8"
highlight_1 <- "#1d3557"
highlight_2 <- "#e63946"
# FHWA Data
## data source
## data in BILLIONS
vmt_data <- tibble::tribble(
~category, ~year, ~JAN, ~FEB, ~MAR, ~APR, ~MAY, ~JUN, ~JUL, ~AUG, ~SEP, ~OCT, ~NOV, ~DEC,
"Rural Interstate", 2019L, 18.7, 16.8, 20.9, 22, 23.1, 23, 25.4, 24.2, 21.5, 22.4, 20.5, 21.7,
"Rural Other Arterial", 2019L, 27.6, 25.7, 31, 32.3, 33.6, 33.8, 36.7, 35.2, 32.9, 33.9, 30.3, 31.2,
"Other Rural", 2019L, 25.1, 22.8, 28, 30, 30.7, 30.5, 32.7, 31.4, 29.2, 30.3, 26.8, 27.5,
"Urban Interstate", 2019L, 43.9, 39.8, 48.1, 48.9, 50.3, 50.5, 49.9, 49.8, 47.9, 49.3, 47.1, 49.7,
"Urban Other Arterial", 2019L, 90.4, 83, 97.8, 100.6, 100.5, 97.4, 102.5, 99.9, 95.8, 101.8, 92.5, 98.3,
"Other Urban", 2019L, 42.5, 38.7, 45.7, 47.6, 47.8, 45.8, 48.4, 46.2, 44.5, 46.1, 43.3, 45.7,
"Rural Interstate", 2020L, 19.2, 17.4, 16.8, 12.2, 16.9, 19.5, 22.2, NA, NA, NA, NA, NA,
"Rural Other Arterial", 2020L, 28.3, 26.4, 25.8, 20.4, 26.4, 30.6, 33.5, NA, NA, NA, NA, NA,
"Other Rural", 2020L, 25.6, 23.3, 23.5, 20, 24.6, 27.9, 30.6, NA, NA, NA, NA, NA,
"Urban Interstate", 2020L, 44.9, 40.7, 37.8, 26.9, 35, 41.8, 42.5, NA, NA, NA, NA, NA,
"Urban Other Arterial", 2020L, 92, 84.6, 78.6, 59.5, 73.7, 83.8, 90.4, NA, NA, NA, NA, NA,
"Other Urban", 2020L, 43.6, 39.5, 37.6, 29.4, 36.1, 40.3, 43.2, NA, NA, NA, NA, NA
)
Reshape data
- Because the data is wide with each month as its own column, I reshaped it into long data for plotting.
- I also combined the categories into Rural and Urban to create two lines.
- Then, I specified the colors I wanted for the two categories.
#reshape from wide to tidy
vmt_reshaped <- vmt_data %>%
pivot_longer(cols = -c("category", "year"), names_to = "month_char") %>%
mutate(year_month = ymd(glue::glue("{year}-{month_char}-01"))) %>%
filter(!is.na(value)) %>%
#create a general category to summarize
mutate(general_category = if_else(str_detect(category, "Rural"), "Rural", "Urban")) %>%
#split out into two lines to compare year-to-year
group_by(year_month) %>%
summarize(value = sum(value)) %>%
mutate(month = month(year_month, label = TRUE),
year = as.character(year(year_month)),
chart_color = if_else(year == "2019", highlight_1, highlight_2))
Plotting
- For the plot, I kept the line chart and specified the color and groupings.
- I made the y-axis more specific and quick to read.
- I avoided using a legend and instead included the year colors in the subtitle.
- Lastly, I included a descriptive title of the key takeaway.
vmt_chart <- vmt_reshaped %>%
ggplot(aes(x = month, y = value, color = chart_color, group = year)) +
geom_line(size = 1) +
scale_color_identity() +
scale_y_continuous(limits = c(100, NA),
labels = scales::number_format(suffix = "B")) +
labs(title = "Traffic is stabilizing after COVID-related plunge",
subtitle = glue::glue("Monthly vehicle miles (urban and rural),
<b style='color:{highlight_1}'>2019</b> compared to
<b style='color:{highlight_2}'>2020</b>"),
caption = "Source: Federal Highway Administration, July 2020") +
theme_classic(base_size = 16) +
theme(
#align title left
plot.title.position = "plot",
#colors and fonts
text = element_text(family = "roboto"),
plot.background = element_rect(fill = bg_gray),
panel.background = element_rect(fill = bg_gray,
colour = bg_gray),
axis.line = element_line(color = axis_line_gray),
plot.title = element_text(family = "spartan", face = "bold", size = 17),
plot.subtitle = element_markdown(family = "spartan", size = 13),
axis.text.y = element_text(),
#no annoying stuff
axis.title = element_blank(),
legend.position = "none"
)
vmt_chart
This is still a relatively plain chart, and I probably could create a more complicated analysis with this data. But in my original tweet, I included a call to action:
A reminder that just because traffic is down doesn’t mean it’s down forever… We need to use this opp[ortunity] for permanent design changes to prioritize people over cars.
Export
Finally time to export to a Twitter-appropriate size.
# Export in Twitter Size --------------------------------------------------
png(filename = "vmt_chart.png",
width = 600,
height = 335)
vmt_chart
dev.off()
quartz_off_screen
2