This can take ~30s to load as it runs entirely in your browser…just leave the window open until it loads
#| standalone: true
#| viewerHeight: 1100
# Load required libraries
library(shiny)
library(ggplot2)
library(dplyr)
library(ggrepel)
library(plotly)
#-------------------------------------------
# Data Loading and Processing Functions ----
#-------------------------------------------
# Function to load presidents data
load_presidents_data <- function() {
presidents_data <- data.frame(
president = c(
"Eisenhower (1957)", "Kennedy (1961)", "Johnson (1963)", "Nixon (1969)",
"Nixon (1973)", "Ford (1974)", "Carter (1977)", "Reagan (1981)",
"Reagan (1985)", "Bush Sr. (1989)", "Clinton (1993)", "Clinton (1997)",
"Bush Jr. (2001)", "Bush Jr. (2005)", "Obama (2009)", "Obama (2013)",
"Trump (2017)", "Biden (2021)", "Trump (2025)"
),
inauguration_date = as.Date(c(
"1957-01-20", "1961-01-20", "1963-11-22", "1969-01-20",
"1973-01-20", "1974-08-09", "1977-01-20", "1981-01-20",
"1985-01-20", "1989-01-20", "1993-01-20", "1997-01-20",
"2001-01-20", "2005-01-20", "2009-01-20", "2013-01-20",
"2017-01-20", "2021-01-20", "2025-01-20"
)),
election_date = as.Date(c(
"1956-11-06", "1960-11-08", "1960-11-08", "1968-11-05",
"1972-11-07", "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", "2024-11-05"
)),
party = c(
"Republican", "Democratic", "Democratic", "Republican",
"Republican", "Republican", "Democratic", "Republican",
"Republican", "Republican", "Democratic", "Democratic",
"Republican", "Republican", "Democratic", "Democratic",
"Republican", "Democratic", "Republican"
),
stringsAsFactors = FALSE
)
# Convert date column to Date type
presidents_data$inauguration_date <- as.Date(presidents_data$inauguration_date)
presidents_data$election_date <- as.Date(presidents_data$election_date)
return(presidents_data)
}
# Function to load prepared data
load_data <- function() {
# URL for the data files in GitHub
market_data_url <- "https://raw.githubusercontent.com/jhelvy/potus-econ-scorecard/refs/heads/main/market_data.csv"
# Load data
tryCatch({
market_data_raw <- read.csv(market_data_url, stringsAsFactors = FALSE)
presidents_data <- load_presidents_data()
# Convert date column to Date type
market_data_raw$date <- as.Date(market_data_raw$date)
# Organize market data by index
market_data <- split(market_data_raw, market_data_raw$index_id)
return(list(
market_data = market_data,
presidents_data = presidents_data
))
}, error = function(e) {
# Return empty data frames if loading fails
warning("Error loading data: ", e$message)
return(list(
market_data = list(),
presidents_data = data.frame()
))
})
}
# Define which indices should use percent change vs absolute values
get_index_types <- function() {
list(
# Market indices - use percent change
percent_change = c("sp500", "djia", "nasdaq", "dxy"),
# Economic indicators - use absolute values
absolute = c("unemployment", "inflation", "treasury10yr", "housing", "gdp", "debt_gdp", "labor_participation")
)
}
# Function to process market data for selected presidents and reference date
process_market_data <- function(market_data,
presidents_data,
selected_index,
selected_presidents,
reference_type,
party_filter,
days_to_show) {
# Check if market data is available
if (is.null(market_data) || length(market_data) == 0) {
return(data.frame())
}
# Get index data
index_data_list <- list(market_data[[selected_index]])
names(index_data_list) <- selected_index
# Filter presidents by party and selection
filtered_presidents <- presidents_data %>%
filter(party %in% party_filter, president %in% selected_presidents)
# If no presidents selected, return empty dataframe
if (nrow(filtered_presidents) == 0) {
return(data.frame())
}
# Process data for each selected president and index
result_data <- data.frame()
for (pres_i in 1:nrow(filtered_presidents)) {
pres_row <- filtered_presidents[pres_i, ]
# Determine reference date based on user selection
ref_date <- if (reference_type == "inauguration") {
pres_row$inauguration_date
} else {
pres_row$election_date
}
# Process each index
for (idx_id in names(index_data_list)) {
index_data <- index_data_list[[idx_id]]
# Find closest trading day to reference date
closest_ref_date <- index_data %>%
filter(date >= ref_date) %>%
arrange(date) %>%
slice(1) %>%
pull(date)
if (length(closest_ref_date) == 0) {
# Skip if no suitable reference date found
next
}
# Get the reference value
ref_value <- index_data %>%
filter(date == closest_ref_date) %>%
pull(value)
# Calculate days from reference and percent change
pres_data <- index_data %>%
filter(date >= closest_ref_date) %>%
mutate(
president = pres_row$president,
party = pres_row$party,
day = as.numeric(difftime(date, closest_ref_date, units = "days")),
reference_value = ref_value,
percent_change = (value / ref_value - 1) * 100
) %>%
filter(day <= days_to_show)
result_data <- rbind(result_data, pres_data)
}
}
return(result_data)
}
# Function to process economic indicator data that shouldn't use percent change
process_econ_data <- function(market_data,
presidents_data,
selected_index,
selected_presidents,
reference_type,
party_filter,
days_to_show) {
# Check if market data is available
if (is.null(market_data) || length(market_data) == 0) {
return(data.frame())
}
# Get index data
index_data_list <- list(market_data[[selected_index]])
names(index_data_list) <- selected_index
# Filter presidents by party and selection
filtered_presidents <- presidents_data %>%
filter(party %in% party_filter, president %in% selected_presidents)
# If no presidents selected, return empty dataframe
if (nrow(filtered_presidents) == 0) {
return(data.frame())
}
# Process data for each selected president and index
result_data <- data.frame()
for (pres_i in 1:nrow(filtered_presidents)) {
pres_row <- filtered_presidents[pres_i, ]
# Determine reference date based on user selection
ref_date <- if (reference_type == "inauguration") {
pres_row$inauguration_date
} else {
pres_row$election_date
}
# Process each index
for (idx_id in names(index_data_list)) {
index_data <- index_data_list[[idx_id]]
# Find closest day to reference date
closest_ref_date <- index_data %>%
filter(date >= ref_date) %>%
arrange(date) %>%
slice(1) %>%
pull(date)
if (length(closest_ref_date) == 0) {
# Skip if no suitable reference date found
next
}
# For economic indicators, we show absolute values (not percent change)
pres_data <- index_data %>%
filter(date >= closest_ref_date) %>%
mutate(
president = pres_row$president,
party = pres_row$party,
day = as.numeric(difftime(date, closest_ref_date, units = "days"))
) %>%
filter(day <= days_to_show)
result_data <- rbind(result_data, pres_data)
}
}
return(result_data)
}
# Function to get the appropriate y-axis label for an index
get_y_axis_label <- function(selected_index) {
switch(selected_index,
"sp500" = "Percent Change (%)",
"djia" = "Percent Change (%)",
"nasdaq" = "Percent Change (%)",
"dxy" = "Percent Change (%)",
"unemployment" = "Unemployment Rate (%)",
"inflation" = "Inflation Rate (YoY %)",
"treasury10yr" = "10-Year Treasury Yield (%)",
"housing" = "Home Price Index",
"gdp" = "Real GDP (Billions of 2017 $)",
"debt_gdp" = "Federal Debt to GDP Ratio (%)",
"labor_participation" = "Labor Force Participation Rate (%)",
"Percent Change (%)" # Default
)
}
# Function to get help text for an index with source information
get_index_help_text <- function(selected_index) {
switch(selected_index,
"sp500" = "The S&P 500 is a stock market index tracking the performance of 500 large companies listed on U.S. exchanges. Source: Standard & Poor's.",
"djia" = "The Dow Jones Industrial Average is a price-weighted index of 30 significant stocks traded on the NYSE and NASDAQ. Source: S&P Dow Jones Indices.",
"nasdaq" = "The NASDAQ Composite Index includes all companies listed on the NASDAQ stock market, weighted by market capitalization. Source: NASDAQ, Inc.",
"dxy" = "The US Dollar Index measures the dollar against a basket of foreign currencies. A rising value indicates a stronger dollar, which can be good for imports but challenging for exports. Source: ICE Futures U.S.",
"unemployment" = "The Unemployment Rate represents the percentage of the labor force that is unemployed but actively seeking employment. Source: U.S. Bureau of Labor Statistics.",
"inflation" = "The Inflation Rate measures the year-over-year percentage change in consumer prices as captured by the Consumer Price Index (CPI). Source: U.S. Bureau of Labor Statistics.",
"treasury10yr" = "The 10-Year Treasury Yield reflects market expectations about future growth and inflation. Lower yields generally indicate economic pessimism or lower inflation expectations. Source: U.S. Department of the Treasury.",
"housing" = "The Case-Shiller Home Price Index tracks changes in the value of residential real estate nationwide. Source: S&P CoreLogic.",
"gdp" = "Real Gross Domestic Product is the inflation-adjusted value of all goods and services produced by an economy. Source: U.S. Bureau of Economic Analysis.",
"debt_gdp" = "The Federal Debt to GDP Ratio shows government debt as a percentage of annual economic output, a measure of fiscal sustainability. Source: U.S. Treasury and Bureau of Economic Analysis.",
"labor_participation" = "The Labor Force Participation Rate shows the percentage of the population that is either employed or actively seeking employment. Source: U.S. Bureau of Labor Statistics.",
"" # Default - no special help text
)
}
#-------------------------------------------
# UI Definition ----
#-------------------------------------------
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
# Index selection
radioButtons("selected_index", "Select Economic Indicator:",
choices = list(
# Market Indices
"S&P 500" = "sp500",
"Dow Jones" = "djia",
"NASDAQ" = "nasdaq",
"US Dollar Index" = "dxy",
# Economic Indicators
"Unemployment Rate" = "unemployment",
"Inflation Rate" = "inflation",
"10-Year Treasury Yield" = "treasury10yr",
"Home Price Index" = "housing",
"Real GDP" = "gdp",
"Federal Debt to GDP Ratio" = "debt_gdp",
"Labor Force Participation" = "labor_participation"
),
selected = "sp500"),
# Baseline selection
radioButtons("reference_date", "Reference Date:",
choices = list(
"Inauguration Day" = "inauguration",
"Day Before Election" = "election"
),
selected = "inauguration"),
# Time period selection
sliderInput("time_period", "Days to Display:",
min = 10, max = 365*4, value = 100, step = 10),
# Party filter
checkboxGroupInput("party_filter", "Filter by Party:",
choices = c("Democratic", "Republican"),
selected = c("Democratic", "Republican")),
# President selection buttons
div(
style = "display: flex; justify-content: space-between; margin-bottom: 10px;",
actionButton("select_all", "Select All", class = "btn-sm"),
actionButton("deselect_all", "Deselect All", class = "btn-sm")
),
# President checkboxes (dynamic)
uiOutput("president_selection")
),
# Main content
mainPanel(
# Add the info box above the plot for indicator descriptions
uiOutput("index_info_box"),
# Plot or "No Data" message
uiOutput("plot_or_message"),
div(
style = "display: flex; justify-content: flex-end; margin-top: 10px;",
actionButton("export_plot", "Export Plot", class = "btn-sm"),
actionButton("export_data", "Export Data", class = "btn-sm")
),
uiOutput("export_modal")
)
)
)
#-------------------------------------------
# Server Logic ----
#-------------------------------------------
server <- function(input, output, session) {
# Reactive values to store loaded data
loaded_data <- reactiveVal(NULL)
# Show loading message
showModal(modalDialog(
title = "Loading Data",
"Loading economic data. This may take a moment...",
footer = NULL,
easyClose = FALSE
))
# Load data on startup
observe({
# Get data
data_list <- load_data()
# Store the data
loaded_data(data_list)
# Remove loading message
removeModal()
})
# Index types
index_types <- get_index_types()
# Update default days depending on starting reference point
observeEvent(input$reference_date, {
# Calculate appropriate default days based on reference type
default_days <- if (input$reference_date == "inauguration") {
100 # Default for inauguration
} else {
180 # Default for election (includes transition period + first 100 days)
}
# Update the slider with the new default value
updateSliderInput(session, "time_period", value = default_days)
})
# Dynamic UI for president selection - reversed order
output$president_selection <- renderUI({
data <- loaded_data()
if (is.null(data) || nrow(data$presidents_data) == 0) {
return(NULL)
}
# Get presidents from data and reverse the order
presidents <- rev(data$presidents_data$president)
# Return checkbox group input with reversed order
checkboxGroupInput("selected_presidents",
"Select Presidents:",
choices = presidents,
selected = head(presidents, 4)) # Select the first 4 presidents in the reversed list (most recent)
})
# Render indicator info box above the plot
output$index_info_box <- renderUI({
selected_index <- input$selected_index
help_text <- get_index_help_text(selected_index)
if (help_text != "") {
div(
style = "margin-bottom: 15px; padding: 12px; background-color: #f8f9fa; border-left: 4px solid #007bff; border-radius: 5px;",
HTML(help_text)
)
}
})
# Process data based on user selections
processed_data <- reactive({
# Get data
data <- loaded_data()
# Make sure data is loaded
req(data, data$market_data, input$selected_presidents)
# Get user selections
selected_index <- input$selected_index
reference_type <- input$reference_date
selected_presidents <- input$selected_presidents
party_filter <- input$party_filter
days_to_show <- input$time_period
# Choose the appropriate processing function based on the selected index
if (selected_index %in% index_types$absolute) {
# For economic indicators, use absolute values
return(process_econ_data(
data$market_data,
data$presidents_data,
selected_index,
selected_presidents,
reference_type,
party_filter,
days_to_show
))
} else {
# For market indices, use percent change from reference date
return(process_market_data(
data$market_data,
data$presidents_data,
selected_index,
selected_presidents,
reference_type,
party_filter,
days_to_show
))
}
})
# Create the ggplot object for the selected data (used for export)
create_ggplot <- reactive({
# Get processed data
plot_data <- processed_data()
# Make sure there's data to plot
req(nrow(plot_data) > 0)
# Reference type for title
ref_type <- if (input$reference_date == "inauguration") {
"Inauguration Day"
} else {
"Day Before Election"
}
# Define party colors
party_colors <- c("Democratic" = "blue", "Republican" = "red")
# Get y-axis label
y_axis_label <- get_y_axis_label(input$selected_index)
if (input$selected_index %in% index_types$absolute) {
# Plot for economic indicators (absolute values)
index_name <- unique(plot_data$index_name)[1]
# Get end points for each president
end_points <- plot_data %>%
group_by(president, party) %>%
filter(day == max(day)) %>%
mutate(label = paste0(president, " (", round(value, 1), ")"))
# Create base ggplot with enhanced tooltips
p <- ggplot(plot_data, aes(x = day, y = value, color = party, group = president)) +
geom_line(size = 1, alpha = 0.8) +
geom_point(data = end_points, size = 3) +
geom_text_repel(
data = end_points,
aes(label = label),
direction = "y",
hjust = 0,
vjust = 0,
nudge_x = 15,
force = 3,
segment.size = 0.2,
box.padding = 0.5,
show.legend = FALSE
) +
scale_color_manual(values = party_colors, labels = c("Democratic", "Republican")) +
labs(
title = paste(index_name, "Since", ref_type),
subtitle = paste0("Showing first ", input$time_period, " days"),
x = paste("Days Since", ref_type),
y = y_axis_label,
color = "Party" # Capitalize Party in legend
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank(),
legend.position = "bottom"
) +
# Add extra space on right for labels
coord_cartesian(xlim = c(0, max(plot_data$day) * 1.3))
# For unemployment and some other metrics, we might want to set y-limits
if (input$selected_index == "unemployment") {
p <- p + ylim(0, max(plot_data$value) * 1.1) # Ensure we start at 0 for unemployment
}
return(p)
} else {
# Plot for a single market index (percent change)
index_name <- unique(plot_data$index_name)[1]
# Get end points for each president
end_points <- plot_data %>%
group_by(president, party) %>%
filter(day == max(day)) %>%
mutate(label = paste0(president, " (", round(percent_change, 1), "%)"))
# Create base ggplot with enhanced tooltips
p <- ggplot(plot_data, aes(x = day, y = percent_change, color = party, group = president)) +
geom_line(size = 1, alpha = 0.8) +
geom_point(data = end_points, size = 3) +
geom_text_repel(
data = end_points,
aes(label = label),
direction = "y",
hjust = 0,
vjust = 0,
nudge_x = 15,
force = 3,
segment.size = 0.2,
box.padding = 0.5,
show.legend = FALSE
) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
scale_color_manual(values = party_colors, labels = c("Democratic", "Republican")) +
labs(
title = paste(index_name, "Performance Since", ref_type),
subtitle = paste0("Showing first ", input$time_period, " days (0% = value on reference date)"),
x = paste("Days Since", ref_type),
y = y_axis_label,
color = "Party" # Capitalize Party in legend
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
panel.grid.minor = element_blank(),
legend.position = "bottom"
) +
# Add extra space on right for labels
coord_cartesian(xlim = c(0, max(plot_data$day) * 1.3))
return(p)
}
})
# Check if we have valid data to plot
has_data_to_plot <- reactive({
plot_data <- processed_data()
# More robust check - ensure we have actual data points for at least one president
return(!is.null(plot_data) && nrow(plot_data) > 0 &&
length(unique(plot_data$president)) > 0 &&
# For percent change indices, make sure we have valid percent_change values
(!input$selected_index %in% index_types$percent_change || any(!is.na(plot_data$percent_change))))
})
# Render either the plot or a "no data" message
output$plot_or_message <- renderUI({
if (has_data_to_plot()) {
# We have data - show the plot
tagList(
plotlyOutput("economic_plot", height = "100%")
)
} else {
# No data - show a message
ref_type <- if (input$reference_date == "inauguration") {
"Inauguration Day"
} else {
"Day Before Election"
}
index_display_name <- switch(input$selected_index,
"sp500" = "S&P 500",
"djia" = "Dow Jones",
"nasdaq" = "NASDAQ",
"dxy" = "US Dollar Index",
"unemployment" = "Unemployment Rate",
"inflation" = "Inflation Rate",
"treasury10yr" = "10-Year Treasury Yield",
"housing" = "Home Price Index",
"gdp" = "Real GDP",
"debt_gdp" = "Federal Debt to GDP Ratio",
"labor_participation" = "Labor Force Participation Rate")
tagList(
div(
style = "height: 400px; display: flex; flex-direction: column; justify-content: center; align-items: center; background-color: #f8f9fa; border-radius: 10px; padding: 20px; text-align: center;",
tags$h4("Insufficient Data Available", style = "margin-bottom: 15px; color: #6c757d;"),
tags$p("Try one of the following:", style = "margin-top: 15px; font-weight: bold;"),
tags$ul(
style = "list-style-type: none; padding: 0;",
tags$li("• Change the reference date", style = "margin-bottom: 5px;"),
tags$li("• Select different presidents", style = "margin-bottom: 5px;"),
tags$li("• Choose a different time period", style = "margin-bottom: 5px;"),
tags$li("• Select a different economic indicator", style = "margin-bottom: 5px;")
)
)
)
}
})
# Render the plot - using direct plotly for better performance
output$economic_plot <- renderPlotly({
# Get processed data
plot_data <- processed_data()
# Make sure there's data to plot
req(nrow(plot_data) > 0)
# Reference type for title
ref_type <- if (input$reference_date == "inauguration") {
"Inauguration Day"
} else {
"Day Before Election"
}
# Define party colors
party_colors <- c("Democratic" = "blue", "Republican" = "red")
# Get y-axis label
y_axis_label <- get_y_axis_label(input$selected_index)
if (input$selected_index %in% index_types$absolute) {
# Plot for economic indicators (absolute values)
index_name <- unique(plot_data$index_name)[1]
# First create the basic plot structure
p <- plot_ly()
# Process end points first for label creation
end_points <- plot_data %>%
group_by(president, party) %>%
slice(which.max(day)) %>%
ungroup()
# Create a list to store traces for each party
democratic_data <- plot_data %>% filter(party == "Democratic")
republican_data <- plot_data %>% filter(party == "Republican")
# Add Democratic party trace if we have data
if (nrow(democratic_data) > 0) {
dem_presidents <- unique(democratic_data$president)
for (pres in dem_presidents) {
pres_data <- democratic_data %>% filter(president == pres)
p <- p %>% add_trace(
data = pres_data,
x = ~day,
y = ~value,
name = pres,
legendgroup = "Democratic",
showlegend = FALSE, # Only show in party legend
color = I("blue"),
type = 'scatter',
mode = 'lines',
hoverinfo = 'text',
text = ~paste0(president, "<br>Day: ", day, "<br>Value: ", round(value, 2)),
line = list(width = 2)
)
}
# Add a single legend entry for Democratic party
if (nrow(democratic_data) > 0) {
p <- p %>% add_trace(
x = c(0),
y = c(0),
name = "Democratic",
legendgroup = "Democratic",
showlegend = TRUE,
color = I("blue"),
type = 'scatter',
mode = 'lines',
line = list(width = 4),
visible = 'legendonly' # This makes the trace invisible but keeps the legend
)
}
}
# Add Republican party trace if we have data
if (nrow(republican_data) > 0) {
rep_presidents <- unique(republican_data$president)
for (pres in rep_presidents) {
pres_data <- republican_data %>% filter(president == pres)
p <- p %>% add_trace(
data = pres_data,
x = ~day,
y = ~value,
name = pres,
legendgroup = "Republican",
showlegend = FALSE, # Only show in party legend
color = I("red"),
type = 'scatter',
mode = 'lines',
hoverinfo = 'text',
text = ~paste0(president, "<br>Day: ", day, "<br>Value: ", round(value, 2)),
line = list(width = 2)
)
}
# Add a single legend entry for Republican party
if (nrow(republican_data) > 0) {
p <- p %>% add_trace(
x = c(0),
y = c(0),
name = "Republican",
legendgroup = "Republican",
showlegend = TRUE,
color = I("red"),
type = 'scatter',
mode = 'lines',
line = list(width = 4),
visible = 'legendonly' # This makes the trace invisible but keeps the legend
)
}
}
# Add layout
p <- p %>% layout(
title = list(
text = paste(index_name, "Since", ref_type),
font = list(size = 16)
),
xaxis = list(
title = paste("Days Since", ref_type),
range = c(0, max(plot_data$day) * 1.3)
),
yaxis = list(
title = y_axis_label,
range = if(input$selected_index == "unemployment") c(0, max(plot_data$value) * 1.1) else NULL
),
legend = list(
title = list(text = "Party"),
orientation = "h",
y = -0.2
),
margin = list(r = 100)
)
# Add individual annotations for each president
for (i in 1:nrow(end_points)) {
p <- p %>% add_annotations(
x = end_points$day[i],
y = end_points$value[i],
text = paste0(end_points$president[i], " (", round(end_points$value[i], 1), ")"),
showarrow = TRUE,
arrowhead = 0,
arrowsize = 0.7,
arrowwidth = 1,
arrowcolor = "gray70",
xanchor = "left",
yanchor = "middle",
ax = 50,
ay = 0
)
}
p %>% config(displayModeBar = TRUE)
} else {
# Plot for market indices (percent change)
index_name <- unique(plot_data$index_name)[1]
# First create the basic plot structure
p <- plot_ly()
# Process end points first for label creation
end_points <- plot_data %>%
group_by(president, party) %>%
slice(which.max(day)) %>%
ungroup()
# Create a list to store traces for each party
democratic_data <- plot_data %>% filter(party == "Democratic")
republican_data <- plot_data %>% filter(party == "Republican")
# Add Democratic party trace if we have data
if (nrow(democratic_data) > 0) {
dem_presidents <- unique(democratic_data$president)
for (pres in dem_presidents) {
pres_data <- democratic_data %>% filter(president == pres)
p <- p %>% add_trace(
data = pres_data,
x = ~day,
y = ~percent_change,
name = pres,
legendgroup = "Democratic",
showlegend = FALSE, # Only show in party legend
color = I("blue"),
type = 'scatter',
mode = 'lines',
hoverinfo = 'text',
text = ~paste0(president, "<br>Day: ", day, "<br>Change: ", round(percent_change, 2), "%"),
line = list(width = 2)
)
}
# Add a single legend entry for Democratic party
if (nrow(democratic_data) > 0) {
p <- p %>% add_trace(
x = c(0),
y = c(0),
name = "Democratic",
legendgroup = "Democratic",
showlegend = TRUE,
color = I("blue"),
type = 'scatter',
mode = 'lines',
line = list(width = 4),
visible = 'legendonly' # This makes the trace invisible but keeps the legend
)
}
}
# Add Republican party trace if we have data
if (nrow(republican_data) > 0) {
rep_presidents <- unique(republican_data$president)
for (pres in rep_presidents) {
pres_data <- republican_data %>% filter(president == pres)
p <- p %>% add_trace(
data = pres_data,
x = ~day,
y = ~percent_change,
name = pres,
legendgroup = "Republican",
showlegend = FALSE, # Only show in party legend
color = I("red"),
type = 'scatter',
mode = 'lines',
hoverinfo = 'text',
text = ~paste0(president, "<br>Day: ", day, "<br>Change: ", round(percent_change, 2), "%"),
line = list(width = 2)
)
}
# Add a single legend entry for Republican party
if (nrow(republican_data) > 0) {
p <- p %>% add_trace(
x = c(0),
y = c(0),
name = "Republican",
legendgroup = "Republican",
showlegend = TRUE,
color = I("red"),
type = 'scatter',
mode = 'lines',
line = list(width = 4),
visible = 'legendonly' # This makes the trace invisible but keeps the legend
)
}
}
# Add layout
p <- p %>% layout(
title = list(
text = paste(index_name, "Performance Since", ref_type),
font = list(size = 16)
),
xaxis = list(
title = paste("Days Since", ref_type),
range = c(0, max(plot_data$day) * 1.3)
),
yaxis = list(
title = y_axis_label,
zeroline = TRUE
),
shapes = list(
# Add zero line
list(
type = "line",
x0 = 0,
x1 = max(plot_data$day) * 1.3,
y0 = 0,
y1 = 0,
line = list(
color = "gray",
width = 1,
dash = "dash"
)
)
),
legend = list(
title = list(text = "Party"),
orientation = "h",
y = -0.2
),
margin = list(r = 100)
)
# Add individual annotations for each president
for (i in 1:nrow(end_points)) {
p <- p %>% add_annotations(
x = end_points$day[i],
y = end_points$percent_change[i],
text = paste0(end_points$president[i], " (", round(end_points$percent_change[i], 1), "%)"),
showarrow = TRUE,
arrowhead = 0,
arrowsize = 0.7,
arrowwidth = 1,
arrowcolor = "gray70",
xanchor = "left",
yanchor = "middle",
ax = 50,
ay = 0
)
}
p %>% config(displayModeBar = TRUE)
}
})
# Handle select all button
observeEvent(input$select_all, {
data <- loaded_data()
req(data, data$presidents_data)
# Get reversed president list to match the UI
presidents <- rev(data$presidents_data$president)
updateCheckboxGroupInput(session, "selected_presidents",
choices = presidents,
selected = presidents)
})
# Handle deselect all button
observeEvent(input$deselect_all, {
data <- loaded_data()
req(data, data$presidents_data)
# Get reversed president list to match the UI
presidents <- rev(data$presidents_data$president)
updateCheckboxGroupInput(session, "selected_presidents",
choices = presidents,
selected = character(0))
})
# Export plot handler - with embedded URL in caption and more right space
observeEvent(input$export_plot, {
req(processed_data())
# Use the ggplot object for export
p <- create_ggplot()
# Add caption with source URL to the ggplot
p <- p + labs(
caption = paste0("Generated on ", Sys.Date(), " from https://jhelvy.github.io/potus-econ-scorecard/")
) +
theme(
plot.title = element_text(face = "bold", size = 16),
plot.subtitle = element_text(size = 12),
plot.caption = element_text(size = 9, hjust = 0)
)
# Show the plot in a modal with save instructions
showModal(
modalDialog(
title = "Plot Export",
size = "l",
plotOutput("export_plot_preview", height = "500px"),
hr(),
tags$div(
style = "text-align: center;",
tags$p("To save this image, right-click on the plot above and select 'Save image as...'")
),
footer = tagList(
modalButton("Close")
)
)
)
output$export_plot_preview <- renderPlot({
p
}, height = 500, width = 800, res = 100) # Increased resolution for better quality
})
# Export data handler - client-side download approach
observeEvent(input$export_data, {
req(processed_data())
export_data <- processed_data() %>%
mutate(
reference_type = if(input$reference_date == "inauguration") "Inauguration Day" else "Day Before Election",
data_generated = as.character(Sys.Date())
)
# Create a unique ID for this download
download_id <- paste0("download_", round(runif(1, 1, 100000)))
# Convert data to CSV format
csv_content <- reactive({
# Create the header row
headers <- paste(colnames(export_data), collapse = ",")
# Create data rows (escaping any commas in string fields)
rows <- apply(export_data, 1, function(row) {
# Convert row values to character and handle special cases
row_vals <- sapply(row, function(val) {
if (is.character(val) && grepl(",", val)) {
# Wrap strings containing commas in quotes
return(paste0('"', val, '"'))
} else {
return(as.character(val))
}
})
paste(row_vals, collapse = ",")
})
# Combine header and rows
csv_data <- paste(c(headers, rows), collapse = "\n")
return(csv_data)
})
# Get index name for the filename
index_name <- switch(input$selected_index,
"sp500" = "SP500",
"djia" = "DowJones",
"nasdaq" = "NASDAQ",
"dxy" = "USDollarIndex",
"unemployment" = "Unemployment",
"inflation" = "Inflation",
"treasury10yr" = "TreasuryYield",
"housing" = "HomePriceIndex",
"gdp" = "RealGDP",
"debt_gdp" = "DebtToGDP",
"labor_participation" = "LaborParticipation")
filename <- paste0(index_name, "_data_", Sys.Date(), ".csv")
# Create modal with preview and client-side download link
showModal(
modalDialog(
title = "Data Export",
size = "l",
p("The complete dataset is ready for download."),
p(paste0("Number of rows in dataset: ", nrow(export_data))),
# Display a small preview of the data
tags$div(
style = "max-height: 300px; overflow-y: auto;",
renderTable({
head(export_data, 10) # Show just first 10 rows as preview
})
),
# Add JavaScript to enable client-side download
tags$script(HTML(sprintf(
"
function downloadCSV() {
var csvContent = %s;
var blob = new Blob([csvContent], { type: 'text/csv;charset=utf-8;' });
var link = document.createElement('a');
link.href = URL.createObjectURL(blob);
link.setAttribute('download', '%s');
document.body.appendChild(link);
link.click();
document.body.removeChild(link);
}
",
paste0("document.getElementById('", download_id, "').getAttribute('data-csv')"),
filename
))),
# Hidden span to store the CSV data
tags$span(
id = download_id,
style = "display: none;",
`data-csv` = csv_content()
),
footer = tagList(
modalButton("Close"),
tags$button(
"Download Complete Dataset",
class = "btn btn-primary",
onclick = "downloadCSV()"
)
)
)
)
})
}
#-------------------------------------------
# Run the application
#-------------------------------------------
shinyApp(ui, server)