Exploring the volatility of the S&P500 under Trump using the quantmod and tidyverse R packages (CC357)

May 2, 2025 • PD Schloss • 9 min read • •

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. The newsletter describing this visualization at a 30,000 ft view can be found here. You can find the original article here. 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)