Skip to content

Instantly share code, notes, and snippets.

@USMortality

USMortality/sp500_by_us_presidency.r

Created September 17, 2024 21:14
Show Gist options
  • Save USMortality/c19e926aa84e8c6b57b9f7a022cf8d56 to your computer and use it in GitHub Desktop.
Save USMortality/c19e926aa84e8c6b57b9f7a022cf8d56 to your computer and use it in GitHub Desktop.
Download ZIP
SP500 US Presidency Analysis
Raw
sp500_by_us_presidency.r
library(readr)
library(dplyr)
library(ggplot2)
library(scales)
sf <- 2
options(vsc.dev.args = list(width = 600 * sf, height = 335 * sf, res = 72 * sf))
# Define custom colors for Democrats (shades of blue) and Republicans (shades of red)
party_colors <- c(
"Democrat" = "#1f78b4", # blue
"Republican" = "#e31a1c" # red
)
watermark <- function(
x = structure(Inf),
y = Inf,
latest = "") {
ggplot2::annotate("text",
y = y,
x = x,
label = paste("@USMortality", latest),
vjust = 1,
hjust = 1,
col = "#000000",
cex = 6,
fontface = "bold",
alpha = 0.1
)
}
# Load the S&P 500 data
df <- read_csv("https://s3.mortality.watch/data/finance/usa/sp500.csv")
# Create a data frame of election details
election_info <- data.frame(
election_date = as.Date(c(
"1928-11-06", "1932-11-08", "1936-11-03", "1940-11-05", "1944-11-07",
"1948-11-02", "1952-11-04", "1956-11-06", "1960-11-08", "1964-11-03",
"1968-11-05", "1972-11-07", "1976-11-02", "1980-11-04", "1984-11-06",
"1988-11-08", "1992-11-03", "1996-11-05", "2000-11-07", "2004-11-02",
"2008-11-04", "2012-11-06", "2016-11-08", "2020-11-03"
)),
president = c(
"Herbert Hoover", "Franklin D. Roosevelt", "Franklin D. Roosevelt",
"Franklin D. Roosevelt", "Franklin D. Roosevelt", "Harry S. Truman",
"Dwight D. Eisenhower", "Dwight D. Eisenhower", "John F. Kennedy",
"Lyndon B. Johnson", "Richard Nixon", "Richard Nixon", "Jimmy Carter",
"Ronald Reagan", "Ronald Reagan", "George H.W. Bush", "Bill Clinton",
"Bill Clinton", "George W. Bush", "George W. Bush", "Barack Obama",
"Barack Obama", "Donald Trump", "Joe Biden"
),
party = c(
"Republican", "Democrat", "Democrat", "Democrat", "Democrat", "Democrat",
"Republican", "Republican", "Democrat", "Democrat", "Republican",
"Republican", "Democrat", "Republican", "Republican", "Republican",
"Democrat", "Democrat", "Republican", "Republican", "Democrat", "Democrat",
"Republican", "Democrat"
)
)
days <- 365.25 * 4
# Filter the S&P 500 data for one year after each election date
ts <- election_info |>
rowwise() |>
do({
election_date <- .$election_date
president <- .$president
party <- .$party
df_filtered <- df |>
filter(date >= election_date & date <= election_date + days) |>
mutate(
election_date = election_date,
president = president,
party = party,
days_since_election = as.numeric(date - election_date),
pct_change = ((close - first(close)) / first(close))
)
df_filtered
}) |>
bind_rows() |>
filter(days_since_election < days)
# Plot the data
ggplot(ts, aes(x = days_since_election, y = pct_change, group = election_date)) +
geom_line(aes(color = president)) +
scale_y_continuous(labels = percent_format(scale = 100)) +
labs(
title = "S&P 500 Percentage Change by U.S. President",
x = "Days Since Election",
y = "Percentage Change (%)",
color = "President"
) +
theme_minimal() +
watermark()
ts2 <- ts |>
group_by(party, days_since_election) |>
summarise(
sd_value = sd(pct_change),
pct_change = mean(pct_change),
n = n(),
.groups = "drop"
) |>
mutate(
error_margin = if_else(!is.na(sd_value) & n > 1, qt(0.975, df = n - 1) * sd_value / sqrt(n), NA_real_),
lower_ci = if_else(!is.na(error_margin), pct_change - error_margin, NA_real_),
upper_ci = if_else(!is.na(error_margin), pct_change + error_margin, NA_real_)
)
# Plot the data with 95% CI
ggplot(ts2, aes(x = days_since_election, y = pct_change, color = party)) +
geom_line() +
geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci, fill = party), alpha = 0.2, color = NA, show.legend = FALSE) +
scale_y_continuous(
labels = percent_format(scale = 100),
limits = c(-0.25, 0.75),
oob = scales::squish
) +
scale_color_manual(values = party_colors) +
scale_fill_manual(values = party_colors) +
labs(
title = "S&P 500 Percentage Change by Party",
subtitle = "Since 1927",
x = "Days Since Election",
y = "Percentage Change (%)",
color = "Party",
linetype = "President"
) +
theme_minimal() +
watermark()
ts3 <- ts |>
group_by(days_since_election) |>
summarise(
sd_value = sd(pct_change),
pct_change = mean(pct_change),
n = n(),
.groups = "drop"
) |>
mutate(
error_margin = if_else(!is.na(sd_value) & n > 1, qt(0.975, df = n - 1) * sd_value / sqrt(n), NA_real_),
lower_ci = if_else(!is.na(error_margin), pct_change - error_margin, NA_real_),
upper_ci = if_else(!is.na(error_margin), pct_change + error_margin, NA_real_)
)
ggplot(ts3, aes(x = days_since_election, y = pct_change)) +
geom_line(aes(color = "Mean"), linewidth = 1, linetype = "solid") + # Mean line in black
geom_ribbon(aes(ymin = lower_ci, ymax = upper_ci), alpha = 0.2, color = NA, show.legend = FALSE) +
geom_line(data = ts |> filter(president == "Donald Trump"), aes(x = days_since_election, y = pct_change, color = "Trump"), linewidth = 1) +
geom_line(data = ts |> filter(president == "Joe Biden"), aes(x = days_since_election, y = pct_change, color = "Biden"), linewidth = 1) +
scale_y_continuous(
labels = scales::percent_format(scale = 100),
limits = c(-0.1, 0.75),
oob = scales::squish
) +
scale_color_manual(
values = c(
"Mean" = "black",
"Trump" = unname(party_colors[2]),
"Biden" = unname(party_colors[1])
),
breaks = c("Mean", "Trump", "Biden"), # Custom order in the legend
name = "Legend"
) +
labs(
title = "S&P 500 Mean Change since U.S. Presidential Election - Trump vs. Biden",
subtitle = "Since 1927",
x = "Days Since Election",
y = "Percentage Change (%)"
) +
theme_minimal() +
watermark()
# Calculate Gains Normalized by Years in Office
presidential_gains <- ts |>
group_by(president, party) |>
summarize(
start_date = min(date),
end_date = max(date),
start_close = close[which.min(date)],
end_close = close[which.max(date)]
) |>
mutate(
total_days = as.numeric(end_date - start_date),
years_in_office = total_days / 365.25, # Account for leap years
total_gain = ((end_close - start_close) / start_close) * 100,
annualized_gain = total_gain / years_in_office
)
# Plotting the Annualized Gains
ggplot(presidential_gains, aes(x = reorder(president, annualized_gain), y = annualized_gain, fill = party)) +
geom_bar(stat = "identity") +
geom_text(
aes(label = sprintf("%.1f%%", annualized_gain)),
hjust = -0.1, # Adjust this value as needed
color = "black",
size = 3
) +
coord_flip() +
labs(
title = "Annualized Stock Market Gain During Presidency",
x = "President",
y = "Annualized Percentage Gain (%)"
) +
scale_fill_manual(values = party_colors) +
theme_minimal() +
watermark()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment