Spaces:

HyannisHarborHawksCCBL
/

CapePitcherSuccessModel

Paused

Update app.R

0e0716a verified 6 months ago

21.5 kB

#Read in libraries (make sure these are installed in the Docker file)
library(shiny)
library(brms)
library(tidyverse)
library(DT)
library(bayesplot)
library(httr)
library(arrow)
library(base64enc)

#Read in HH Logo
logo_b64 <- base64enc::base64encode("HHLogo.png")
logo_uri <- paste0("data:image/png;base64,", logo_b64)

#Get passoword from app secrets
HF_PASSWORD <- Sys.getenv('APP_PASSWORD')



# ============================================================
#Functions to read in private datasets and models
# ============================================================
download_private_parquet <- function(repo_id, filename, max_retries = 3) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  api_key <- Sys.getenv("HF_PitSuccess_Dataset_Token")
  if (api_key == "") stop("API key is not set.")
  for (attempt in 1:max_retries) {
    tryCatch({
      response <- GET(url, add_headers(Authorization = paste("Bearer", api_key)), timeout(60))
      if (status_code(response) == 200) {
        tmp <- tempfile(fileext = ".parquet")
        writeBin(content(response, "raw"), tmp)
        return(read_parquet(tmp))
      } else warning(paste("Attempt", attempt, "failed with status:", status_code(response)))
    }, error = function(e) {
      warning(paste("Attempt", attempt, "failed:", e$message))
      if (attempt < max_retries) Sys.sleep(2)
    })
  }
  stop(paste("Failed to download dataset after", max_retries, "attempts"))
}

download_private_rds <- function(repo_id, filename, max_retries = 3) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  api_key <- Sys.getenv("HF_PitSuccess_Dataset_Token")
  if (api_key == "") stop("API key is not set.")
  for (attempt in 1:max_retries) {
    tryCatch({
      response <- GET(url, add_headers(Authorization = paste("Bearer", api_key)), timeout(60))
      if (status_code(response) == 200) {
        tmp <- tempfile(fileext = ".rds")
        writeBin(content(response, "raw"), tmp)
        return(readRDS(tmp))
      } else warning(paste("Attempt", attempt, "failed:", e$message))
    }, error = function(e) {
      warning(paste("Attempt", attempt, "failed:", e$message))
      if (attempt < max_retries) Sys.sleep(2)
    })
  }
  stop(paste("Failed to download dataset after", max_retries, "attempts"))
}

#Read in the pitching model and the full dataframe with results
cape_model_pitching <- download_private_rds("HyannisHarborHawksCCBL/PitcherSuccessDataset", "PitchingModel.rds")
college_26_results <- download_private_parquet("HyannisHarborHawksCCBL/PitcherSuccessDataset", "college_26_results.parquet")


# ============================================================
#App UI
# ============================================================
ui <- fluidPage(
  
  tags$head(tags$style(HTML("
    body { font-family: 'Helvetica Neue', sans-serif; background: #f8f8f8; }
    .navbar { background: #1B3A5C; }
    .navbar-default .navbar-brand { color: white; font-weight: 600; }
    .navbar-default .navbar-nav > li > a { color: #ccc; }
    .navbar-default .navbar-nav > .active > a { background: #2a5a8c; color: white; }
    .card { background: white; border-radius: 8px; padding: 20px; margin-bottom: 15px; 
            border: 1px solid #e0e0e0; }
    .metric-box { text-align: center; padding: 15px; }
    .metric-value { font-size: 28px; font-weight: 600; color: #1B3A5C; }
    .metric-label { font-size: 12px; color: #888; text-transform: uppercase; letter-spacing: 1px; }
    
    /* Login screen */
    #login_screen {
      position: fixed;
      top: 0; left: 0; right: 0; bottom: 0;
      z-index: 9999;
      display: flex;
      flex-direction: column;
      align-items: center;
      justify-content: center;
      background: linear-gradient(135deg, #0d1f33 0%, #1B3A5C 40%, #2a5a8c 100%);
      transition: opacity 0.8s ease, transform 0.8s ease;
    }
    #login_screen.fade-out {
      opacity: 0;
      transform: scale(1.02);
      pointer-events: none;
    }
    #login_screen .login-title {
      font-size: 36px;
      font-weight: 800;
      color: white;
      letter-spacing: 1px;
      margin-bottom: 8px;
      text-align: center;
    }
    #login_screen .login-subtitle {
      font-size: 14px;
      color: rgba(255,255,255,0.5);
      letter-spacing: 2px;
      text-transform: uppercase;
      margin-bottom: 36px;
    }
    #login_screen .login-box {
      background: rgba(255,255,255,0.06);
      border: 1px solid rgba(255,255,255,0.15);
      border-radius: 12px;
      padding: 32px 40px;
      backdrop-filter: blur(10px);
      width: 340px;
      text-align: center;
    }
    #login_screen .login-box input[type='password'] {
      width: 100%;
      padding: 12px 16px;
      border: 1px solid rgba(255,255,255,0.2);
      border-radius: 6px;
      background: rgba(255,255,255,0.08);
      color: white;
      font-size: 15px;
      margin-bottom: 16px;
      outline: none;
      text-align: center;
      letter-spacing: 2px;
      transition: border-color 0.3s;
    }
    #login_screen .login-box input[type='password']:focus {
      border-color: #4a9eff;
    }
    #login_screen .login-box input[type='password']::placeholder {
      color: rgba(255,255,255,0.3);
      letter-spacing: 1px;
    }
    #login_screen .login-btn {
      width: 100%;
      padding: 12px;
      border: none;
      border-radius: 6px;
      background: #2a5a8c;
      color: white;
      font-size: 14px;
      font-weight: 700;
      letter-spacing: 1px;
      text-transform: uppercase;
      cursor: pointer;
      transition: background 0.3s;
    }
    #login_screen .login-btn:hover { background: #3a7abc; }
    #login_screen .login-error {
      color: #ff6b6b;
      font-size: 13px;
      margin-top: 12px;
      min-height: 20px;
    }
  "))),
  
  # Login overlay
  tags$div(id = "login_screen",
    tags$img(class = "login-logo", src = logo_uri),
    tags$div(class = "login-title", "Cape Cod Pitching Projections"),
    tags$div(class = "login-subtitle", "Hyannis Harbor Hawks"),
    tags$div(class = "login-box",
      tags$input(id = "login_pw", type = "password", placeholder = "Enter password"),
      tags$button(id = "login_btn", class = "login-btn", "Enter"),
      tags$div(id = "login_error", class = "login-error")
    )
  ),
  
  # Login JS
  tags$script(HTML(paste0("
    var APP_PASSWORD = '", HF_PASSWORD, "';
    function tryLogin() {
      var pw = document.getElementById('login_pw').value;
      if (pw === APP_PASSWORD) {
        document.getElementById('login_screen').classList.add('fade-out');
        setTimeout(function() {
          document.getElementById('login_screen').style.display = 'none';
        }, 800);
      } else {
        document.getElementById('login_error').textContent = 'Incorrect password';
        document.getElementById('login_pw').value = '';
        document.getElementById('login_pw').style.borderColor = '#ff6b6b';
        setTimeout(function() {
          document.getElementById('login_error').textContent = '';
          document.getElementById('login_pw').style.borderColor = 'rgba(255,255,255,0.2)';
        }, 2000);
      }
    }
    document.addEventListener('DOMContentLoaded', function() {
      document.getElementById('login_btn').addEventListener('click', tryLogin);
      document.getElementById('login_pw').addEventListener('keydown', function(e) {
        if (e.key === 'Enter') tryLogin();
      });
    });
  "))),
  
  navbarPage(
    title = "Cape Cod Pitching Projections",

    #Leaderboard tab -- Filterable table of all projected pitchers with summary metrics and sorting options
    tabPanel("Leaderboard",
             fluidRow(
               column(3,
                      div(class = "card",
                          selectInput("league_filter", "Conference:", 
                                      choices = c("All", sort(unique(college_26_results$PitcherLeague_college))),
                                      selected = "All"),
                          selectInput("throws_filter", "Throws:",
                                      choices = c("All", "Right", "Left"),
                                      selected = "All"),
                          sliderInput("bf_filter", "Min College BF:",
                                      min = 0, max = 300, value = 30, step = 10),
                          selectInput("sort_by", "Sort by:",
                                      choices = c("Predicted xwOBA" = "pred_xwOBA",
                                                  "Uncertainty" = "pred_uncertainty",
                                                  "College BF" = "BF_college"),
                                      selected = "pred_xwOBA"),
                          checkboxInput("sort_asc", "Ascending", value = TRUE)
                      )
               ),
               column(9,
                      div(class = "card",
                          fluidRow(
                            column(3, div(class = "metric-box",
                                          textOutput("n_pitchers_text") %>% tagAppendAttributes(class = "metric-value"),
                                          div(class = "metric-label", "Pitchers")
                            )),
                            column(3, div(class = "metric-box",
                                          textOutput("avg_pred_text") %>% tagAppendAttributes(class = "metric-value"),
                                          div(class = "metric-label", "Avg Predicted xwOBA")
                            )),
                            column(3, div(class = "metric-box",
                                          textOutput("best_pred_text") %>% tagAppendAttributes(class = "metric-value"),
                                          div(class = "metric-label", "Best Predicted")
                            )),
                            column(3, div(class = "metric-box",
                                          textOutput("avg_unc_text") %>% tagAppendAttributes(class = "metric-value"),
                                          div(class = "metric-label", "Avg Uncertainty")
                            ))
                          )
                      ),
                      div(class = "card",
                          DTOutput("leaderboard_table")
                      )
               )
             )
    ),

    #Breakdown tab -- Individual pitcher deep dive with waterfall contributions, posterior distributions, and peer comparisons
    tabPanel("Player Breakdown",
             fluidRow(
               column(3,
                      div(class = "card",
                          selectizeInput("player_select", "Select Pitcher:",
                                         choices = sort(unique(college_26_results$Pitcher)),
                                         selected = NULL,
                                         options = list(placeholder = "Type a name...")),
                          hr(),
                          uiOutput("player_summary")
                      )
               ),
               column(9,
                      fluidRow(
                        column(6, div(class = "card", plotOutput("waterfall_plot", height = "450px"))),
                        column(6, div(class = "card", plotOutput("uncertainty_plot", height = "450px")))
                      ),
                      fluidRow(
                        column(6, div(class = "card", plotOutput("posterior_dist_plot", height = "350px"))),
                        column(6, div(class = "card", plotOutput("comparison_plot", height = "350px")))
                      )
               )
             )
    )
  )
)


# ============================================================
#App Server
# ============================================================

server <- function(input, output, session) {
  
  filtered_data <- reactive({
    df <- college_26_results


    #Filters to filter by college league, handedness, BF, and sorts
    if (input$league_filter != "All") {
      df <- df %>% filter(PitcherLeague_college == input$league_filter)
    }
    if (input$throws_filter != "All") {
      df <- df %>% filter(PitcherThrows_college == input$throws_filter)
    }
    df <- df %>% filter(BF_college >= input$bf_filter)
    
    if (input$sort_asc) {
      df <- df %>% arrange(.data[[input$sort_by]])
    } else {
      df <- df %>% arrange(desc(.data[[input$sort_by]]))
    }
    df
  })

  #Summary stats
  output$n_pitchers_text <- renderText(nrow(filtered_data()))
  output$avg_pred_text <- renderText(round(mean(filtered_data()$pred_xwOBA, na.rm = TRUE), 3))
  output$best_pred_text <- renderText(round(min(filtered_data()$pred_xwOBA, na.rm = TRUE), 3))
  output$avg_unc_text <- renderText(round(mean(filtered_data()$pred_uncertainty, na.rm = TRUE), 3))

  #Returns leaderboard table
  output$leaderboard_table <- renderDT({
    filtered_data() %>%
      mutate(rank = row_number()) %>%
      select(rank, Pitcher, PitcherThrows_college, PitcherLeague_college,
             BF_college, pred_xwOBA, pred_lower, pred_upper, pred_uncertainty) %>%
      mutate(across(where(is.numeric) & !c(rank, BF_college), ~round(.x, 3))) %>%
      datatable(
        colnames = c("Rank", "Pitcher", "Throws", "Conference", "College BF",
                     "Pred xwOBA", "Lower", "Upper", "Uncertainty"),
        selection = "single",
        options = list(pageLength = 25, scrollX = TRUE),
        rownames = FALSE
      )
  })

  #Player selection 
  observeEvent(input$leaderboard_table_rows_selected, {
    row <- filtered_data()[input$leaderboard_table_rows_selected, ]
    updateSelectizeInput(session, "player_select", selected = row$Pitcher)
  })

  #Reactive filter: returns the selected pitcher's row from the results table
  player_data <- reactive({
    req(input$player_select)
    college_26_results %>% filter(Pitcher == input$player_select)
  })
  
  output$player_summary <- renderUI({
    obs <- player_data()
    if (nrow(obs) == 0) return(NULL)

    #Compute observation-level sigma from the distributional submodel fixed effects (get player uncertainty)
    sigma_fe <- fixef(cape_model_pitching, dpar = "sigma")
    
    log_sigma <- sigma_fe["sigma_Intercept", "Estimate"] +
      sigma_fe["sigma_logBF_cape", "Estimate"] * log(obs$BF_cape) +
      sigma_fe["sigma_logBF_college", "Estimate"] * log(obs$BF_college)
    obs_sigma <- exp(log_sigma)

    #Render the player summary card with prediction, interval, and pitcher info
    tagList(
      h4(obs$Pitcher),
      tags$table(style = "width: 100%; font-size: 14px;",
                 tags$tr(tags$td("Predicted xwOBA"), tags$td(style = "text-align: right; font-weight: 600;", round(obs$pred_xwOBA, 3))),
                 tags$tr(tags$td("95% Interval"), tags$td(style = "text-align: right;", 
                                                          paste0("[", round(obs$pred_lower, 3), ", ", round(obs$pred_upper, 3), "]"))),
                 tags$tr(tags$td("Uncertainty"), tags$td(style = "text-align: right;", round(obs$pred_uncertainty, 3))),
                 tags$tr(tags$td(style = "padding-top: 10px;", "College BF"), tags$td(style = "text-align: right; padding-top: 10px;", obs$BF_college)),
                 tags$tr(tags$td("Throws"), tags$td(style = "text-align: right;", as.character(obs$PitcherThrows_college))),
                 tags$tr(tags$td("Conference"), tags$td(style = "text-align: right;", as.character(obs$PitcherLeague_college))),
                 tags$tr(tags$td(style = "padding-top: 10px;", "Obs Sigma"), tags$td(style = "text-align: right; padding-top: 10px;", round(obs_sigma, 4)))
      )
    )
  })

  #Predict cape success 
  get_contributions <- reactive({
    obs <- player_data()
    if (nrow(obs) == 0) return(NULL)
    
    fe <- fixef(cape_model_pitching)
    coefs <- fe[, "Estimate"]
    
    pred_cols <- c("zone_pct_college", "k_minus_bb_college", "csw_plus_college",
                   "stuff_plus_primary_college", "stuff_plus_secondary_college",
                   "stuff_plus_tertiary_college", "arsenal_depth_college",
                   "chase_pct_college", "iz_whiff_pct_college",
                   "mean_ev_college", "ev_90_college", "ev_sd_college",
                   "gb_pct_college", "xwOBA_R_minus_L_college")
    
    contributions <- data.frame(
      predictor = pred_cols,
      value = as.numeric(obs[1, pred_cols]),
      coefficient = as.numeric(coefs[pred_cols]),
      stringsAsFactors = FALSE
    ) %>%
      bind_rows(data.frame(
        predictor = "logBF_college",
        value = log(obs$BF_college),
        coefficient = as.numeric(coefs["logBF_college"]),
        stringsAsFactors = FALSE
      )) %>%
      mutate(
        contribution = value * coefficient,
        direction = ifelse(contribution > 0, "increases xwOBA", "decreases xwOBA")
      ) %>%
      arrange(desc(abs(contribution)))
    
    draws_matrix <- as.matrix(as_draws_df(cape_model_pitching))
    contributions <- contributions %>%
      mutate(
        coef_sd = sapply(predictor, function(p) {
          col_name <- paste0("b_", p)
          if (col_name %in% colnames(draws_matrix)) sd(draws_matrix[, col_name], na.rm = TRUE) else NA
        }),
        contribution_sd = abs(value) * coef_sd
      )
    
    contributions
  })

  #Create plot to show which variables contribute the most to the uncertainty
  output$waterfall_plot <- renderPlot({
    contributions <- get_contributions()
    if (is.null(contributions)) return(NULL)
    obs <- player_data()
    
    waterfall <- contributions %>%
      head(10) %>%
      mutate(predictor = factor(predictor, levels = rev(predictor)))
    
    ggplot(waterfall, aes(x = predictor, y = contribution, fill = direction)) +
      geom_col() +
      geom_hline(yintercept = 0, linewidth = 0.3) +
      coord_flip() +
      scale_fill_manual(values = c("increases xwOBA" = "#B2182B", "decreases xwOBA" = "#2166AC")) +
      labs(title = "What drives this prediction?",
           subtitle = paste("Predicted:", round(obs$pred_xwOBA, 3)),
           x = NULL, y = "Contribution to xwOBA", fill = NULL) +
      theme_minimal() +
      theme(legend.position = "bottom")
  })
  
  output$uncertainty_plot <- renderPlot({
    contributions <- get_contributions()
    if (is.null(contributions)) return(NULL)
    obs <- player_data()
    
    sigma_fe <- fixef(cape_model_pitching, dpar = "sigma")
    sigma_bf_cape <- sigma_fe["sigma_logBF_cape", "Estimate"]
    sigma_bf_col  <- sigma_fe["sigma_logBF_college", "Estimate"]
    
    log_sigma <- sigma_fe["sigma_Intercept", "Estimate"] +
      sigma_bf_cape * log(obs$BF_cape) +
      sigma_bf_col * log(obs$BF_college)
    obs_sigma <- exp(log_sigma)
    
    unc_data <- contributions %>%
      arrange(desc(contribution_sd)) %>%
      head(8) %>%
      bind_rows(data.frame(
        predictor = c("college sample size", "cape sample size"),
        contribution_sd = c(
          abs(sigma_bf_col) * abs(log(obs$BF_college) - median(log(college_26_results$BF_college), na.rm = TRUE)) * obs_sigma,
          abs(sigma_bf_cape) * abs(log(obs$BF_cape) - median(log(college_26_results$BF_cape), na.rm = TRUE)) * obs_sigma
        ),
        stringsAsFactors = FALSE
      )) %>%
      arrange(desc(contribution_sd)) %>%
      mutate(predictor = factor(predictor, levels = rev(predictor)))
    
    ggplot(unc_data, aes(x = predictor, y = contribution_sd)) +
      geom_col(fill = "#E8913A") +
      coord_flip() +
      labs(title = "Where does uncertainty come from?",
           subtitle = paste("College BF:", obs$BF_college, "| Sigma:", round(obs_sigma, 4)),
           x = NULL, y = "Contribution to uncertainty") +
      theme_minimal()
  })

  #Plot of the player's posteriior distribution (distribution of 95% credible interval of predicted values)
  output$posterior_dist_plot <- renderPlot({
    obs <- player_data()
    if (nrow(obs) == 0) return(NULL)
    
    post_draws <- fitted(cape_model_pitching, newdata = obs, 
                         allow_new_levels = TRUE, summary = FALSE)
    
    draws_df <- data.frame(xwOBA = as.numeric(post_draws))
    
    ggplot(draws_df, aes(x = xwOBA)) +
      geom_density(fill = "#2166AC", alpha = 0.4, color = "#2166AC") +
      geom_vline(xintercept = obs$pred_xwOBA, linewidth = 1, color = "#1B3A5C") +
      geom_vline(xintercept = obs$pred_lower, linetype = "dashed", color = "#888") +
      geom_vline(xintercept = obs$pred_upper, linetype = "dashed", color = "#888") +
      labs(title = "Predicted xwOBA distribution",
           subtitle = paste0("Median: ", round(obs$pred_xwOBA, 3),
                             "  |  95% CI: [", round(obs$pred_lower, 3), ", ", round(obs$pred_upper, 3), "]"),
           x = "xwOBA", y = NULL) +
      theme_minimal() +
      theme(axis.text.y = element_blank())
  })
  
  output$comparison_plot <- renderPlot({
    obs <- player_data()
    if (nrow(obs) == 0) return(NULL)
    
    ggplot(college_26_results, aes(x = pred_xwOBA)) +
      geom_histogram(fill = "#cccccc", color = "white", bins = 30) +
      geom_vline(xintercept = obs$pred_xwOBA, color = "#B2182B", linewidth = 1.2) +
      annotate("text", x = obs$pred_xwOBA, y = Inf, label = obs$Pitcher,
               vjust = 2, hjust = -0.1, color = "#B2182B", fontface = "bold", size = 4) +
      labs(title = "vs. all projected pitchers",
           x = "Predicted Cape xwOBA", y = "Count") +
      theme_minimal()
  })
}

shinyApp(ui, server)

	#Read in libraries (make sure these are installed in the Docker file)
	library(shiny)
	library(brms)
	library(tidyverse)
	library(DT)
	library(bayesplot)
	library(httr)
	library(arrow)
	library(base64enc)

	#Read in HH Logo
	logo_b64 <- base64enc::base64encode("HHLogo.png")
	logo_uri <- paste0("data:image/png;base64,", logo_b64)

	#Get passoword from app secrets
	HF_PASSWORD <- Sys.getenv('APP_PASSWORD')



	# ============================================================
	#Functions to read in private datasets and models
	# ============================================================
	download_private_parquet <- function(repo_id, filename, max_retries = 3) {
	url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
	api_key <- Sys.getenv("HF_PitSuccess_Dataset_Token")
	if (api_key == "") stop("API key is not set.")
	for (attempt in 1:max_retries) {
	tryCatch({
	response <- GET(url, add_headers(Authorization = paste("Bearer", api_key)), timeout(60))
	if (status_code(response) == 200) {
	tmp <- tempfile(fileext = ".parquet")
	writeBin(content(response, "raw"), tmp)
	return(read_parquet(tmp))
	} else warning(paste("Attempt", attempt, "failed with status:", status_code(response)))
	}, error = function(e) {
	warning(paste("Attempt", attempt, "failed:", e$message))
	if (attempt < max_retries) Sys.sleep(2)
	})
	}
	stop(paste("Failed to download dataset after", max_retries, "attempts"))
	}

	download_private_rds <- function(repo_id, filename, max_retries = 3) {
	url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
	api_key <- Sys.getenv("HF_PitSuccess_Dataset_Token")
	if (api_key == "") stop("API key is not set.")
	for (attempt in 1:max_retries) {
	tryCatch({
	response <- GET(url, add_headers(Authorization = paste("Bearer", api_key)), timeout(60))
	if (status_code(response) == 200) {
	tmp <- tempfile(fileext = ".rds")
	writeBin(content(response, "raw"), tmp)
	return(readRDS(tmp))
	} else warning(paste("Attempt", attempt, "failed:", e$message))
	}, error = function(e) {
	warning(paste("Attempt", attempt, "failed:", e$message))
	if (attempt < max_retries) Sys.sleep(2)
	})
	}
	stop(paste("Failed to download dataset after", max_retries, "attempts"))
	}

	#Read in the pitching model and the full dataframe with results
	cape_model_pitching <- download_private_rds("HyannisHarborHawksCCBL/PitcherSuccessDataset", "PitchingModel.rds")
	college_26_results <- download_private_parquet("HyannisHarborHawksCCBL/PitcherSuccessDataset", "college_26_results.parquet")


	# ============================================================
	#App UI
	# ============================================================
	ui <- fluidPage(

	tags$head(tags$style(HTML("
	body { font-family: 'Helvetica Neue', sans-serif; background: #f8f8f8; }
	.navbar { background: #1B3A5C; }
	.navbar-default .navbar-brand { color: white; font-weight: 600; }
	.navbar-default .navbar-nav > li > a { color: #ccc; }
	.navbar-default .navbar-nav > .active > a { background: #2a5a8c; color: white; }
	.card { background: white; border-radius: 8px; padding: 20px; margin-bottom: 15px;
	border: 1px solid #e0e0e0; }
	.metric-box { text-align: center; padding: 15px; }
	.metric-value { font-size: 28px; font-weight: 600; color: #1B3A5C; }
	.metric-label { font-size: 12px; color: #888; text-transform: uppercase; letter-spacing: 1px; }

	/* Login screen */
	#login_screen {
	position: fixed;
	top: 0; left: 0; right: 0; bottom: 0;
	z-index: 9999;
	display: flex;
	flex-direction: column;
	align-items: center;
	justify-content: center;
	background: linear-gradient(135deg, #0d1f33 0%, #1B3A5C 40%, #2a5a8c 100%);
	transition: opacity 0.8s ease, transform 0.8s ease;
	}
	#login_screen.fade-out {
	opacity: 0;
	transform: scale(1.02);
	pointer-events: none;
	}
	#login_screen .login-title {
	font-size: 36px;
	font-weight: 800;
	color: white;
	letter-spacing: 1px;
	margin-bottom: 8px;
	text-align: center;
	}
	#login_screen .login-subtitle {
	font-size: 14px;
	color: rgba(255,255,255,0.5);
	letter-spacing: 2px;
	text-transform: uppercase;
	margin-bottom: 36px;
	}
	#login_screen .login-box {
	background: rgba(255,255,255,0.06);
	border: 1px solid rgba(255,255,255,0.15);
	border-radius: 12px;
	padding: 32px 40px;
	backdrop-filter: blur(10px);
	width: 340px;
	text-align: center;
	}
	#login_screen .login-box input[type='password'] {
	width: 100%;
	padding: 12px 16px;
	border: 1px solid rgba(255,255,255,0.2);
	border-radius: 6px;
	background: rgba(255,255,255,0.08);
	color: white;
	font-size: 15px;
	margin-bottom: 16px;
	outline: none;
	text-align: center;
	letter-spacing: 2px;
	transition: border-color 0.3s;
	}
	#login_screen .login-box input[type='password']:focus {
	border-color: #4a9eff;
	}
	#login_screen .login-box input[type='password']::placeholder {
	color: rgba(255,255,255,0.3);
	letter-spacing: 1px;
	}
	#login_screen .login-btn {
	width: 100%;
	padding: 12px;
	border: none;
	border-radius: 6px;
	background: #2a5a8c;
	color: white;
	font-size: 14px;
	font-weight: 700;
	letter-spacing: 1px;
	text-transform: uppercase;
	cursor: pointer;
	transition: background 0.3s;
	}
	#login_screen .login-btn:hover { background: #3a7abc; }
	#login_screen .login-error {
	color: #ff6b6b;
	font-size: 13px;
	margin-top: 12px;
	min-height: 20px;
	}
	"))),

	# Login overlay
	tags$div(id = "login_screen",
	tags$img(class = "login-logo", src = logo_uri),
	tags$div(class = "login-title", "Cape Cod Pitching Projections"),
	tags$div(class = "login-subtitle", "Hyannis Harbor Hawks"),
	tags$div(class = "login-box",
	tags$input(id = "login_pw", type = "password", placeholder = "Enter password"),
	tags$button(id = "login_btn", class = "login-btn", "Enter"),
	tags$div(id = "login_error", class = "login-error")
	)
	),

	# Login JS
	tags$script(HTML(paste0("
	var APP_PASSWORD = '", HF_PASSWORD, "';
	function tryLogin() {
	var pw = document.getElementById('login_pw').value;
	if (pw === APP_PASSWORD) {
	document.getElementById('login_screen').classList.add('fade-out');
	setTimeout(function() {
	document.getElementById('login_screen').style.display = 'none';
	}, 800);
	} else {
	document.getElementById('login_error').textContent = 'Incorrect password';
	document.getElementById('login_pw').value = '';
	document.getElementById('login_pw').style.borderColor = '#ff6b6b';
	setTimeout(function() {
	document.getElementById('login_error').textContent = '';
	document.getElementById('login_pw').style.borderColor = 'rgba(255,255,255,0.2)';
	}, 2000);
	}
	}
	document.addEventListener('DOMContentLoaded', function() {
	document.getElementById('login_btn').addEventListener('click', tryLogin);
	document.getElementById('login_pw').addEventListener('keydown', function(e) {
	if (e.key === 'Enter') tryLogin();
	});
	});
	"))),

	navbarPage(
	title = "Cape Cod Pitching Projections",

	#Leaderboard tab -- Filterable table of all projected pitchers with summary metrics and sorting options
	tabPanel("Leaderboard",
	fluidRow(
	column(3,
	div(class = "card",
	selectInput("league_filter", "Conference:",
	choices = c("All", sort(unique(college_26_results$PitcherLeague_college))),
	selected = "All"),
	selectInput("throws_filter", "Throws:",
	choices = c("All", "Right", "Left"),
	selected = "All"),
	sliderInput("bf_filter", "Min College BF:",
	min = 0, max = 300, value = 30, step = 10),
	selectInput("sort_by", "Sort by:",
	choices = c("Predicted xwOBA" = "pred_xwOBA",
	"Uncertainty" = "pred_uncertainty",
	"College BF" = "BF_college"),
	selected = "pred_xwOBA"),
	checkboxInput("sort_asc", "Ascending", value = TRUE)
	)
	),
	column(9,
	div(class = "card",
	fluidRow(
	column(3, div(class = "metric-box",
	textOutput("n_pitchers_text") %>% tagAppendAttributes(class = "metric-value"),
	div(class = "metric-label", "Pitchers")
	)),
	column(3, div(class = "metric-box",
	textOutput("avg_pred_text") %>% tagAppendAttributes(class = "metric-value"),
	div(class = "metric-label", "Avg Predicted xwOBA")
	)),
	column(3, div(class = "metric-box",
	textOutput("best_pred_text") %>% tagAppendAttributes(class = "metric-value"),
	div(class = "metric-label", "Best Predicted")
	)),
	column(3, div(class = "metric-box",
	textOutput("avg_unc_text") %>% tagAppendAttributes(class = "metric-value"),
	div(class = "metric-label", "Avg Uncertainty")
	))
	)
	),
	div(class = "card",
	DTOutput("leaderboard_table")
	)
	)
	)
	),

	#Breakdown tab -- Individual pitcher deep dive with waterfall contributions, posterior distributions, and peer comparisons
	tabPanel("Player Breakdown",
	fluidRow(
	column(3,
	div(class = "card",
	selectizeInput("player_select", "Select Pitcher:",
	choices = sort(unique(college_26_results$Pitcher)),
	selected = NULL,
	options = list(placeholder = "Type a name...")),
	hr(),
	uiOutput("player_summary")
	)
	),
	column(9,
	fluidRow(
	column(6, div(class = "card", plotOutput("waterfall_plot", height = "450px"))),
	column(6, div(class = "card", plotOutput("uncertainty_plot", height = "450px")))
	),
	fluidRow(
	column(6, div(class = "card", plotOutput("posterior_dist_plot", height = "350px"))),
	column(6, div(class = "card", plotOutput("comparison_plot", height = "350px")))
	)
	)
	)
	)
	)
	)


	# ============================================================
	#App Server
	# ============================================================

	server <- function(input, output, session) {

	filtered_data <- reactive({
	df <- college_26_results


	#Filters to filter by college league, handedness, BF, and sorts
	if (input$league_filter != "All") {
	df <- df %>% filter(PitcherLeague_college == input$league_filter)
	}
	if (input$throws_filter != "All") {
	df <- df %>% filter(PitcherThrows_college == input$throws_filter)
	}
	df <- df %>% filter(BF_college >= input$bf_filter)

	if (input$sort_asc) {
	df <- df %>% arrange(.data[[input$sort_by]])
	} else {
	df <- df %>% arrange(desc(.data[[input$sort_by]]))
	}
	df
	})

	#Summary stats
	output$n_pitchers_text <- renderText(nrow(filtered_data()))
	output$avg_pred_text <- renderText(round(mean(filtered_data()$pred_xwOBA, na.rm = TRUE), 3))
	output$best_pred_text <- renderText(round(min(filtered_data()$pred_xwOBA, na.rm = TRUE), 3))
	output$avg_unc_text <- renderText(round(mean(filtered_data()$pred_uncertainty, na.rm = TRUE), 3))

	#Returns leaderboard table
	output$leaderboard_table <- renderDT({
	filtered_data() %>%
	mutate(rank = row_number()) %>%
	select(rank, Pitcher, PitcherThrows_college, PitcherLeague_college,
	BF_college, pred_xwOBA, pred_lower, pred_upper, pred_uncertainty) %>%
	mutate(across(where(is.numeric) & !c(rank, BF_college), ~round(.x, 3))) %>%
	datatable(
	colnames = c("Rank", "Pitcher", "Throws", "Conference", "College BF",
	"Pred xwOBA", "Lower", "Upper", "Uncertainty"),
	selection = "single",
	options = list(pageLength = 25, scrollX = TRUE),
	rownames = FALSE
	)
	})

	#Player selection
	observeEvent(input$leaderboard_table_rows_selected, {
	row <- filtered_data()[input$leaderboard_table_rows_selected, ]
	updateSelectizeInput(session, "player_select", selected = row$Pitcher)
	})

	#Reactive filter: returns the selected pitcher's row from the results table
	player_data <- reactive({
	req(input$player_select)
	college_26_results %>% filter(Pitcher == input$player_select)
	})

	output$player_summary <- renderUI({
	obs <- player_data()
	if (nrow(obs) == 0) return(NULL)

	#Compute observation-level sigma from the distributional submodel fixed effects (get player uncertainty)
	sigma_fe <- fixef(cape_model_pitching, dpar = "sigma")

	log_sigma <- sigma_fe["sigma_Intercept", "Estimate"] +
	sigma_fe["sigma_logBF_cape", "Estimate"] * log(obs$BF_cape) +
	sigma_fe["sigma_logBF_college", "Estimate"] * log(obs$BF_college)
	obs_sigma <- exp(log_sigma)

	#Render the player summary card with prediction, interval, and pitcher info
	tagList(
	h4(obs$Pitcher),
	tags$table(style = "width: 100%; font-size: 14px;",
	tags$tr(tags$td("Predicted xwOBA"), tags$td(style = "text-align: right; font-weight: 600;", round(obs$pred_xwOBA, 3))),
	tags$tr(tags$td("95% Interval"), tags$td(style = "text-align: right;",
	paste0("[", round(obs$pred_lower, 3), ", ", round(obs$pred_upper, 3), "]"))),
	tags$tr(tags$td("Uncertainty"), tags$td(style = "text-align: right;", round(obs$pred_uncertainty, 3))),
	tags$tr(tags$td(style = "padding-top: 10px;", "College BF"), tags$td(style = "text-align: right; padding-top: 10px;", obs$BF_college)),
	tags$tr(tags$td("Throws"), tags$td(style = "text-align: right;", as.character(obs$PitcherThrows_college))),
	tags$tr(tags$td("Conference"), tags$td(style = "text-align: right;", as.character(obs$PitcherLeague_college))),
	tags$tr(tags$td(style = "padding-top: 10px;", "Obs Sigma"), tags$td(style = "text-align: right; padding-top: 10px;", round(obs_sigma, 4)))
	)
	)
	})

	#Predict cape success
	get_contributions <- reactive({
	obs <- player_data()
	if (nrow(obs) == 0) return(NULL)

	fe <- fixef(cape_model_pitching)
	coefs <- fe[, "Estimate"]

	pred_cols <- c("zone_pct_college", "k_minus_bb_college", "csw_plus_college",
	"stuff_plus_primary_college", "stuff_plus_secondary_college",
	"stuff_plus_tertiary_college", "arsenal_depth_college",
	"chase_pct_college", "iz_whiff_pct_college",
	"mean_ev_college", "ev_90_college", "ev_sd_college",
	"gb_pct_college", "xwOBA_R_minus_L_college")

	contributions <- data.frame(
	predictor = pred_cols,
	value = as.numeric(obs[1, pred_cols]),
	coefficient = as.numeric(coefs[pred_cols]),
	stringsAsFactors = FALSE
	) %>%
	bind_rows(data.frame(
	predictor = "logBF_college",
	value = log(obs$BF_college),
	coefficient = as.numeric(coefs["logBF_college"]),
	stringsAsFactors = FALSE
	)) %>%
	mutate(
	contribution = value * coefficient,
	direction = ifelse(contribution > 0, "increases xwOBA", "decreases xwOBA")
	) %>%
	arrange(desc(abs(contribution)))

	draws_matrix <- as.matrix(as_draws_df(cape_model_pitching))
	contributions <- contributions %>%
	mutate(
	coef_sd = sapply(predictor, function(p) {
	col_name <- paste0("b_", p)
	if (col_name %in% colnames(draws_matrix)) sd(draws_matrix[, col_name], na.rm = TRUE) else NA
	}),
	contribution_sd = abs(value) * coef_sd
	)

	contributions
	})

	#Create plot to show which variables contribute the most to the uncertainty
	output$waterfall_plot <- renderPlot({
	contributions <- get_contributions()
	if (is.null(contributions)) return(NULL)
	obs <- player_data()

	waterfall <- contributions %>%
	head(10) %>%
	mutate(predictor = factor(predictor, levels = rev(predictor)))

	ggplot(waterfall, aes(x = predictor, y = contribution, fill = direction)) +
	geom_col() +
	geom_hline(yintercept = 0, linewidth = 0.3) +
	coord_flip() +
	scale_fill_manual(values = c("increases xwOBA" = "#B2182B", "decreases xwOBA" = "#2166AC")) +
	labs(title = "What drives this prediction?",
	subtitle = paste("Predicted:", round(obs$pred_xwOBA, 3)),
	x = NULL, y = "Contribution to xwOBA", fill = NULL) +
	theme_minimal() +
	theme(legend.position = "bottom")
	})

	output$uncertainty_plot <- renderPlot({
	contributions <- get_contributions()
	if (is.null(contributions)) return(NULL)
	obs <- player_data()

	sigma_fe <- fixef(cape_model_pitching, dpar = "sigma")
	sigma_bf_cape <- sigma_fe["sigma_logBF_cape", "Estimate"]
	sigma_bf_col <- sigma_fe["sigma_logBF_college", "Estimate"]

	log_sigma <- sigma_fe["sigma_Intercept", "Estimate"] +
	sigma_bf_cape * log(obs$BF_cape) +
	sigma_bf_col * log(obs$BF_college)
	obs_sigma <- exp(log_sigma)

	unc_data <- contributions %>%
	arrange(desc(contribution_sd)) %>%
	head(8) %>%
	bind_rows(data.frame(
	predictor = c("college sample size", "cape sample size"),
	contribution_sd = c(
	abs(sigma_bf_col) * abs(log(obs$BF_college) - median(log(college_26_results$BF_college), na.rm = TRUE)) * obs_sigma,
	abs(sigma_bf_cape) * abs(log(obs$BF_cape) - median(log(college_26_results$BF_cape), na.rm = TRUE)) * obs_sigma
	),
	stringsAsFactors = FALSE
	)) %>%
	arrange(desc(contribution_sd)) %>%
	mutate(predictor = factor(predictor, levels = rev(predictor)))

	ggplot(unc_data, aes(x = predictor, y = contribution_sd)) +
	geom_col(fill = "#E8913A") +
	coord_flip() +
	labs(title = "Where does uncertainty come from?",
	subtitle = paste("College BF:", obs$BF_college, "\| Sigma:", round(obs_sigma, 4)),
	x = NULL, y = "Contribution to uncertainty") +
	theme_minimal()
	})

	#Plot of the player's posteriior distribution (distribution of 95% credible interval of predicted values)
	output$posterior_dist_plot <- renderPlot({
	obs <- player_data()
	if (nrow(obs) == 0) return(NULL)

	post_draws <- fitted(cape_model_pitching, newdata = obs,
	allow_new_levels = TRUE, summary = FALSE)

	draws_df <- data.frame(xwOBA = as.numeric(post_draws))

	ggplot(draws_df, aes(x = xwOBA)) +
	geom_density(fill = "#2166AC", alpha = 0.4, color = "#2166AC") +
	geom_vline(xintercept = obs$pred_xwOBA, linewidth = 1, color = "#1B3A5C") +
	geom_vline(xintercept = obs$pred_lower, linetype = "dashed", color = "#888") +
	geom_vline(xintercept = obs$pred_upper, linetype = "dashed", color = "#888") +
	labs(title = "Predicted xwOBA distribution",
	subtitle = paste0("Median: ", round(obs$pred_xwOBA, 3),
	" \| 95% CI: [", round(obs$pred_lower, 3), ", ", round(obs$pred_upper, 3), "]"),
	x = "xwOBA", y = NULL) +
	theme_minimal() +
	theme(axis.text.y = element_blank())
	})

	output$comparison_plot <- renderPlot({
	obs <- player_data()
	if (nrow(obs) == 0) return(NULL)

	ggplot(college_26_results, aes(x = pred_xwOBA)) +
	geom_histogram(fill = "#cccccc", color = "white", bins = 30) +
	geom_vline(xintercept = obs$pred_xwOBA, color = "#B2182B", linewidth = 1.2) +
	annotate("text", x = obs$pred_xwOBA, y = Inf, label = obs$Pitcher,
	vjust = 2, hjust = -0.1, color = "#B2182B", fontface = "bold", size = 4) +
	labs(title = "vs. all projected pitchers",
	x = "Predicted Cape xwOBA", y = "Count") +
	theme_minimal()
	})
	}

	shinyApp(ui, server)