Exploring the volatility of the S&P500 under Trump using the quantmod and tidyverse R packages (CC357)
Pat uses the quantmod and tidyverse packages to recreate a plot showing the changes in the S&P500 over the initial months of the Trump presidency. The plot generated functions from the tidyverse. To pull this off he uses the quantmod, dplyr, ggplot2, showtext, and ggtext packages. The functions he uses from these packages include aes, as.Date, as_tibble, coord_cartesian, drop_na, element_blank, element_markdown, element_text, filter, font_add_google, geom_hline, geom_line, geom_point, geom_rect, geom_text, getSymbols, ggplot, ggsave, isoweek, label_number, labs, lag, library, map_dbl, margin, max, min, month, mutate, nest, parse_date, pull, scale_fill_manual, scale_x_date, scale_y_continuous, select, seq, showtext_auto, showtext_opts, slice_max, summarize, theme, today, unique, unnest, and year. You can find the code he developed in this episode at https://www.riffomonas.org/code_club/2025-05-02-sandp500_weekly. The newsletter describing this visualization at a 30,000 ft view can be found at https://shop.riffomonas.org/posts/two-ways-to-plot-a-dumpster-fire. You can find the original article at https://www.nytimes.com/live/2025/04/04/business/trump-tariffs-stocks-economy?smid=url-share#investors-recoil-from-trumps-pledge-to-remake-the-global-economy. If you have a figure that you would like to see me discuss in a future newsletter and episode of Code Club, email me at pat@riffomonas.org!
Code
library(tidyverse)
library(showtext)
library(quantmod)
library(ggtext)
font_add_google("Libre Franklin", "franklin")
font_add_google("Domine", "domine")
showtext_opts(dpi = 300)
showtext_auto()
beginning <- as.Date("2025-01-01")
ending <- today() #as.Date("2025-04-04")
sandp <- getSymbols("^GSPC", auto.assign = FALSE) %>%
as_tibble(rownames = "date") %>%
select(date, close = GSPC.Close) %>%
mutate(date = parse_date(date),
week = isoweek(date),
year = year(date)) %>%
filter((date >= beginning - 7 & date <= ending) &
((year == 2024 & week == 52) | year == 2025)) %>%
nest(weekly = -c(week, year)) %>%
mutate(
weekly_close = map_dbl(weekly,
~slice_max(.x, order_by = date) %>% pull(close)),
prev_weekly_close = lag(weekly_close),
weekly_loss = weekly_close < prev_weekly_close) %>%
drop_na(prev_weekly_close) %>%
unnest(weekly)
rectangles <- sandp %>%
summarize(first = min(date),
last = max(date),
weekly_loss = unique(weekly_loss), .by = c(week, year)) %>%
select(first, last, weekly_loss)
month_label <- sandp %>%
filter(date %in% c("2025-01-06", "2025-02-03", "2025-03-03", "2025-04-14")) %>%
mutate(month = month(date, label = TRUE)) %>%
select(date, month)
gap <- 0.005
ymax <- (1 + gap) * max(sandp$close)
ymin <- (1 - gap) * min(sandp$close)
month_y <- ymin * 0.978
sandp %>%
ggplot(aes(x = date, y = close, group = week)) +
geom_rect(data = rectangles,
aes(xmin = first, xmax = last,
ymin = ymin, ymax = ymax, fill = weekly_loss),
inherit.aes = FALSE) +
geom_hline(yintercept = seq(5100, 6100, 200),
color = "gray80", linewidth = 0.2) +
geom_line(color = "#016C90", linewidth = 0.75) +
geom_point(color = "#016C90") +
geom_text(data = month_label,
aes(x = date, y = month_y, label = month), inherit.aes = FALSE,
family = "franklin", size = 9, size.unit = "pt") +
labs(
title = "Investors recoil from Trump's pledge to remake the\nglobal economy.",
subtitle = "<span style = 'color:#F6904C'>**Orange bars**</span> indicate weekly losses from end of previous week.",
caption = "Source: Yahoo"
) +
scale_fill_manual(
breaks = c(TRUE, FALSE),
values = c("#FDE3D4", "#E9F0F3")
) +
coord_cartesian(expand = FALSE, clip = "off",
ylim = c(ymin, ymax)) +
scale_y_continuous(breaks = seq(5100, 6100, 200),
labels = scales::label_number(big.mark = ",")) +
scale_x_date(limits = c(min(sandp$date) - 2, max(sandp$date) + 2),
breaks = seq(as.Date("2025-01-06"), max(sandp$date), 14),
date_labels = "%e") +
theme(
text = element_text(family = "franklin"),
panel.grid = element_blank(),
panel.background = element_blank(),
legend.position = "none",
plot.title.position = "plot",
plot.title = element_text(family = "domine", size = 16, face = "bold",
lineheight = 1.2),
plot.subtitle = element_markdown(family = "domine", size = 10,
color = "gray30",
margin = margin(t = 23, b = 19)),
plot.caption.position = "plot",
plot.caption = element_text(hjust = 0, size = 8, color = "gray30",
margin = margin(t = 29)),
plot.margin = margin(t = 8, r = 10, b = 8, l = 7),
axis.title = element_blank(),
axis.ticks = element_blank(),
axis.text.x = element_text(margin = margin(t = 3))
)
ggsave("sandp500_weekly.png", width = 6, height = 5.17)