Votes as Percentage of Voting Eligible Population [USA]

chart_usa_elections_president_percentage_eligible.r

# Required libraries
library(ggplot2)
library(dplyr)
library(tsibble)
library(fable)
library(feasts)
library(readr)

sf <- 2
width <- 600 * sf
height <- 335 * sf

options(vsc.dev.args = list(width = width, height = height, res = 72 * sf))

# Original data (1976-2020)
votes_data <- data.frame(
  year = c(
    1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004, 2008, 2012, 2016, 2020
  ),
  dem_votes = c(
    40831881, 35480115, 37577352, 41809074,
    44909806, 47401185, 50999897, 59028444,
    69498516, 65915795, 65853514, 81283501
  ),
  rep_votes = c(
    39241665, 43643801, 54255263, 48746241,
    39446724, 39445724, 50456002, 62039788,
    59694844, 60377809, 62984344, 74216440
  )
)

# Add 2024 estimates
el_data <- read_csv("https://election.lab.ufl.edu/data-downloads/turnoutdata/Turnout_1980_2022_v1.1.csv") |>
  filter(STATE == "United States", YEAR %in% votes_data$year) |>
  select(YEAR, VEP) |>
  setNames(c("year", "eligible_population"))

df <- votes_data |>
  inner_join(el_data, by = join_by(year)) |>
  add_row(
    year = 2024,
    dem_votes = 73008454,
    rep_votes = 77736019,
    eligible_population = 245741673
  ) |>
  mutate(
    dem_votes_pct = dem_votes / eligible_population,
    rep_votes_pct = rep_votes / eligible_population
  )

# Plot popular votes
chart <- ggplot(df, aes(x = year)) +
  geom_line(aes(y = dem_votes, color = "Democratic"), size = 1.2) +
  geom_line(aes(y = rep_votes, color = "Republican"), size = 1.2) +
  geom_point(aes(y = dem_votes, color = "Democratic"), size = 3) +
  geom_point(aes(y = rep_votes, color = "Republican"), size = 3) +
  labs(
    title = "Popular Votes by Presidential Election [USA]",
    subtitle = "Updated: 11/8/24 9:48am · 2024 Projection · @USMortality",
    x = "Year", y = "Votes",
    color = "Party"
  ) +
  scale_color_manual(values = c("Democratic" = "blue", "Republican" = "red")) +
  scale_y_continuous(labels = scales::comma) +
  theme_bw()

ggsave(
  filename = "chart1.png", plot = chart, width = width, height = height,
  units = "px", dpi = 72 * sf, device = grDevices::png, type = "cairo"
)


# Plot normalized votes

# Convert to tsibble for forecasting
ts <- df |> as_tsibble(index = year)

# Fit models with trend component
dem_fit <- ts |>
  filter(year < 2020) |>
  model(TSLM(dem_votes_pct ~ trend()))
rep_fit <- ts |>
  filter(year < 2020) |>
  model(TSLM(rep_votes_pct ~ trend()))

# Forecast for 2020 and 2024 with 95% prediction intervals
dem_forecast <- dem_fit |> forecast(h = 2)
rep_forecast <- rep_fit |> forecast(h = 2)

# Extract hilo intervals and reshape data
dem_forecast <- dem_forecast |>
  fabletools::hilo(95) |>
  fabletools::unpack_hilo(cols = "95%") |>
  mutate(party = "Democratic") |>
  as_tibble()

rep_forecast <- rep_forecast |>
  fabletools::hilo(95) |>
  fabletools::unpack_hilo(cols = "95%") |>
  mutate(party = "Republican") |>
  as_tibble()

# Combine forecasts
forecast_df <- bind_rows(dem_forecast, rep_forecast)

# Plot normalized votes with forecast and ribbon
chart <- ggplot(ts, aes(x = year)) +
  # Historical data
  geom_line(aes(y = dem_votes_pct, color = "Democratic"), size = 1.2) +
  geom_line(aes(y = rep_votes_pct, color = "Republican"), size = 1.2) +
  geom_point(aes(y = dem_votes_pct, color = "Democratic"), size = 3) +
  geom_point(aes(y = rep_votes_pct, color = "Republican"), size = 3) +
  # Forecast ribbons
  geom_ribbon(
    data = forecast_df |> filter(party == "Democratic"),
    aes(ymin = `95%_lower`, ymax = `95%_upper`, fill = "Democratic"),
    alpha = 0.2
  ) +
  # geom_ribbon(
  #   data = forecast_df |> filter(party == "Republican"),
  #   aes(ymin = `95%_lower`, ymax = `95%_upper`, fill = "Republican"),
  #   alpha = 0.2
  # ) +
  # Forecasted lines
  geom_line(
    data = forecast_df |> filter(party == "Democratic"),
    aes(y = .mean, color = "Democratic"),
    linetype = "dashed", size = 1.2
  ) +
  # geom_line(
  #   data = forecast_df |> filter(party == "Republican"),
  #   aes(y = .mean, color = "Republican"),
  #   linetype = "dashed", size = 1.2
  # ) +
  labs(
    title = "Votes as Percentage of Voting Eligible Population",
    subtitle = "95% Prediction Interval of 1976-2016",
    x = "Year", y = "Percentage of Voting Eligible Population",
    color = "Party", fill = "Party"
  ) +
  scale_color_manual(values = c("Democratic" = "blue", "Republican" = "red")) +
  scale_fill_manual(values = c("Democratic" = "blue", "Republican" = "red")) +
  scale_y_continuous(labels = scales::percent) +
  theme_bw()

ggsave(
  filename = "chart2.png", plot = chart, width = width, height = height,
  units = "px", dpi = 72 * sf, device = grDevices::png, type = "cairo"
)