POTUS Economic Scorecard
  • Scorecard
  • About

This can take ~30s to load as it runs entirely in your browser…just leave the window open until it loads

The app is best viewed in landscape mode on a mobile device.
#| 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)
 
  • Site made with quarto and shinylive
  • Edit this page
  • Report an issue