Spaces:

HyannisHarborHawks2
/

DataScrapeAndClean

Sleeping

Update app.R
ecf02aa verified 4 months ago
70.9 kB
#IF THIS APP IS TO BE USED IN SEASONS BEYOND 2026, CODE NEEDS TO BE CHANGED TO REFLECT THE CURRENT YEAR OF USE 

library(arrow)
library(httr)
library(jsonlite)
library(readr)
library(DT)
library(recipes)
library(xgboost)
library(stringr)
library(bundle)
library(tidymodels)
library(base64enc)
library(tidyr)
library(dplyr)  
library(shiny)
library(bslib)
library(glue)
library(ggplot2)
library(gt)
library(gtExtras)
library(purrr)
library(scales)
library(knitr)
library(htmltools)
library(patchwork)


#reticulate is a package that is used to code python in R environments
library(reticulate)
use_python("/usr/bin/python3", required = TRUE)

`%||%` <- function(a, b) if (!is.null(a)) a else b

# ============================================================
# Config / secrets
# ============================================================
# Space secrets required: all these can be found in the settings, but you cannot see the actual values. To see the actual values, go to the 
  #password document under the Harbor Hawks OPS google account. 

#Allows the app to read models and data from the CleanDataObjects private dataset on the HyannisHarborHawksCCBL HF
HF_READ_TOKEN <- Sys.getenv("READ_CLEANDATAOBJ_TOKEN")

#Allows the app to read models and data from the PastSeasonData private dataset on the HyannisHarborHawksCCBL HF
HF_READ_TOKEN_PASTSEASONDATA <- Sys.getenv("READ_PASTSEASONDATA_TOKEN")

#Allows the app to poll GitHub to scrape (read and write access token)
gh_token <- Sys.getenv("GITHUB_TOKEN")

#Name of GitHub repository
gh_repo <- "HyannisHarborHawks/HyannisAnalytics"

#Allows HF to write new data to the PastSeasonData private dataset on the HyannisHarborHawksCCBL HF
HF_WRITE_TOKEN  <- Sys.getenv("WRITE_PASTSEASONDATA_TOKEN")

#Name of the HF repo that the app will be writing to
HF_REPO_ID <- "HyannisHarborHawksCCBL/PastSeasonData"

#App password
PASSWORD   <- Sys.getenv("APP_PASSWORD")

# pbp / pos -> HF folder + UID index (both live under 2026_cape/)
hf_target_for <- function(source) {
  switch(source,
    "pbp" = list(folder = "2026_cape/pbp", index = "2026_cape/pbp_uid_index.csv.gz", label = "2026 Cape PBP"),
    "pos" = list(folder = "2026_cape/pos", index = "2026_cape/pos_uid_index.csv.gz", label = "2026 Cape POS")
  )
}

# ============================================================
# READ IN PRIVATE DATASETS AND MODELS FOR CLEANING -- All in a private dataset on the main (HyannisHarborHawksCCBL) Huggingface
# ============================================================

download_private_parquet <- function(repo_id, filename, max_retries = 3) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  api_key <- HF_READ_TOKEN_PASTSEASONDATA
  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_csv <- function(repo_id, filename, max_retries = 3) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  api_key <- HF_READ_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 = ".csv")
        writeBin(content(response, "raw"), tmp)
        return(readr::read_csv(tmp, show_col_types = FALSE))
      } 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_xgb <- function(repo_id, filename, max_retries = 3) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  api_key <- HF_READ_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 = ".json")
        writeBin(content(response, "raw"), tmp)
        return(xgb.load(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 <- HF_READ_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"))
}

#Stuff Model (XGBoost)
stuffplus_recipe <- download_private_rds("HyannisHarborHawksCCBL/CleanDataObjects", "stuffplus_recipe.rds")
stuffplus_model  <- download_private_xgb("HyannisHarborHawksCCBL/CleanDataObjects", "stuffplus_xgb.json")

#xwOBA model (KNN)
xwoba_model <- unbundle(download_private_rds("HyannisHarborHawksCCBL/CleanDataObjects", "bundle_college_xwoba_knn.rds"))

#Pitch Retag Model (XGBoost)
retag_model <- unbundle(download_private_rds("HyannisHarborHawksCCBL/CleanDataObjects", "pitch_tag_model.rds"))

#Data to join on (non-context run values, conferences, GUTS!, longer team names)
rv <- download_private_csv("HyannisHarborHawksCCBL/CleanDataObjects", "non_context_run_values.csv")
team_leagues <- download_private_csv("HyannisHarborHawksCCBL/CleanDataObjects", "college_team_leagues.csv")
college_guts <- download_private_csv("HyannisHarborHawksCCBL/CleanDataObjects", "college_GUTS.csv")
college_join <- download_private_csv("HyannisHarborHawksCCBL/CleanDataObjects", "college_join.csv")

#Reference arsenal data (only pitches thrown over 5% for retagging)
pitcher_arsenals_over_5perc <- download_private_csv("HyannisHarborHawksCCBL/CleanDataObjects", "pitcher_arsenals_over_5perc.csv")

#Team logo
logo_b64 <- base64enc::base64encode("HHLogo.png")
logo_uri <- paste0("data:image/png;base64,", logo_b64)

#College 26 data
REFERENCE_DATA <- download_private_parquet("HyannisHarborHawksCCBL/PastSeasonData", "college_26_clean.parquet")


# =====================================================================
# Harbor Hawks — Pitcher Outing Report: component builders
# gt tables (HTML) + ggplot plots (PNG) -> one full-width letter-portrait HTML string.
# Sourced by app.R. Assumes packages are already loaded there.
# =====================================================================

# ---- Style constants -------------------------------------------------
NAVY   <- "#002855"
ORANGE <- "#F25B00"
BLUE   <- "#164EA7"
GRAY   <- "black"

# Owen's standard pitch colors (covers TrackMan tag variants)
pitch_colors <- c(
  "Fastball" = "red", "FourSeamFastBall" = "red", "Four-Seam" = "red",
  "Sinker" = "orange", "TwoSeamFastBall" = "orange",
  "Cutter" = "brown",
  "Slider" = "gold",
  "Sweeper" = "maroon2",
  "Curveball" = "blue",
  "Changeup" = "green4", "ChangeUp" = "green4",
  "Splitter" = "lightblue",
  "Knuckleball" = "#6A89A7"
)

pcol <- function(x) { out <- pitch_colors[as.character(x)]; out[is.na(out)] <- "#8A8D91"; unname(out) }

text_for <- function(hex) {
  v <- grDevices::col2rgb(hex)
  lum <- (0.299 * v[1] + 0.587 * v[2] + 0.114 * v[3]) / 255
  if (lum < 0.5) "white" else NAVY
}

make_color_fn <- function(min_val, max_val, low = "#3661ad", mid = "white", high = "#d82029") {
  if (is.na(min_val) || is.na(max_val) || min_val == max_val) return(function(x) "white")
  g <- scales::col_numeric(c(low, mid, high), domain = c(min_val, max_val), na.color = "white")
  function(x) ifelse(is.na(x), "white", g(pmin(pmax(x, min_val), max_val)))
}
make_color_fn_reverse <- function(min_val, max_val) make_color_fn(min_val, max_val, "#d82029", "white", "#3661ad")

# ---- Raw-column feature derivation (works without cleaned data) ------
derive_outing <- function(d, pitch_col = "TaggedPitchType") {
  z_half <- 9.975; z_lo <- 18; z_hi <- 42
  d %>%
    mutate(
      pitch_type = .data[[pitch_col]],
      .swing  = PitchCall %in% c("StrikeSwinging", "InPlay") | grepl("Foul", PitchCall),
      .whiff  = PitchCall == "StrikeSwinging",
      .csw    = PitchCall %in% c("StrikeSwinging", "StrikeCalled"),
      .strike = PitchCall %in% c("StrikeCalled", "StrikeSwinging", "InPlay") | grepl("Foul", PitchCall),
      .inzone = abs(PlateLocSide) <= z_half & PlateLocHeight >= z_lo & PlateLocHeight <= z_hi,
      .chase  = .swing & !.inzone,
      .bip    = PitchCall == "InPlay",
      .hit    = PlayResult %in% c("Single", "Double", "Triple", "HomeRun", "Homerun")
    )
}

color_group_cells <- function(gt_tbl, group_col = "GROUP") {
  for (pt in names(pitch_colors)) {
    fill <- unname(pitch_colors[pt])
    gt_tbl <- gt_tbl %>%
      gt::tab_style(
        style = list(gt::cell_fill(color = fill),
                     gt::cell_text(color = text_for(fill), weight = "bold")),
        locations = gt::cells_body(columns = gt::all_of(group_col),
                                   rows = .data[[group_col]] == pt))
  }
  gt_tbl
}

hawks_gt_base <- function(gt_tbl, title) {
  gt_tbl %>%
    gtExtras::gt_theme_espn() %>%
    gt::tab_header(title = title) %>%
    gt::tab_options(heading.align = "center", table.font.size = gt::px(11),
                    data_row.padding = gt::px(4), table.width = gt::pct(100)) %>%
    gt::sub_missing(missing_text = "\u2014") %>%
    gt::tab_style(gt::cell_text(color = NAVY), gt::cells_body()) %>%
    gt::tab_style(gt::cell_text(color = NAVY, weight = "bold"), gt::cells_column_labels()) %>%
    gt::tab_style(gt::cell_text(color = BLUE, size = gt::px(18), weight = "bold"),
                  gt::cells_title("title")) %>%
    gt::tab_style(gt::cell_borders(sides = c("top", "bottom", "left", "right"),
                                   color = NAVY, weight = gt::px(0.5)), gt::cells_body())
}

# =====================================================================
# Season reference (mean + sd per pitch type) for vs-season arrows
# =====================================================================
build_season_ref <- function(data, pitcher, pitch_col = "TaggedPitchType", min_pitches = 15) {
  out <- data %>%
    filter(Pitcher == pitcher) %>%
    mutate(pitch_type = .data[[pitch_col]]) %>%
    group_by(pitch_type) %>%
    summarise(
      season_n = n(),
      VELO = mean(RelSpeed, na.rm = TRUE),         VELO_sd = sd(RelSpeed, na.rm = TRUE),
      SPIN = mean(SpinRate, na.rm = TRUE),         SPIN_sd = sd(SpinRate, na.rm = TRUE),
      IVB  = mean(InducedVertBreak, na.rm = TRUE), IVB_sd  = sd(InducedVertBreak, na.rm = TRUE),
      HB   = mean(HorzBreak, na.rm = TRUE),        HB_sd   = sd(HorzBreak, na.rm = TRUE),
      EXT  = mean(Extension, na.rm = TRUE),        EXT_sd  = sd(Extension, na.rm = TRUE),
      RELH = mean(RelHeight, na.rm = TRUE),        RELH_sd = sd(RelHeight, na.rm = TRUE),
      RELS = mean(RelSide, na.rm = TRUE),          RELS_sd = sd(RelSide, na.rm = TRUE),
      .groups = "drop") %>%
    filter(season_n >= min_pitches) %>%
    select(-season_n)
  if (nrow(out) == 0) NULL else out
}

# =====================================================================
# TABLE 1 — Pitch shapes vs season (gt). Now includes STUFF+.
# =====================================================================
shape_table_gt <- function(outing, season_ref = NULL, pitch_col = "TaggedPitchType", k = 1) {
  metrics <- c("VELO", "SPIN", "IVB", "HB", "EXT", "RELH", "RELS")
  digits  <- c(VELO = 1, MAX = 1, SPIN = 0, IVB = 1, HB = 1, EXT = 1, RELH = 1, RELS = 1)
  has_stuff <- "stuff_plus" %in% names(outing)
  
  summ <- outing %>%
    mutate(pitch_type = .data[[pitch_col]]) %>%
    filter(pitch_type != "Other") %>%
    group_by(pitch_type) %>%
    summarise(
      n_temp = n(),
      `USAGE%` = round(100 * n() / nrow(outing), 1), `#` = n(),
      VELO = mean(RelSpeed, na.rm = TRUE), MAX = max(RelSpeed, na.rm = TRUE),
      SPIN = mean(SpinRate, na.rm = TRUE),
      IVB = mean(InducedVertBreak, na.rm = TRUE), HB = mean(HorzBreak, na.rm = TRUE),
      EXT = mean(Extension, na.rm = TRUE),
      RELH = mean(RelHeight, na.rm = TRUE), RELS = mean(RelSide, na.rm = TRUE),
      `STUFF+` = if (has_stuff) round(mean(stuff_plus, na.rm = TRUE)) else NA_real_,
      .groups = "drop") %>%
    arrange(desc(n_temp)) %>% select(-n_temp)
  
  have_ref <- !is.null(season_ref)
  if (have_ref)
    summ <- summ %>% left_join(season_ref, by = "pitch_type", suffix = c("", "_ref"))
  
  arrow_html <- function(delta, thr, dg) {
    if (is.na(delta) || is.na(thr) || abs(delta) <= thr) return("")
    col <- if (delta > 0) "#C8102E" else "#164EA7"
    sym <- if (delta > 0) "\u25B2" else "\u25BC"
    sprintf(" <span style='color:%s;font-size:9px;font-weight:700;'>%s%s</span>",
            col, sym, formatC(abs(delta), format = "f", digits = max(dg, 1)))
  }
  
  disp <- tibble(GROUP = summ$pitch_type, `USAGE%` = summ$`USAGE%`, `#` = summ$`#`)
  cell <- function(m, i) {
    val <- summ[[m]][i]; dg <- digits[[m]]
    base <- sprintf(paste0("%.", dg, "f"), val)
    if (have_ref && m %in% metrics) {
      ref <- summ[[paste0(m, "_ref")]][i]; sdv <- summ[[paste0(m, "_sd")]][i]
      thr <- if (is.na(sdv)) NA_real_ else k * sdv
      paste0(base, arrow_html(val - ref, thr, dg))
    } else base
  }
  nr <- nrow(summ)
  for (m in c("VELO", "MAX", "SPIN", "IVB", "HB", "EXT", "RELH", "RELS"))
    disp[[m]] <- vapply(seq_len(nr), function(i) cell(m, i), character(1))
  if (has_stuff) disp[["STUFF+"]] <- summ[["STUFF+"]]
  
  ttl <- if (have_ref) sprintf("Pitch Shapes \u2014 vs Season", k) else "Pitch Shapes"
  gt_tbl <- disp %>%
    gt::gt() %>%
    hawks_gt_base(title = ttl) %>%
    gt::fmt_markdown(columns = c("VELO", "MAX", "SPIN", "IVB", "HB", "EXT", "RELH", "RELS")) %>%
    gt::cols_label(GROUP = "PITCH", MAX = "MAX V", RELH = "REL H", RELS = "REL S") %>%
    gt::tab_style(gt::cell_borders(sides = "right", color = ORANGE, weight = gt::px(1.2)),
                  gt::cells_body(columns = c(GROUP, `#`)))
  if (has_stuff)
    gt_tbl <- gt_tbl %>% gt::data_color(columns = `STUFF+`, fn = make_color_fn(80, 120))
  color_group_cells(gt_tbl, "GROUP")
}

# =====================================================================
# TABLE 2 — Results (gt, heat-mapped). STUFF+ moved to the shape table.
# =====================================================================
results_table_gt <- function(outing, pitch_col = "TaggedPitchType") {
  d <- derive_outing(outing, pitch_col) %>% filter(pitch_type != "Other")
#  has_xw <- "xwOBA" %in% names(d)
  
  agg <- d %>%
    group_by(pitch_type) %>%
    summarise(
      n_temp = n(), `#` = n(),
      `WHIFF%` = round(100 * sum(.whiff, na.rm = TRUE) / pmax(sum(.swing, na.rm = TRUE), 1), 1),
      `CSW%`   = round(100 * mean(.csw, na.rm = TRUE), 1),
      `CHASE%` = round(100 * sum(.chase, na.rm = TRUE) / pmax(sum(!.inzone, na.rm = TRUE), 1), 1),
      `ZONE%`  = round(100 * mean(.inzone, na.rm = TRUE), 1),
      EV       = round(mean(ExitSpeed, na.rm = TRUE), 1),
#      xwOBA    = if (has_xw) round(mean(xwOBA, na.rm = TRUE), 3) else NA_real_,
      .groups = "drop") %>%
    arrange(desc(n_temp)) %>% select(-n_temp) %>%
    rename(GROUP = pitch_type)
  
#  if (!has_xw) agg <- agg %>% select(-xwOBA)
  
  gt_tbl <- agg %>%
    gt::gt() %>%
    hawks_gt_base(title = "Results") %>%
    gt::cols_label(GROUP = "PITCH") %>%
    gt::fmt_number(columns = c("WHIFF%", "CSW%", "CHASE%", "ZONE%", "EV"), decimals = 1) %>%
    gt::data_color(columns = `WHIFF%`, fn = make_color_fn(15, 40)) %>%
    gt::data_color(columns = `CSW%`,   fn = make_color_fn(20, 40)) %>%
    gt::data_color(columns = `CHASE%`, fn = make_color_fn(20, 45)) %>%
    gt::data_color(columns = `ZONE%`,  fn = make_color_fn(30, 60)) %>%
    gt::data_color(columns = EV,       fn = make_color_fn_reverse(75, 95)) %>%
    gt::tab_style(gt::cell_borders(sides = "right", color = ORANGE, weight = gt::px(1.2)),
                  gt::cells_body(columns = c(GROUP, `#`)))
#  if (has_xw)
#    gt_tbl <- gt_tbl %>% gt::fmt_number(columns = xwOBA, decimals = 3) %>%
#    gt::data_color(columns = xwOBA, fn = make_color_fn_reverse(.250, .450))
#  color_group_cells(gt_tbl, "GROUP")
}



#Pitch Usage Table
sequencing_table <- function(data, pitcher, pitch_col = "TaggedPitchType") {
  navy <- "#002855"; orange <- "#F25B00"
  
  tryCatch({
    d <- data %>% filter(Pitcher == pitcher) %>% mutate(pitch_type = .data[[pitch_col]])
    keep <- d %>% count(pitch_type) %>% pull(pitch_type)
    d <- d %>% filter(pitch_type %in% keep)
    
    situations <- list(
      "First Pitch" = quote(Balls == 0 & Strikes == 0),
      "Even"        = quote(Balls == Strikes & Strikes > 0),
      "2 Strikes"   = quote(Strikes == 2),
      "Behind"      = quote(Balls > Strikes & !(Balls == 3 & Strikes == 2)),
      "Full"        = quote(Balls == 3 & Strikes == 2)
    )
    
    per_sit <- imap(situations, function(cond, label) {
      sub <- d %>% filter(!!cond)
      list(n = nrow(sub),
           usage = sub %>% count(pitch_type, name = "k") %>%
             mutate(usage = if (nrow(sub) > 0) k / nrow(sub) else 0))
    })
    n_lookup   <- tibble(situation = names(per_sit), n_sit = map_int(per_sit, "n"))
    usage_long <- imap_dfr(per_sit, ~ .x$usage %>% transmute(pitch_type, situation = .y, usage))
    
    order_levels <- d %>% count(pitch_type, sort = TRUE) %>% pull(pitch_type)
    wide <- usage_long %>% pivot_wider(names_from = situation, values_from = usage, values_fill = 0)
    for (s in names(situations)) if (!s %in% names(wide)) wide[[s]] <- 0
    wide <- wide %>%
      mutate(pitch_type = factor(pitch_type, levels = order_levels)) %>%
      arrange(pitch_type) %>%
      select(pitch_type, all_of(names(situations)))
    
    maxv <- max(as.matrix(wide[, names(situations)]), na.rm = TRUE)
    labs <- setNames(lapply(names(situations), function(s) {
      gt::html(sprintf("%s<br><span style='font-weight:400;font-size:9px;color:#9bb;'>%d P</span>",
                       s, n_lookup$n_sit[n_lookup$situation == s]))
    }), names(situations))
    
    wide %>%
      gt(rowname_col = "pitch_type") %>%
      gt_theme_espn() %>%
      tab_header(title = "Pitch Usage by Count") %>%
      fmt_percent(columns = all_of(names(situations)), decimals = 0) %>%
      cols_label(.list = labs) %>%
      cols_align("center", columns = all_of(names(situations))) %>%
      data_color(columns = all_of(names(situations)),
                 palette = c("white", orange), domain = c(0, maxv)) %>%
      tab_style(list(cell_fill(navy), cell_text(color = "white", weight = "bold")),
                cells_column_labels()) %>%
      tab_style(cell_text(color = navy, weight = "bold"), cells_stub()) %>%
      tab_style(cell_text(color = navy, weight = "bold"), cells_title("title")) %>%
      tab_options(
        table.width             = px(225),
        table.font.size         = px(10),
        column_labels.font.size = px(10),
        heading.title.font.size = px(14),
        data_row.padding        = px(3)
      )
  },
  error = function(e) {
    gt(tibble(` ` = "Bullpen \u2014 no sequencing")) %>%
      gt_theme_espn() %>%
      tab_options(column_labels.hidden = TRUE,
                  table.width = px(225), table.font.size = px(12)) %>%
      cols_align("center") %>%
      tab_style(cell_text(color = navy, weight = "bold"), cells_body())
  })
}

# =====================================================================
# Shared ggplot theme
# =====================================================================
theme_report <- function(base = 10) {
  theme_minimal() + 
  theme(
    legend.position = "bottom",
    plot.title = element_text(hjust = .5, size = 20),
    legend.title = element_blank(),
    panel.grid.minor = element_blank(),
    axis.title = element_text(size = 13),
    axis.text = element_text(size = 6)
  )
}

# ---- Release points (fixed batter's-eye window) ----------------------
release_plot <- function(outing, pitch_col = "TaggedPitchType") {
  d <- outing %>% mutate(pitch_type = .data[[pitch_col]]) %>% filter(pitch_type != "Other")
  m <- d %>% group_by(pitch_type) %>%
    summarise(RelSide = mean(RelSide, na.rm = TRUE), RelHeight = mean(RelHeight, na.rm = TRUE), .groups = "drop")
  ggplot(d, aes(RelSide, RelHeight, color = pitch_type)) +
    geom_point(alpha = 0.55, size = 1.6) +
    geom_point(data = m, aes(fill = pitch_type), shape = 21, size = 3.4,
                        color = "white", stroke = 1, show.legend = FALSE) +
    scale_color_manual(values = pitch_colors, name = NULL) +
    scale_fill_manual(values = pitch_colors, guide = "none") +
    coord_fixed(xlim = c(-4.5, 4.5), ylim = c(0, 7.5), expand = FALSE) +
    labs(title = "Release Points", x = "Release Side (ft)", y = "Release Height (ft)") +
    theme_report() + 
    theme(
      legend.position = "none"
    )
}

# ---- Movement (points only) -----------------------------------------
movement_plot <- function(outing, season_ref = NULL, pitch_col = "TaggedPitchType") {
  d <- outing %>% mutate(pitch_type = .data[[pitch_col]]) %>% filter(pitch_type != "Other")
  
  ggplot(d, aes(HorzBreak, InducedVertBreak, color = pitch_type)) +
    geom_vline(xintercept = 0, linewidth = 1, linetype = "dotted", color = "black") +
    geom_hline(yintercept = 0, linewidth = 1, linetype = "dotted", color = "black") +
    geom_point(size = 2, alpha = 0.85) +
    scale_color_manual(values = pitch_colors, name = NULL) +
    coord_fixed(xlim = c(-28, 28), ylim = c(-28, 28)) +
    labs(title = "Movement", x = "HB", y = "IVB") +
    theme_report() + 
    theme(
      legend.position = "none"
    )
  
}


# ---- Location grid (pitcher's view: plate point UP; outcome by shape)-
#      Color legend removed; facet labels already carry the pitch type.
location_grid <- function(outing, pitch_col = "TaggedPitchType", n_pitches = 3) {
  zb <- list(xmin = -8.5, xmax = 8.5, ymin = 18, ymax = 42)
  plate <- tibble(x = c(-8.5, 8.5, 8.5, 0, -8.5), y = c(8, 8, 11, 14, 11))  # point up
  
  d <- derive_outing(outing, pitch_col) %>%
    filter(!is.na(PlateLocSide), !is.na(PlateLocHeight), pitch_type != "Other")
  
  # top N pitches by count, shared across both batter sides so columns align
  top <- d %>% count(pitch_type) %>% slice_max(n, n = n_pitches, with_ties = FALSE) %>% pull(pitch_type)
  d <- d %>%
    filter(pitch_type %in% top) %>%
    mutate(pitch_type = factor(pitch_type, levels = top),
           outcome = dplyr::case_when(.whiff ~ "Whiff", .bip ~ "In play", TRUE ~ "Other"),
           outcome = factor(outcome, levels = c("Other", "Whiff", "In play")))
  
  panel <- function(df, title) {
    if (nrow(df) == 0)
      return(ggplot() +
               annotate("text", x = 0, y = 30, label = "No pitches",
                        color = "grey60", size = 3) +
               coord_fixed(xlim = c(-14, 14), ylim = c(4, 50), expand = FALSE) +
               labs(title = title, x = NULL, y = NULL) +
               theme_void() +
               theme(plot.title = element_text(face = "bold", color = NAVY,
                                               size = 10, hjust = 0.5)))
    
    ggplot(df, aes(PlateLocSide, PlateLocHeight)) +
      annotate("rect", xmin = zb$xmin, xmax = zb$xmax, ymin = zb$ymin, ymax = zb$ymax,
                        fill = NA, color = "grey35", linewidth = 0.5) +
      annotate("segment", x = c(-2.84, 2.84), xend = c(-2.84, 2.84),
                        y = zb$ymin, yend = zb$ymax, color = "grey82", linewidth = 0.3) +
      annotate("segment", x = zb$xmin, xend = zb$xmax,
                        y = c(26, 34), yend = c(26, 34), color = "grey82", linewidth = 0.3) +
      geom_polygon(data = plate, aes(x, y), inherit.aes = FALSE,
                            fill = "grey88", color = "grey55", linewidth = 0.35) +
      geom_point(aes(color = pitch_type, shape = outcome), size = 1.5, stroke = 0.8) +
      scale_color_manual(values = pitch_colors, guide = "none", drop = FALSE) +
      scale_shape_manual(values = c("Other" = 16, "Whiff" = 4, "In play" = 17),
                                  name = NULL, drop = FALSE) +
      coord_fixed(xlim = c(-14*1.25, 14*1.25), ylim = c(4*1.25, 50*1.25), expand = FALSE) +
      facet_wrap(~ pitch_type, nrow = 1, drop = FALSE) +
      labs(title = title, x = NULL, y = NULL) +
      theme_report() +
      theme(axis.text = element_blank(), axis.ticks = element_blank(),
                     panel.grid = element_blank(),
                     plot.title = element_text(face = "bold", color = NAVY, size = 10, hjust = 0.5),
                     strip.text = element_text(face = "bold", color = NAVY, size = 8))
  }
  
  # no handedness column -> fall back to a single combined block
  if (!("BatterSide" %in% names(d))) return(panel(d, "Locations (pitcher's view)"))
  
  d <- d %>% mutate(side = dplyr::case_when(
    BatterSide %in% c("Left", "L")  ~ "L",
    BatterSide %in% c("Right", "R") ~ "R", TRUE ~ NA_character_)) %>%
    filter(!is.na(side))
  
  p_l <- panel(dplyr::filter(d, side == "L"), "vs LHB")
  p_r <- panel(dplyr::filter(d, side == "R"), "vs RHB")
  bar <- ggplot() +
    geom_vline(xintercept = 0, color = ORANGE, linewidth = 1) +
    theme_void()
  
  patchwork::wrap_plots(p_l, bar, p_r, widths = c(1, 0.05, 1), guides = "collect") +
    patchwork::plot_annotation(
      title = "Locations (pitcher's view)",
      theme = theme(plot.title = element_text(face = "bold", color = NAVY, size = 11))) &
    theme(legend.position = "bottom")
}

# =====================================================================
# Assembly: ggplot -> base64 <img>, gt -> HTML, wrap in full-width letter page
# =====================================================================
gg_to_img <- function(p, width = 8.0, height = 3.0, dpi = 150) {
  tmp <- tempfile(fileext = ".png")
  ggsave(tmp, p, width = width, height = height, dpi = dpi, bg = "white", device = "png")
  uri <- knitr::image_uri(tmp); file.remove(tmp)
  sprintf('<img src="%s" style="width:100%%;height:auto;display:block;"/>', uri)
}

game_stats <- function(outing) {
  d <- derive_outing(outing)
  has_pa <- "PitchofPA" %in% names(d)
  list(
    P  = nrow(d),
    BF = if (has_pa) sum(d$PitchofPA == 1, na.rm = TRUE) else NA,
    K  = sum(d$KorBB == "Strikeout", na.rm = TRUE),
    BB = sum(d$KorBB == "Walk", na.rm = TRUE),
    H  = sum(d$.hit, na.rm = TRUE),
    Str = round(100 * mean(d$.strike, na.rm = TRUE)))
}

report_css <- function() {
  glue::glue("
    @page {{ size: 8.5in 11in; margin: 0; }}
    * {{ box-sizing: border-box; }}
    body {{ margin:0; font-family:'Inter',system-ui,sans-serif; color:{NAVY};
            width:8.5in; -webkit-print-color-adjust:exact; print-color-adjust:exact; }}
    .rpt {{ width:8.5in; margin:0; }}
    .rpt-head {{ background:#0D1B2A; border-bottom:3px solid {ORANGE};
                 padding:12px 0.25in; display:flex; align-items:center; justify-content:space-between; }}
    .rpt-head .name {{ color:#fff; font-size:20px; font-weight:800; }}
    .rpt-head .date {{ color:#ffffffaa; font-size:12px; margin-top:2px; }}
    .rpt-stats {{ display:grid; grid-template-columns:repeat(6,1fr); gap:8px;
                  padding:0 0.25in; margin:10px 0 6px; }}
    .sbox {{ border:1px solid #E2E8F0; border-radius:7px; padding:7px 4px; text-align:center;
             border-bottom:3px solid {BLUE}; }}
    .sbox.k {{ border-bottom-color:{ORANGE}; }}
    .sbox .v {{ font-size:20px; font-weight:800; color:{NAVY}; line-height:1; }}
    .sbox .l {{ font-size:9px; color:{GRAY}; text-transform:uppercase; letter-spacing:.06em; margin-top:3px; }}
    .sec {{ break-inside:avoid; page-break-inside:avoid; margin-top:10px; padding:0 0.25in; }}
    .row2 {{ display:flex; gap:10px; }} .row2 > div {{ flex:1; }}
    table {{ width:100%; font-size:11px; }}
    .cap {{ text-align:center; font-size:8px; color:{GRAY}; margin-top:14px; padding:0 0.25in; }}
  ")
}

build_report_html <- function(outing, season_ref = NULL, pitcher_name, game_date,
                              pitch_col = "TaggedPitchType", k = 1) {
  stopifnot(nrow(outing) > 0)
  nm <- sub("^(.*),\\s*(.*)$", "\\2 \\1", pitcher_name)
  gs <- game_stats(outing)
  
  shape_html <- gt::as_raw_html(shape_table_gt(outing, season_ref, pitch_col, k))
  res_html   <- gt::as_raw_html(results_table_gt(outing, pitch_col))
  rel_img    <- gg_to_img(release_plot(outing, pitch_col),  width = 3.9, height = 3.2)
  mov_img    <- gg_to_img(movement_plot(outing, season_ref, pitch_col), width = 3.9, height = 3.2)
  seq_html   <- gt::as_raw_html(sequencing_table(outing, pitcher_name, pitch_col))
  loc_img    <- gg_to_img(location_grid(outing, pitch_col), width = 8.0, height = 3.3)
  
  sbox <- function(v, l, k = FALSE)
    sprintf('<div class="sbox%s"><div class="v">%s</div><div class="l">%s</div></div>',
            if (k) " k" else "", v, l)
  
  htmltools::HTML(glue::glue('
<!DOCTYPE html><html><head><meta charset="utf-8">
<link href="https://fonts.googleapis.com/css2?family=Inter:wght@400;600;800&display=swap" rel="stylesheet">
<style>{report_css()}</style></head>
<body><div class="rpt">
  <div class="rpt-head">
    <div><div class="name">{nm}</div><div class="date">{as.character(game_date)} \u00b7 Hyannis Harbor Hawks</div></div>
    <svg width="34" height="34" viewBox="0 0 30 30">
      <polygon points="15,2 28,26 15,21 2,26" fill="{ORANGE}" opacity="0.9"/>
      <polygon points="15,2 15,21 2,26" fill="#fff" opacity="0.18"/></svg>
  </div>
  <div class="rpt-stats">
    {sbox(gs$P, "Pitches")}
    {sbox(ifelse(is.na(gs$BF), "\u2014", gs$BF), "Batters")}
    {sbox(gs$K, "K", k = TRUE)}
    {sbox(gs$BB, "BB")}
    {sbox(gs$H, "Hits")}
    {sbox(paste0(gs$Str, "%"), "Strike%")}
  </div>
  <div class="sec">{shape_html}</div>
  <div class="sec">{res_html}</div>
    <div class="sec"><div class="row2">
    <div>{rel_img}</div>
    <div>{mov_img}</div>
    <div style="flex:0 0 225px;">{seq_html}</div>
  </div></div>
  <div class="sec">{loc_img}</div>
  <div class="cap">Hyannis Harbor Hawks \u00b7 Cape Cod Baseball League \u00b7 generated {format(Sys.Date())}</div>
</div></body></html>'))
}

REQUIRED_COLS <- c("Pitcher", "Date", "TaggedPitchType", "RelSpeed", "SpinRate",
                   "InducedVertBreak", "HorzBreak", "PlateLocSide", "PlateLocHeight", "PitchCall")

# ============================================================
#Clean data 
# ============================================================

#Function that retags pitches into a column of a Trackman dataset
retag_pitches <- function(data) {
  
  #Uses create_pitcher_arsenals function to get arsenals from reference set (college season)
  arsenal_percentages <- pitcher_arsenals_over_5perc %>%
    mutate(in_reference = TRUE)   
  
  # get row ID for joins later
  data <- data %>% mutate(row_id = row_number())
  
  #aggregation that prepares data for prediction (removes NAs, creates features, flips HorzBreak and RelSide)
  predict_data <- data %>%
    mutate(
      max_velo_diff = max(RelSpeed, na.rm = TRUE) - RelSpeed,
      max_vert_diff = InducedVertBreak[which.max(RelSpeed)] - InducedVertBreak,
      max_ext_diff  = Extension[which.max(RelSpeed)] - Extension,
      .by = c(GameUID, Pitcher)
    ) %>%
    mutate(
      RelSide = case_when(
        PitcherThrows == "Right" ~ RelSide,
        PitcherThrows == "Left"  ~ -RelSide,
        PitcherThrows %in% c("Both", "Undefined") & RelSide > 0 ~ RelSide,
        PitcherThrows %in% c("Both", "Undefined") & RelSide < 0 ~ -RelSide),
      HorzBreak = case_when(
        PitcherThrows == "Right" ~ HorzBreak,
        PitcherThrows == "Left"  ~ -HorzBreak,
        PitcherThrows %in% c("Both", "Undefined") & HorzBreak > 0 ~ HorzBreak,
        PitcherThrows %in% c("Both", "Undefined") & HorzBreak < 0 ~ -HorzBreak)
    )
  
  #Predcted probabilities from model
  probs          <- predict(retag_model, predict_data, type = "prob")
  pred_col_names <- names(probs)
  
  #Get row_id for join
  probs$row_id   <- predict_data$row_id
  
  #Join over probabilities
  data <- data %>%
    left_join(arsenal_percentages, by = "Pitcher") %>%
    left_join(probs, by = "row_id") %>%
    select(-row_id)
  
  #Determine if pitcher has reference data (pitched in college season)
  has_arsenal <- !is.na(data$in_reference)  
  
  # mask only pitchers who are in the reference, everyone else predicts normally, meaning a pitcher not in the reference has no 
  #arsenal constraint and is just given the model prediction. everyone else moves to the next steps:
  pitch_to_perc <- c(
    .pred_Fastball = "perc_FF", .pred_Cutter    = "perc_CT",
    .pred_Sinker   = "perc_SI", .pred_Slider    = "perc_SL",
    .pred_Sweeper  = "perc_SW", .pred_Curveball = "perc_CU",
    .pred_Changeup = "perc_CH", .pred_Splitter  = "perc_SP"
  )
  for (pc in intersect(names(pitch_to_perc), names(data))) {
    ac   <- pitch_to_perc[[pc]]
    mult <- ifelse(has_arsenal, as.numeric(coalesce(data[[ac]], 0) > 0), 1)
    data[[pc]] <- data[[pc]] * mult 
  }
  
  #Build a matrix of the (now masked) class probabilities 
  prob_mat  <- as.matrix(data[pred_col_names])
  
  #Flag rows that actually got scored, unscored rows stay all-NA and are skipped
  predicted <- rowSums(!is.na(prob_mat)) > 0
  
  #Start everyone as NA, only scored rows get a tag
  pt <- rep(NA_character_, nrow(data))
  
  #Pull just the scored rows, zero out NAs so max.col can run
  m  <- prob_mat[predicted, , drop = FALSE]
  m[is.na(m)] <- 0
  
  #Pick the highest surviving probability per row as the predicted pitch
  pt[predicted] <- pred_col_names[max.col(m, ties.method = "first")]

  #Move real tags over in case we need them later
  data <- data %>%
    mutate(real_tag = TaggedPitchType)
  
  #Strip the ".pred_" prefix to get a clean pitch type, drop the helper column
  data$TaggedPitchType <- sub("^\\.pred_", "", pt)
  data %>% select(-in_reference)
  
  #make all splitters change ups
  data <- data %>% 
    mutate(TaggedPitchType = ifelse(TaggedPitchType == "Splitter", "Changeup", TaggedPitchType))
    
  return(data)
  
}


#Function that predicts stuffplus 
predict_stuffplus <- function(data) {

  #main aggregation: standardizes ax0 and RelSide so that righties and lefties are looked at the same and defines primary pitch
  predict_data <- data %>% 
    mutate(RelSide = case_when(
      PitcherThrows == "Right" ~ RelSide,
      PitcherThrows == "Left" ~ -RelSide,
      PitcherThrows %in% c("Both", "Undefined") & RelSide > 0 ~ RelSide,
      PitcherThrows %in% c("Both", "Undefined") & RelSide < 0 ~ -RelSide),
      ax0 = case_when(
        PitcherThrows == "Right" ~ ax0,
        PitcherThrows == "Left" ~ -ax0,
        PitcherThrows %in% c("Both", "Undefined") & ax0 > 0 ~ ax0,
        PitcherThrows %in% c("Both", "Undefined") & ax0 < 0 ~ -ax0),
      ax0 = -ax0) %>%
    group_by(Pitcher, GameID) %>%

  #Primary pitch is defined as a fastball if a pitcher throws it, if he doesn't then it is a sinker, and if he does not throw that it is his most used pitch.
  #It is determined on a game-by-game basis because a pitcher who does not throw his fastball in an outing is clearly not playing off of it in that game and his
  #pitches should not be determined relative to it
    mutate(
      primary_pitch = case_when(
        any(TaggedPitchType == "Fastball") ~ "Fastball",
        any(TaggedPitchType == "Sinker") ~ "Sinker",
        TRUE ~ names(sort(table(TaggedPitchType), decreasing = TRUE))[1]
      )
    ) %>%
    ungroup() %>% 
    group_by(Pitcher, GameID, primary_pitch) %>%
    mutate(
      primary_az0 = mean(az0[TaggedPitchType == primary_pitch], na.rm = TRUE),
      primary_velo = mean(RelSpeed[TaggedPitchType == primary_pitch], na.rm = TRUE)
    ) %>%
    ungroup() %>% 
    mutate(az0_diff = az0 - primary_az0, 
           velo_diff = RelSpeed - primary_velo)

  
  #Predict using XGBoost model
  df_processed <- bake(stuffplus_recipe, new_data = predict_data)
  
  df_matrix <- as.matrix(df_processed)
  
  raw_stuff <- predict(stuffplus_model, df_matrix)
  
  data$raw_stuff <- raw_stuff
  
  
  data <- data %>%
    mutate(stuff_plus = ((raw_stuff - 0.004424894) / 0.01010482) * 10 + 100)
  
  return(data)
  
}

#===================================================================================================
#Clean College Data Function (includes predicting stuffplus)

#Function to clean college data
clean_college_data <- function(data, teams = NA) {
  
  #Clean cases of bad batter names or Home run errors
  data <- data %>% 
    mutate(PlayResult = ifelse(PlayResult %in% c("HomeRun", "homerun"), "Homerun", PlayResult), 
           Batter = sub("(.*),\\s*(.*)", "\\2 \\1", Batter),
           Pitcher = sub("(.*),\\s*(.*)", "\\2 \\1", Pitcher),
           Catcher = sub("(.*),\\s*(.*)", "\\2 \\1", Catcher))
  
  
  col <- colnames(data)

  #Rename column to not include /
  if ("Top/Bottom" %in% col){ 
    data <- data %>% 
      rename(`Top.Bottom` = `Top/Bottom`)
  }
  
  #Fix column types
  numeric_columns <- c("PitchNo", "PAofInning", "PitchofPA", "PitcherId", "BatterId", "Inning", "Outs", "Balls",
                       "Strikes", "OutsOnPlay", "RunsScored", "RelSpeed", "VertRelAngle", "HorzRelAngle", "SpinRate", 
                       "SpinAxis", "RelHeight", "RelSide", "Extension", "VertBreak", "InducedVertBreak", "HorzBreak", 
                       "PlateLocHeight", "PlateLocSide", "ZoneSpeed", "VertApprAngle", "HorzApprAngle", "ZoneTime", 
                       "ExitSpeed", "Angle", "Direction", "HitSpinRate", "Distance", "Bearing", "HangTime",
                       "LastTrackedDistance", "pfxx", "pfxz", "x0", "y0", "z0", "vx0", "vz0", "vy0", "ax0", "ay0", 
                       "az0",  "EffectiveVelo", "MaxHeight", "SpeedDrop", "ContactPositionX", "ContactPositionY",
                       "ContactPositionZ", "HomeTeamForeignID", "AwayTeamForeignID", "CatcherId", "ThrowSpeed",
                       "PopTime", "ExchangeTime", "TimeToBase", "OutsOnPlay") 
  data <- data %>% 
    mutate(across(any_of(numeric_columns), ~suppressWarnings(as.numeric(.x)))) 
  
  
  #Correct for last, first
  data <- data %>% 
    mutate(
      Batter = ifelse(str_detect(Batter, ","),
                      str_trim(sub("^([^,]*),\\s*(.*)$", "\\2 \\1", Batter)),
                      Batter),
      Pitcher = ifelse(str_detect(Pitcher, ","),
                       str_trim(sub("^([^,]*),\\s*(.*)$", "\\2 \\1", Pitcher)),
                       Pitcher)
    )
  
  #Fix plate locations where unit is feet and not inches 
  data <- data %>% 
    group_by(GameID) %>% 
    mutate(
      PlateLocHeight = PlateLocHeight * if (isTRUE(sd(PlateLocHeight, na.rm = TRUE) < 5)) 12 else 1,
      PlateLocSide   = PlateLocSide   * if (isTRUE(sd(PlateLocSide, na.rm = TRUE) < 5)) 12 else 1
    ) %>% 
    ungroup()
    
  
  #fix pitch tagging
  data <- data %>% 
    mutate(TaggedPitchType = case_when(
      TaggedPitchType == "FourSeamFastBall" ~ "Fastball", 
      TaggedPitchType %in% c("TwoSeamFastBall", "OneSeamFastBall") ~ "Sinker", 
      TaggedPitchType == "ChangeUp" ~ "Changeup", 
      TaggedPitchType == "Undefined" ~ "Other", 
      T ~ TaggedPitchType
    ))

  data <- retag_pitches(data)
  
  #Main aggregations
  data <- data %>%
    mutate(
      is_csw = case_when(
        PitchCall %in% c("StrikeSwinging", "StrikeCalled") ~ 1,
        TRUE ~ 0
      ),
      is_swing = case_when(
        PitchCall %in% c("StrikeSwinging", "FoulBallNotFieldable", "InPlay", 
                         "FoulBallFieldable", "FoulBall") ~ 1,
        TRUE ~ 0
      ),
      is_whiff = case_when(
        PitchCall == "StrikeSwinging" & is_swing == 1 ~ 1,
        PitchCall != "StrikeSwinging" & is_swing == 1 ~ 0,
        TRUE ~ NA_real_
      ),
      in_zone = case_when(
        PlateLocSide > 9.975 | PlateLocSide < -9.975 |
          PlateLocHeight  > 40 | PlateLocHeight  < 20 ~ 0,
        TRUE ~ 1
      ),
      chase = case_when(
        is_swing == 1 & in_zone == 0 ~ 1,
        is_swing == 0 & in_zone == 0 ~ 0,
        TRUE ~ NA_real_
      ),
      in_zone_whiff = case_when(
        is_swing == 1 & in_zone == 1 & is_whiff == 1 ~ 1,
        is_swing == 1 & in_zone == 1 & is_whiff == 0 ~ 0,
        TRUE ~ NA_real_
      ),
      is_hit = case_when(
        PlayResult %in% c("Single", "Double", "Triple", "Homerun", "HomeRun") & PitchCall == "InPlay" ~ 1,
        !PlayResult %in% c("Single", "Double", "Triple", "Homerun", "HomeRun") & PitchCall == "InPlay" ~ 0,
        KorBB == "Strikeout" ~ 0,
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 0,
        TRUE ~ NA_real_
      ),
      slg = case_when(
        PitchCall == "InPlay" & PlayResult == "Single" ~ 1,
        PitchCall == "InPlay" & PlayResult == "Double" ~ 2,
        PitchCall == "InPlay" & PlayResult == "Triple" ~ 3,
        PitchCall == "InPlay" & PlayResult %in% c("Homerun", "HomeRun") ~ 4,
        !PlayResult %in% c("Single", "Double", "Triple", "Homerun", "HomeRun") & PitchCall == "InPlay" ~ 0,
        KorBB == "Strikeout" ~ 0,
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 0,
        TRUE ~ NA_real_
      ),
      on_base = case_when(
        PitchCall == "InPlay" & PlayResult %in% c("Single", "Double", "Triple", "Homerun", "HomeRun") ~ 1,
        PitchCall %in% c("HitByPitch") | KorBB == "Walk" ~ 1,
        PitchCall == "InPlay" & PlayResult %in% c("Out", "Error", "FieldersChoice") & PlayResult != "Sacrifice" ~ 0,
        KorBB == "Strikeout" ~ 0,
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 0,
        TRUE ~ NA_real_
      ),
      is_hard_hit = case_when(
        ExitSpeed >= 95 & PitchCall == "InPlay" ~ 1,
        ExitSpeed < 95 & PitchCall == "InPlay" ~ 0,
        TRUE ~ NA_real_
      ),
      woba = case_when(
        PitchCall == "InPlay" & PlayResult == "Single" ~ 0.95,
        PitchCall == "InPlay" & PlayResult == "Double" ~ 1.24,
        PitchCall == "InPlay" & PlayResult == "Triple" ~ 1.47,
        PitchCall == "InPlay" & PlayResult %in% c("Homerun", "HomeRun") ~ 1.71,
        KorBB == "Walk" ~ 0.82,
        PitchCall %in% c("HitByPitch") ~ 0.85,
        KorBB == "Strikeout" ~ 0,
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 0,
        PitchCall == "InPlay" & !PlayResult  %in% c("Single", "Double" ,"Triple" ,"Homerun", "HomeRun") ~ 0,
        TRUE ~ NA_real_
      ),
      wobacon = case_when(
        PitchCall == "InPlay" & PlayResult == "Single" ~ 0.95,
        PitchCall == "InPlay" & PlayResult == "Double" ~ 1.24,
        PitchCall == "InPlay" & PlayResult == "Triple" ~ 1.47,
        PitchCall == "InPlay" & PlayResult %in% c("Homerun", "HomeRun") ~ 1.71,
        PitchCall == "InPlay" & !PlayResult  %in% c("Single", "Double" ,"Triple" ,"Homerun", "HomeRun") ~ 0,
        TRUE ~ NA_real_
      ),
      is_plate_appearance = ifelse(
        PitchCall %in% c("InPlay", "HitByPitch") | KorBB %in% c("Strikeout", "Walk") | PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking"), 1, 0
      ),
      is_at_bat = case_when(
        PitchCall == "InPlay" & !PlayResult %in% c("StolenBase", "Sacrifice", "CaughtStealing", "Undefined") ~ 1,
        KorBB == "Strikeout" ~ 1,
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 1,
        TRUE ~ 0
      ),
      is_walk = case_when(
        is_plate_appearance == 1 & KorBB == "Walk" ~ 1,
        is_plate_appearance == 1 & KorBB != "Walk" ~ 0,
        TRUE ~ NA_real_
      ),
      is_k = case_when(
        is_at_bat == 1 & KorBB == "Strikeout" ~ 1,
        is_at_bat == 1 & KorBB != "Strikeout" ~ 0, 
        PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 1,
        TRUE ~ NA_real_
      ), 
      is_put_away = case_when(
        Strikes == 2 & KorBB == "Strikeout" ~ 1,
        Strikes == 2 & KorBB != "Strikeout" ~ 0,
        Strikes == 2 & PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking") ~ 1,
        TRUE ~ NA_real_
      ), 
      OutsOnPlay = ifelse(KorBB == "Strikeout" | PlayResult %in% c("StrikeoutSwinging", "StrikeoutLooking"), OutsOnPlay + 1, OutsOnPlay)
    )
  
  data <- data %>% 
    mutate(event_type = case_when(
      PitchCall %in% c("StrikeSwinging", "StrkeSwinging") ~ "Whiff", 
      PitchCall %in% c("StriekC", "StrikeCalled") ~ "Called Strike", 
      PitchCall %in% c("FoulBallFieldable", "FoulBall", "FoulBallNotFieldable",
                       "FouldBallNotFieldable") ~ "Foul Ball", 
      PitchCall %in% c("BallCalled", "BallinDirt", "BallIntentional", "BalIntentional") ~ "Ball", 
      PitchCall == "HitByPitch" ~ "HBP", 
      PitchCall == "InPlay" & PlayResult %in% c("Out", "FieldersChoice",
                                                "Error", "error", 
                                                "Sacrifice") ~ "Field Out", 
      PitchCall == "InPlay" & PlayResult == "Single" ~ "Single", 
      PitchCall == "InPlay" & PlayResult == "Double" ~ "Double",
      PitchCall == "InPlay" & PlayResult == "Triple" ~ "Triple",
      PitchCall == "InPlay" & PlayResult == "Homerun" ~ "Home Run", 
      T ~ NA
    ))
  

  #Join over context neutral run values (dertermined using base states from the NCAA API to achive College RE24. Run values are reflective of the entire NCAA regular sesaon)
  if (!"mean_DRE" %in% names(data)) {
    data <- data %>% 
      left_join(rv, by = "event_type")
  }

      #Get rud of unnecessary columns
  data <- data %>%
    dplyr::select(
      -any_of(c(
        "PitchLastMeasuredX", "PitchLastMeasuredY", "PitchLastMeasuredZ",
        "HitSpinAxis",
        "PitchReleaseConfidence", "PitchLocationConfidence", "PitchMovementConfidence",
        "HitLaunchConfidence", "HitLandingConfidence",
        "CatcherThrowCatchConfidence", "CatcherThrowReleaseConfidence", "CatcherThrowLocationConfidence",
        "PositionAt110X", "PositionAt110Y", "PositionAt110Z"
      )),
      -starts_with("PitchTrajectory"),
      -starts_with("HitTrajectory")
    )

  #Join over leagues DF for conference names 
  data <- data %>% 
    dplyr::select(-any_of(c("HomeLeague", "AwayLeague", "PitcherLeague", "BatterLeague"))) %>% 
    left_join(team_leagues, by = "HomeTeam") %>% 
    left_join(team_leagues %>% rename(AwayLeague = HomeLeague, AwayTeam = HomeTeam), by = "AwayTeam") %>% 
    mutate(PitcherLeague = ifelse(`Top.Bottom` == "Top", HomeLeague, AwayLeague),
           BatterLeague = ifelse(`Top.Bottom` == "Top", AwayLeague, HomeLeague),
           HomeLeague = replace_na(HomeLeague, "Other"),
           AwayLeague = replace_na(AwayLeague, "Other"),
           PitcherLeague = replace_na(PitcherLeague, "Other"),
           BatterLeague = replace_na(BatterLeague, "Other")
    )
  

  #Predict stuffplus
  if (!"stuff_plus" %in% names(data)) {
    data <- predict_stuffplus(data)
  }

  #filter out lower levels
  data <- data %>% 
    filter(!(Level %in% c("D2", "JUCO", "NAIA", "D3")))

  #If able predict xwoba, if not enough data default to NA
  data <- tryCatch({
      d <- data %>% mutate(row_id = row_number())
      prob_cols <- c("prob_0", "prob_1", "prob_2", "prob_3", "prob_4")
  
      complete <- d %>%
        filter(!is.na(ExitSpeed) & !is.na(Angle)) %>%
        dplyr::select(-any_of(prob_cols))
  
      xwoba_preds <- predict(xwoba_model, complete, type = "prob")
      colnames(xwoba_preds) <- prob_cols
  
      complete <- complete %>% bind_cols(xwoba_preds)
  
      d <- d %>%
        dplyr::select(-any_of(prob_cols)) %>%
        left_join(complete %>% dplyr::select(row_id, any_of(prob_cols)), by = "row_id") %>%
        dplyr::select(-row_id)
  
      d <- d %>%
        dplyr::select(-any_of(c("w1B", "w2B", "w3B", "wHR"))) %>%
        cross_join(college_guts %>% dplyr::select(w1B, w2B, w3B, wHR)) %>%
        mutate(xwOBA = w1B*prob_1 + w2B*prob_2 + w3B*prob_3 + wHR*prob_4 + 0*prob_0,
               xwOBA = case_when(
                 KorBB == "Strikeout" ~ 0,
                 KorBB == "Walk" ~ .82,
                 event_type == "HBP" ~ .85,
                 TRUE ~ xwOBA
               ))
      d
    }, error = function(e) {
      message("xwOBA prediction failed: ", conditionMessage(e), " \u2014 setting xwOBA and prob_* to NA.")
      data %>% mutate(
        prob_0 = NA_real_, prob_1 = NA_real_, prob_2 = NA_real_,
        prob_3 = NA_real_, prob_4 = NA_real_,
        xwOBA  = NA_real_
      )
    })
  
  message(nrow(data), " rows cleaned.")

  return(data)
  
  
}


# ============================================================
# Theme + CSS (Hawks look, inlined — no theme.R needed)
# ============================================================
HAWKS_ORANGE <- "#F25B00"; HAWKS_BLUE <- "#164EA7"; HAWKS_DARK <- "#0D1B2A"
HAWKS_LIGHT  <- "#F5F7FA"; HAWKS_GRAY <- "#6B7280"; HAWKS_BORDER <- "#E2E8F0"

hawks_theme <- bs_theme(
  version = 5, bg = "#FFFFFF", fg = HAWKS_DARK,
  primary = HAWKS_BLUE, secondary = HAWKS_ORANGE,
  base_font = font_google("Inter"), heading_font = font_google("Inter"),
  `border-radius` = "0.5rem", `font-size-base` = "0.925rem"
)

hawks_css <- tags$style(HTML(glue("
  * {{ box-sizing:border-box; }}
  body {{ background:{HAWKS_LIGHT}; font-family:'Inter',system-ui,sans-serif; margin:0; }}
  .hawks-shell {{ display:flex; flex-direction:column; min-height:100vh; }}
  .hawks-topbar {{ background:{HAWKS_DARK}; padding:0 24px; display:flex; align-items:center;
    justify-content:space-between; border-bottom:3px solid {HAWKS_ORANGE}; }}
  .topbar-brand {{ display:flex; align-items:center; gap:10px; padding:14px 0; }}
  .topbar-brand .app-title {{ color:#fff; font-size:16px; font-weight:800; }}
  .topbar-title {{ color:#fff; font-size:26px; font-weight:800; flex:1; text-align:center; white-space:nowrap; }}
  .topbar-spacer {{ width:110px; }}
  .hawks-content {{ flex:1; padding:24px; }}
  .data-card {{ background:#fff; border:1px solid {HAWKS_BORDER}; border-radius:8px; overflow:hidden; }}
  .data-card-hdr {{ padding:10px 14px; border-bottom:1px solid {HAWKS_BORDER};
    display:flex; align-items:center; justify-content:space-between; }}
  .data-card-title {{ font-size:11px; font-weight:700; color:{HAWKS_DARK};
    text-transform:uppercase; letter-spacing:.05em; }}
  .data-card-sub {{ font-size:10px; color:#9CA3AF; }}
  .data-card-body {{ padding:16px; }}
  .status-box {{ background:#eef3fb; border-left:4px solid {HAWKS_BLUE}; padding:14px;
    border-radius:4px; white-space:pre-wrap; font-family:monospace; font-size:13px; color:{HAWKS_DARK}; }}
  .btn-scrape {{ background:{HAWKS_BLUE} !important; border:none !important; color:#fff !important;
    font-weight:700; width:100%; }}
  .btn-scrape:hover {{ background:#0f3d82 !important; }}
  .btn-hf {{ background:{HAWKS_ORANGE} !important; border:none !important; color:#fff !important;
    font-weight:700; width:100%; }}
  .btn-hf:hover {{ background:#d44f00 !important; }}
")))

# ============================================================
# Login overlay (JS, matches the other apps)
# ============================================================
login_css <- tags$style(HTML("
  #login_screen { position:fixed; inset:0; z-index:9999; display:flex; flex-direction:column;
    align-items:center; justify-content:center;
    background:linear-gradient(135deg,#001a3a 0%,#003366 40%,#0a4a8a 100%);
    transition:opacity .8s ease, transform .8s ease; }
  #login_screen.fade-out { opacity:0; transform:scale(1.02); pointer-events:none; }
  #login_screen .login-logo { width:120px; height:120px; margin-bottom:20px; border-radius:50%;
    object-fit:cover; border:3px solid rgba(255,165,0,.6); box-shadow:0 0 30px rgba(255,165,0,.2); }
  #login_screen .login-title { font-size:42px; font-weight:800; color:#fff; letter-spacing:1.5px;
    margin-bottom:6px; text-align:center; }
  #login_screen .login-subtitle { font-size:16px; color:rgba(255,165,0,.7); letter-spacing:3px;
    text-transform:uppercase; margin-bottom:40px; }
  #login_screen .login-accent { width:60px; height:3px; background:#FF8C00; margin:0 auto 30px; border-radius:2px; }
  #login_screen .login-box { background:rgba(255,255,255,.06); border:1px solid rgba(255,165,0,.2);
    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,165,0,.3); border-radius:6px; background:rgba(255,255,255,.08);
    color:#fff; font-size:15px; margin-bottom:16px; outline:none; text-align:center; letter-spacing:2px; }
  #login_screen .login-box input[type='password']:focus { border-color:#FF8C00; }
  #login_screen .login-btn { width:100%; padding:12px; border:none; border-radius:6px;
    background:#FF8C00; color:#fff; font-size:14px; font-weight:700; letter-spacing:1px;
    text-transform:uppercase; cursor:pointer; }
  #login_screen .login-btn:hover { background:#e67e00; }
  #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", "TrackMan Scraper"),
  tags$div(class = "login-accent"),
  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 = '", 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.addEventListener('DOMContentLoaded', function(){
    document.getElementById('login_btn').addEventListener('click', tryLogin);
    document.getElementById('login_pw').addEventListener('keydown', function(e){
      if (e.key === 'Enter') tryLogin();
    });
  });
")))

# ============================================================
# UI
# ============================================================
ui <- fluidPage(
  theme = hawks_theme,
  hawks_css,
  login_css,
  tags$style(HTML(glue("
    .page-frame {{ width:8.5in; height:11in; border:1px solid {HAWKS_BORDER};
      box-shadow:0 4px 24px rgba(0,0,0,.12); background:#fff; }}
  "))),
  tags$div(class = "hawks-shell",
    tags$div(class = "hawks-topbar",
      tags$div(class = "topbar-brand",
        tags$svg(width = "24", height = "24", viewBox = "0 0 30 30", fill = "none",
          tags$polygon(points = "15,2 28,26 15,21 2,26", fill = HAWKS_ORANGE, opacity = "0.9"),
          tags$polygon(points = "15,2 15,21 2,26", fill = "#fff", opacity = "0.18")),
        tags$span(class = "app-title", "Scraper")
      ),
      tags$div(class = "topbar-title", "TrackMan Scraper \u2014 2026 Cape"),
      tags$div(class = "topbar-spacer")
    ),
    tags$div(class = "hawks-content",
      tabsetPanel(
        id = "main_tabs",

        tabPanel("Scrape & Upload",
          tags$div(style = "padding-top:16px;",
            fluidRow(
              column(4,
                tags$div(class = "data-card",
                  tags$div(class = "data-card-hdr",
                    tags$span(class = "data-card-title", "Controls"),
                    tags$span(class = "data-card-sub", "Source & dates")),
                  tags$div(class = "data-card-body",
                    radioButtons("scrape_source", "Data Source",
                      choices = c("TrackMan PBP" = "pbp", "TrackMan Positional" = "pos"), selected = "pbp"),
                    dateInput("start_date", "Start Date:", value = Sys.Date() - 1),
                    dateInput("end_date",   "End Date:",   value = Sys.Date() - 1),
                    br(),
                    actionButton("scrape_btn", "Scrape Data", class = "btn-scrape"),
                    br(), br(),
                    downloadButton("download_scrape", "Download CSV", style = "width:100%;"),
                    br(), br(),
                    actionButton("upload_hf_btn", "Upload to HF Dataset", class = "btn-hf")
                  )
                )
              ),
              column(8,
                tags$div(class = "data-card", style = "margin-bottom:16px;",
                  tags$div(class = "data-card-hdr",
                    tags$span(class = "data-card-title", "Progress"),
                    tags$span(class = "data-card-sub", "Live status")),
                  tags$div(class = "data-card-body",
                    tags$div(class = "status-box", textOutput("scrape_status")))
                ),
                tags$div(class = "data-card",
                  tags$div(class = "data-card-hdr",
                    tags$span(class = "data-card-title", "Data Preview"),
                    tags$span(class = "data-card-sub", "Scraped rows")),
                  tags$div(class = "data-card-body", DT::dataTableOutput("scrape_preview"))
                )
              )
            )
          )
        ),

        tabPanel("Pitcher Report",
          tags$div(style = "display:flex; gap:16px; padding-top:16px;",
            tags$div(style = "width:260px; flex-shrink:0;",
              tags$div(class = "data-card",
                tags$div(class = "data-card-hdr",
                  tags$span(class = "data-card-title", "Report Inputs")),
                tags$div(class = "data-card-body",
                  fileInput("file", "Outing CSV (TrackMan)", accept = ".csv",
                            buttonLabel = "Browse", placeholder = "No file"),
                  checkboxInput("needs_cleaning",
                                "Raw data \u2014 run cleaning + tagging", value = FALSE),
                  selectInput("pitcher", "Pitcher", choices = NULL, width = "100%"),
                  selectInput("game",    "Outing",  choices = NULL, width = "100%"),
                  actionButton("build", "Build report", class = "btn-scrape"),
                  br(), br(),
                  downloadButton("dl", "Download HTML", style = "width:100%;")
                )
              )
            ),
            tags$div(style = "flex:1; overflow:auto;",
              uiOutput("preview")
            )
          )
        )
      )
    )
  ),
  login_overlay,
  login_js
)

# ============================================================
# Server
# ============================================================
server <- function(input, output, session) {

  scraped_data      <- reactiveVal(NULL)
  scrape_polling    <- reactiveVal(FALSE)
  scrape_status_msg <- reactiveVal("Ready.")

  output$scrape_status <- renderText({ scrape_status_msg() })

  # ---- 1. Trigger workflow on GitHub ----
  observeEvent(input$scrape_btn, {
    scrape_status_msg("Triggering scrape on GitHub...")

    result <- tryCatch({
      httr::POST(
        paste0("https://api.github.com/repos/", gh_repo, "/actions/workflows/scrape.yml/dispatches"),
        httr::add_headers(
          Authorization = paste("Bearer", gh_token),
          Accept = "application/vnd.github.v3+json"
        ),
        body = jsonlite::toJSON(list(
          ref = "main",
          inputs = list(
            start_date = as.character(input$start_date),
            end_date   = as.character(input$end_date),
            data_type  = input$scrape_source
          )
        ), auto_unbox = TRUE),
        encode = "raw"
      )
    }, error = function(e) {
      scrape_status_msg(paste("Failed:", e$message)); NULL
    })

    if (is.null(result)) return()

    if (httr::status_code(result) == 204) {
      scrape_status_msg("Scrape triggered! Waiting for GitHub to finish...")
      scrape_polling(TRUE)
    } else {
      scrape_status_msg(paste("GitHub API error:", httr::status_code(result)))
    }
  })

  # ---- 2. Poll GitHub every 15s until the run completes ----
  shiny::observe({
    req(scrape_polling())
    invalidateLater(15000, session)

    resp <- tryCatch({
      httr::GET(
        paste0("https://api.github.com/repos/", gh_repo, "/actions/runs?per_page=1"),
        httr::add_headers(
          Authorization = paste("Bearer", gh_token),
          Accept = "application/vnd.github.v3+json"
        )
      )
    }, error = function(e) NULL)

    if (is.null(resp)) return()

    runs <- jsonlite::fromJSON(httr::content(resp, as = "text", encoding = "UTF-8"))
    if (length(runs$workflow_runs) == 0) return()

    latest     <- runs$workflow_runs[1, ]
    status     <- latest$status
    conclusion <- latest$conclusion

    if (status == "completed") {
      scrape_polling(FALSE)

      if (conclusion == "success") {
        scrape_status_msg("GitHub finished! Fetching data...")

        filename <- paste0(input$scrape_source, "_", input$start_date, "_to_", input$end_date, ".csv.gz")
        url <- paste0("https://api.github.com/repos/", gh_repo, "/contents/TrackmanScraper/data/", filename)

        data <- tryCatch({
          file_resp <- httr::GET(
            url,
            httr::add_headers(
              Authorization = paste("Bearer", gh_token),
              Accept = "application/vnd.github.v3.raw"
            )
          )
          if (httr::status_code(file_resp) == 200) {
            tmp <- tempfile(fileext = ".csv.gz")
            writeBin(httr::content(file_resp, as = "raw"), tmp)
            read_csv(gzfile(tmp))
          } else NULL
        }, error = function(e) NULL)

        if (!is.null(data) && nrow(data) > 0) {

          # Only PBP gets cleaned + Stuff+; positional is uploaded raw.
          if (input$scrape_source == "pbp") {
            scrape_status_msg("Processing data (clean + Stuff+)...")
            data <- tryCatch({
              d <- clean_college_data(data)
              d
            }, error = function(e) {
              scrape_status_msg(paste("Processing error:", e$message)); data
            })
          }

          scraped_data(data)
          scrape_status_msg(paste0("Done! ", nrow(data), " rows x ", ncol(data), " columns."))
        } else {
          scrape_status_msg("Scrape finished but couldn't fetch the file.")
        }

      } else {
        scrape_status_msg(paste("GitHub Action failed:", conclusion))
      }

    } else {
      scrape_status_msg(paste0("GitHub is running... (status: ", status, ")"))
    }
  })

  # ---- Preview + download ----
  output$scrape_preview <- DT::renderDataTable({
    req(scraped_data())
    DT::datatable(scraped_data(), options = list(scrollX = TRUE, pageLength = 10))
  })

  output$download_scrape <- downloadHandler(
    filename = function() {
      paste0("trackman_", input$scrape_source, "_",
             format(input$start_date, "%Y%m%d"), "_to_",
             format(input$end_date, "%Y%m%d"), ".csv")
    },
    content = function(file) {
      req(scraped_data())
      write.csv(scraped_data(), file, row.names = FALSE)
    }
  )

  # ---- 3. Upload to HuggingFace (dedup by PitchUID, append-only shards) ----
  observeEvent(input$upload_hf_btn, {
    req(scraped_data())

    timestamp <- format(Sys.time(), "%Y%m%d_%H%M%S")
    target    <- hf_target_for(input$scrape_source)

    upload_to_hf <- function(new_data, folder, index_file, label) {
      scrape_status_msg(paste0("Checking existing UIDs for ", label, "..."))

      existing_uids <- tryCatch({
        tmp_idx <- tempfile(fileext = ".csv.gz")
        resp <- httr::GET(
          paste0("https://huggingface.co/datasets/", HF_REPO_ID, "/resolve/main/", index_file),
          httr::add_headers(Authorization = paste("Bearer", HF_WRITE_TOKEN)),
          httr::write_disk(tmp_idx, overwrite = TRUE)
        )
        if (httr::status_code(resp) == 200) {
          d <- read.csv(gzfile(tmp_idx), stringsAsFactors = FALSE)
          file.remove(tmp_idx)
          d$PitchUID
        } else {
          file.remove(tmp_idx)
          character(0)
        }
      }, error = function(e) character(0))

      scraped_rows <- nrow(new_data)

      if (length(existing_uids) > 0 && "PitchUID" %in% names(new_data)) {
        new_only <- new_data %>% filter(!PitchUID %in% existing_uids)
      } else {
        new_only <- new_data
      }

      new_rows    <- nrow(new_only)
      total_after <- length(existing_uids) + new_rows

      if (new_rows == 0) {
        return(paste0(label, ": ", scraped_rows, " rows scraped, 0 new rows added (",
                      length(existing_uids), " total)"))
      }

      scrape_status_msg(paste0("Uploading ", new_rows, " new rows for ", label, "..."))

      hf  <- reticulate::import("huggingface_hub")
      api <- hf$HfApi()

      tmp_data <- tempfile(fileext = ".parquet")
      arrow::write_parquet(new_only, tmp_data)

      api$upload_file(
        path_or_fileobj = tmp_data,
        path_in_repo    = paste0(folder, "/", timestamp, ".parquet"),
        repo_id         = HF_REPO_ID,
        repo_type       = "dataset",
        token           = HF_WRITE_TOKEN
      )
      file.remove(tmp_data)

      # Rebuild the UID index only when PitchUID exists
      if ("PitchUID" %in% names(new_only)) {
        scrape_status_msg(paste0("Updating ", label, " index..."))
        all_uids <- data.frame(PitchUID = c(existing_uids, new_only$PitchUID))
        tmp_idx  <- tempfile(fileext = ".csv.gz")
        gz <- gzfile(tmp_idx, "w"); write.csv(all_uids, gz, row.names = FALSE); close(gz)

        api$upload_file(
          path_or_fileobj = tmp_idx,
          path_in_repo    = index_file,
          repo_id         = HF_REPO_ID,
          repo_type       = "dataset",
          token           = HF_WRITE_TOKEN
        )
        file.remove(tmp_idx)
      }

      rm(new_only); gc()
      paste0(label, ": ", scraped_rows, " rows scraped, ", new_rows, " new rows added (",
             total_after, " total)")
    }

    msg <- tryCatch(
      upload_to_hf(scraped_data(), target$folder, target$index, target$label),
      error = function(e) paste("Upload failed:", e$message)
    )
    scrape_status_msg(msg)
  })

  # ============================================================
  # PITCHER REPORT TAB
  # ============================================================
  raw_upload <- reactive({
    req(input$file)
    df <- tryCatch(readr::read_csv(input$file$datapath, show_col_types = FALSE, guess_max = 50000),
                   error = function(e) { showNotification(paste("Read error:", e$message), type = "error"); NULL })
    req(df)
    missing <- setdiff(REQUIRED_COLS, names(df))
    shiny::validate(shiny::need(length(missing) == 0,
                  paste0("CSV missing required column(s): ", paste(missing, collapse = ", "))))
    df
  })

  # Checkbox gates cleaning: checked = raw -> clean + tag; unchecked = already clean -> pass through
  processed_upload <- reactive({
    req(raw_upload())
    if (isTRUE(input$needs_cleaning)) {
      withProgress(message = "Cleaning + tagging data\u2026", {
        tryCatch(
          clean_college_data(raw_upload()),
          error = function(e) {
            showNotification(
              paste0("Cleaning failed: ", conditionMessage(e),
                     " \u2014 if this file is already cleaned, leave the \u201cRaw data\u201d box unchecked."),
              type = "error", duration = 12
            )
            NULL
          }
        )
      })
    } else {
      raw_upload()
    }
  })

  observeEvent(processed_upload(), {
    ps <- sort(unique(processed_upload()$Pitcher))
    updateSelectInput(session, "pitcher", choices = ps, selected = ps[1])
  })

  observeEvent(input$pitcher, {
    req(processed_upload(), input$pitcher)
    dts <- processed_upload() %>% filter(Pitcher == input$pitcher) %>%
      pull(Date) %>% unique() %>% as.character() %>% sort(decreasing = TRUE)
    updateSelectInput(session, "game", choices = dts, selected = dts[1])
  })

  season_ref <- reactive({
    req(input$pitcher)
    if (is.null(REFERENCE_DATA) || !("Pitcher" %in% names(REFERENCE_DATA))) return(NULL)
    build_season_ref(REFERENCE_DATA, input$pitcher, min_pitches = 1)
  })

  outing <- reactive({
    req(processed_upload(), input$pitcher, input$game)
    processed_upload() %>%
      filter(Pitcher == input$pitcher, as.character(Date) == as.character(input$game))
  })

  report_html <- eventReactive(input$build, {
    req(nrow(outing()) > 0)
    withProgress(message = "Building report\u2026", {
      build_report_html(outing(), season_ref(), input$pitcher, input$game,
                        k = 0.1)
    })
  })

  output$preview <- renderUI({
    if (input$build == 0 || is.null(input$file)) {
      return(tags$div(style = "width:8.5in; padding:40px; text-align:center; color:#6B7280;",
        tags$div(style = "font-size:14px; font-weight:600;",
                 "Upload an outing CSV, pick the pitcher & date, then Build report."),
        tags$div(style = "font-size:12px; margin-top:6px;",
                 "The preview renders the exact 8.5\u00d711 page you'll download.")))
    }
    tags$iframe(class = "page-frame", srcdoc = as.character(report_html()))
  })

  output$dl <- downloadHandler(
    filename = function() paste0(gsub("[ ,]+", "_", input$pitcher %||% "pitcher"),
                                 "_", input$game %||% "outing", ".html"),
    content  = function(f) writeLines(as.character(report_html()), f, useBytes = TRUE)
  )
}

shinyApp(ui = ui, server = server)