app.R

# app.R
library(shiny)
library(ggplot2)
library(dplyr)
library(patchwork)
library(showtext)
library(magick)
library(grid)
library(gridExtra)
library(gtable)
library(httr)
library(bslib)
library(jsonlite)
library(arrow)

download_private_parquet <- function(repo_id, filename) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename, "?download=true")
  temp_file <- tempfile(fileext = ".parquet")
  
  response <- GET(
    url,
    add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))),
    write_disk(temp_file, overwrite = TRUE)
  )
  
  if (status_code(response) == 200) {
    tryCatch({
      data <- read_parquet(temp_file)
      file.remove(temp_file)
      return(data)
    }, error = function(e) {
      file.remove(temp_file)
      stop(paste("Error reading parquet file:", e$message))
    })
  } else {
    file.remove(temp_file)
    stop(paste("Failed to download file. Status code:", status_code(response)))
  }
}

font_add_google("Roboto Condensed")

is_barrel <- function(df) {
  df$barrel <- with(df, ifelse(hit_angle <= 50 & hit_speed >= 97 & hit_speed * 1.5 -
                                 hit_angle >= 117 & hit_speed + hit_angle >= 123, 1, 0))
  return(df)
}

apply_percentile_calcs <- function(data) {
  percent_rank_cols <- c("Z-Con%", "Z-Swing%", "O-Con%", "Avg EV", "Max EV", "EV90", "Barrel%", "Swing%", "wOBA",
                         "wOBACON", "xwOBA", "xDamage")
  inverse_percent_rank_cols <- c("Chase%", "Whiff%", "stdev(LA)", "SwStr%")
  
  percentile_list <- list()
  
  for (col in percent_rank_cols) {
    percentile_list[[col]] <- data.frame(
      `Batter Name` = data[["Batter Name"]],
      `Batter ID` = data[["Batter ID"]],
      metric = col,
      percentile = pmax(1, round(percent_rank(data[[col]]) * 100)),
      value = data[[col]],
      stringsAsFactors = FALSE
    )
  }
  
  for (col in inverse_percent_rank_cols) {
    percentile_list[[col]] <- data.frame(
      `Batter Name` = data[["Batter Name"]],
      `Batter ID` = data[["Batter ID"]],
      metric = col,
      percentile = pmax(1, round((1 - percent_rank(data[[col]])) * 100)),
      value = data[[col]],
      stringsAsFactors = FALSE
    )
  }
  
  result <- do.call(rbind, percentile_list)
  rownames(result) <- NULL
  return(result)
}

get_player_image <- function(player_id) {
  silo_url <- sprintf("https://img.mlbstatic.com/mlb-photos/image/upload/w_200,q_auto:best/v1/people/%s/headshot/silo/current", player_id)
  
  silo_result <- tryCatch({
    response <- httr::HEAD(silo_url)
    httr::status_code(response) == 200
  }, error = function(e) FALSE)
  
  if (!silo_result) {
    return(sprintf("https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto,b_white,ar_1:1/w_180/v1/people/%s/headshot/milb/current", player_id))
  }
  
  return(silo_url)
}

get_player_info <- function(player_id, season, level = "MLB") {
  team <- "MLB"
  position <- NA
  
  if (level == "MLB") {
    url <- paste0("https://statsapi.mlb.com/api/v1/people/", player_id,
                  "/stats?stats=season&season=", season, "&group=hitting")
    response <- httr::GET(url)
    data <- httr::content(response, "parsed")
    
    if (length(data$stats) > 0 && length(data$stats[[1]]$splits) > 0) {
      team <- data$stats[[1]]$splits[[length(data$stats[[1]]$splits)]]$team$name
    }
  } else {
    sport_code <- if (level == "AAA") "11" else "14"
    url <- paste0("https://statsapi.mlb.com/api/v1/sports/", sport_code, "/players?season=", season)
    response <- httr::GET(url)
    players_df <- jsonlite::fromJSON(rawToChar(response$content), flatten = TRUE)$people
    found_player <- players_df[players_df$id == player_id, ]
    
    if (nrow(found_player) > 0) {
      team_id <- found_player$currentTeam.id
      team_url <- paste0("https://statsapi.mlb.com/api/v1/teams/", team_id, "?season=", season)
      team_response <- httr::GET(team_url)
      team_data <- jsonlite::fromJSON(rawToChar(team_response$content))
      team <- team_data$teams$parentOrgName
    }
  }
  
  url2 <- paste0("https://statsapi.mlb.com/api/v1/people/", player_id)
  response2 <- httr::GET(url2)
  data2 <- httr::content(response2, "parsed")
  
  if (length(data2$people) > 0) {
    full_position <- data2$people[[1]]$primaryPosition$name
    position <- case_when(
      full_position == "First Base" ~ "1B",
      full_position == "Second Base" ~ "2B",
      full_position == "Third Base" ~ "3B",
      full_position == "Shortstop" ~ "SS",
      full_position == "Catcher" ~ "C",
      full_position == "Left Field" ~ "LF",
      full_position == "Center Field" ~ "CF",
      full_position == "Right Field" ~ "RF",
      full_position == "Outfielder" ~ "OF",
      full_position == "Outfield" ~ "OF",
      full_position == "Designated Hitter" ~ "DH",
      full_position == "Pitcher" ~ "P",
      full_position == "Two-Way Player" ~ "TWP",
      TRUE ~ as.character(full_position)
    )
  }
  
  return(list(team = team, position = position))
}

download_private_csv <- function(repo_id, filename) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  response <- GET(url, add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))))
  
  if (status_code(response) == 200) {
    content <- content(response, "text")
    con <- textConnection(content)
    data <- read.csv(con, header = TRUE, check.names = FALSE, fileEncoding = "UTF-8", stringsAsFactors = FALSE)
    close(con)
    return(data)
  } else {
    stop("Failed to download dataset")
  }
}

# ---- Data Loading ----
MLB25 <- download_private_parquet("TimStats/StatcastDataAll", "MLB25.parquet")
MLB25$level <- "MLB"
AAA25 <- download_private_parquet("TimStats/StatcastDataAll", "AAA25.parquet")
AAA25$level <- "AAA"
FSL25 <- download_private_parquet("TimStats/StatcastDataAll", "FSL25.parquet")
FSL25$level <- "FSL"

MLB26 <- download_private_parquet("TimStats/StatcastDataAll", "MLB26.parquet")
MLB26$level <- "MLB"
AAA26 <- download_private_parquet("TimStats/StatcastDataAll", "AAA26.parquet")
AAA26$level <- "AAA"
FSL26 <- download_private_parquet("TimStats/StatcastDataAll", "FSL26.parquet")
FSL26$level <- "FSL"

MLB <- download_private_parquet("TimStats/StatcastDataAll", "MLB.parquet")
MLB$level <- "MLB"
AAA <- download_private_parquet("TimStats/StatcastDataAll", "AAA.parquet")
AAA$level <- "AAA"
FSLAll <- download_private_parquet("TimStats/StatcastDataAll", "FSL.parquet")
FSLAll$level <- "FSL"

MLB <- rbind(MLB, MLB25, MLB26)
print("aaa")
AAA <- rbind(AAA, AAA25, AAA26)
print("fsl")
FSL <- rbind(FSLAll, FSL25, FSL26)

temp_players <- MLB %>% filter(season == 2026)
MLBC <- rbind(MLB, AAA, FSLAll)

data <- is_barrel(MLBC) %>%
  mutate(
    BBE = case_when(description %in% c('In play, run(s)', 'In play, out(s)', 'In play, no out') ~ TRUE, TRUE ~ FALSE),
    Swing = case_when(description %in% c('Foul', 'Foul Bunt', 'Foul Pitchout', 'Foul Tip',
                                         'In play, run(s)', 'In play, out(s)', 'In play, no out',
                                         'Swinging Strike', 'Swinging Strike (Blocked)',
                                         'Missed Bunt') ~ TRUE, TRUE ~ FALSE),
    Contact = case_when(description %in% c('In play, run(s)', 'In play, out(s)', 'In play, no out',
                                           'Foul', 'Foul Bunt', 'Foul Pitchout') ~ TRUE, TRUE ~ FALSE),
    Whiff = case_when(description %in% c('Swinging Strike', 'Swinging Strike (Blocked)',
                                         'Missed Bunt', 'Foul Tip') ~ TRUE, TRUE ~ FALSE),
    IZ = ifelse(zone <= 9, TRUE, FALSE),
    Single = case_when(result == "Single" & BBE == TRUE ~ TRUE, TRUE ~ FALSE),
    Double = case_when(result == "Double" & BBE == TRUE ~ TRUE, TRUE ~ FALSE),
    Triple = case_when(result == "Triple" & BBE == TRUE ~ TRUE, TRUE ~ FALSE),
    `Home Run` = case_when(result == "Home Run" & BBE == TRUE ~ TRUE, TRUE ~ FALSE),
    Walk = case_when(balls >= 4 & result == "Walk" ~ TRUE, TRUE ~ FALSE),
    HBP = case_when(description == "Hit By Pitch" & result == "Hit By Pitch" ~ TRUE, TRUE ~ FALSE),
    Strikeout = case_when(strikes >= 3 & result %in% c("Strikeout", 'Stikeout Double Play') ~ TRUE, TRUE ~ FALSE),
    Sac = case_when(BBE == TRUE & result %in% c('Sac Fly', 'Sac Bunt',
                                                 'Sac Fly Double Play', 'Sac Bunt Double Play') ~ TRUE, TRUE ~ FALSE),
    IBB = case_when(pitchNum == 1 & result == "Intent Walk" ~ TRUE, TRUE ~ FALSE),
    AB = Strikeout + BBE - Sac,
    PA = AB + Walk + HBP + IBB
  ) %>%
  group_by(`Batter Name`, `Batter ID`, season, level) %>%
  summarise(
    BIP = sum(BBE, na.rm = TRUE),
    wOBA = round((sum(Single, na.rm = TRUE) * .882 + sum(Double, na.rm = TRUE) * 1.254 +
                    sum(Triple, na.rm = TRUE) * 1.59 + sum(`Home Run`, na.rm = TRUE) * 2.05 +
                    sum(Walk, na.rm = TRUE) * .689 + sum(HBP, na.rm = TRUE) * .720) /
                   (sum(PA, na.rm = TRUE) - sum(IBB, na.rm = TRUE)), 3),
    wOBACON = round((sum(Single, na.rm = TRUE) * .882 + sum(Double, na.rm = TRUE) * 1.254 +
                       sum(Triple, na.rm = TRUE) * 1.59 + sum(`Home Run`, na.rm = TRUE) * 2.05) /
                      sum(BBE, na.rm = TRUE), 3),
    xwOBA = round(mean(expected_woba, na.rm = TRUE), 3),
    xDamage = round(mean(expected_woba[BBE == TRUE], na.rm = TRUE), 3),
    `Avg EV` = round(mean(hit_speed, na.rm = TRUE), 1),
    EV90 = round(quantile(hit_speed, 0.9, na.rm = TRUE), 1),
    `Max EV` = round(max(hit_speed, na.rm = TRUE), 1),
    'stdev(LA)' = round(sd(hit_angle, na.rm = TRUE), 1),
    'Barrel%' = round(100 * mean(barrel[Swing == TRUE], na.rm = TRUE), 1),
    "Z-Con%" = round(100 * mean(Contact[IZ == TRUE & Swing == TRUE], na.rm = TRUE), 1),
    "Z-Swing%" = round(100 * mean(Swing[IZ == TRUE], na.rm = TRUE), 1),
    "O-Con%" = round(100 * mean(Contact[IZ == FALSE & Swing == TRUE], na.rm = TRUE), 1),
    "Chase%" = round(100 * mean(Swing[IZ == FALSE], na.rm = TRUE), 1),
    "Whiff%" = round(100 * mean(Whiff[Swing == TRUE], na.rm = TRUE), 1),
    "Swing%" = round(100 * mean(Swing, na.rm = TRUE), 1),
    "SwStr%" = round(100 * mean(Whiff, na.rm = TRUE), 1)
  )

# ---- UI ----
ui <- fluidPage(
  theme = bs_theme(bg = "#ffffff", fg = "#333333", primary = "#428bca"),
  tags$head(
    tags$link(href = "https://fonts.googleapis.com/css2?family=Roboto+Condensed:wght@400;700&display=swap",
              rel = "stylesheet"),
    tags$style(HTML("
      * { font-family: 'Roboto Condensed', sans-serif !important; }
    "))
  ),
  titlePanel(NULL, windowTitle = "Baseball Stats Visualization"),
  sidebarLayout(
    sidebarPanel(
      selectInput("szn", "Season:", c(2026, 2025, 2024, 2023, 2022, 2021)),
      selectInput("level", "Level:", c("MLB", "AAA", "FSL")),
      selectInput("type", "Player Type:", c("Batter")),
      selectInput("player", "Player:", choices = unique(temp_players$`Batter Name`)),
      checkboxInput("use_custom_team", "Use Custom Team", FALSE),
      conditionalPanel(
        condition = "input.use_custom_team == true",
        selectInput(
          inputId = "team",
          label = "Select Team",
          choices = c(
            "MLB" = "MLB",
            "Angels" = "LAA",
            "Astros" = "HOU",
            "Athletics" = "OAK",
            "Blue Jays" = "TOR",
            "Braves" = "ATL",
            "Brewers" = "MIL",
            "Cardinals" = "STL",
            "Cubs" = "CHC",
            "D-backs" = "ARI",
            "Dodgers" = "LAD",
            "Giants" = "SF",
            "Guardians" = "CLE",
            "Mariners" = "SEA",
            "Marlins" = "MIA",
            "Mets" = "NYM",
            "Nationals" = "WSH",
            "Orioles" = "BAL",
            "Padres" = "SD",
            "Phillies" = "PHI",
            "Pirates" = "PIT",
            "Rangers" = "TEX",
            "Rays" = "TB",
            "Red Sox" = "BOS",
            "Reds" = "CIN",
            "Rockies" = "COL",
            "Royals" = "KC",
            "Tigers" = "DET",
            "Twins" = "MIN",
            "White Sox" = "CHW",
            "Yankees" = "NYY"
          ),
          selected = "MLB"
        )
      )
    ),
    mainPanel(
      div(class = "plot-container",
          plotOutput("statsPlot")
      )
    )
  )
)

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

  observeEvent(c(input$szn, input$level), {
    filtered_data <- MLBC[MLBC$season == as.numeric(input$szn) & MLBC$level == input$level, ]
    updateSelectInput(session,
                      inputId = "player",
                      choices = unique(filtered_data$`Batter Name`))
  })

  team_value <- reactiveVal("MLB")
  position_value <- reactiveVal("")

  observeEvent(c(input$player, input$szn), {
    if (!input$use_custom_team && !is.null(input$player) && input$player != "") {
      player_id <- MLBC %>%
        filter(`Batter Name` == input$player) %>%
        pull(`Batter ID`) %>%
        unique() %>%
        first()

      if (!is.null(player_id)) {
        player_info <- get_player_info(player_id, as.numeric(input$szn), input$level)

        team_abb <- switch(player_info$team,
                           "Los Angeles Angels" = "LAA",
                           "Houston Astros" = "HOU",
                           "Oakland Athletics" = "OAK",
                           "Toronto Blue Jays" = "TOR",
                           "Atlanta Braves" = "ATL",
                           "Milwaukee Brewers" = "MIL",
                           "St. Louis Cardinals" = "STL",
                           "Chicago Cubs" = "CHC",
                           "Arizona Diamondbacks" = "ARI",
                           "Los Angeles Dodgers" = "LAD",
                           "San Francisco Giants" = "SF",
                           "Cleveland Guardians" = "CLE",
                           "Seattle Mariners" = "SEA",
                           "Miami Marlins" = "MIA",
                           "New York Mets" = "NYM",
                           "Washington Nationals" = "WSH",
                           "Baltimore Orioles" = "BAL",
                           "San Diego Padres" = "SD",
                           "Philadelphia Phillies" = "PHI",
                           "Pittsburgh Pirates" = "PIT",
                           "Texas Rangers" = "TEX",
                           "Tampa Bay Rays" = "TB",
                           "Boston Red Sox" = "BOS",
                           "Cincinnati Reds" = "CIN",
                           "Colorado Rockies" = "COL",
                           "Kansas City Royals" = "KC",
                           "Detroit Tigers" = "DET",
                           "Minnesota Twins" = "MIN",
                           "Chicago White Sox" = "CHW",
                           "New York Yankees" = "NYY",
                           "MLB")
        if (is.na(team_abb) || is.null(team_abb)) {
          team_abb <- "MLB"
        }
        team_value(team_abb)
        position_value(player_info$position)
      }
    }
  })

  current_team <- reactive({
    if (input$use_custom_team) {
      return(input$team)
    } else {
      return(team_value())
    }
  })

  output$statsPlot <- renderPlot({
    req(position_value())
    req(input$player)

    szn_num <- as.numeric(input$szn)

    plot_data <- data %>% filter(season == szn_num, level == input$level)

    BBE <- MLBC %>%
      filter(season == szn_num) %>%
      filter(level == input$level) %>%
      filter(`Batter Name` == input$player) %>%
      mutate(
        BBE = case_when(description %in% c('In play, run(s)', 'In play, out(s)', 'In play, no out') ~ TRUE, TRUE ~ FALSE)
      )

    indv <- plot_data %>% filter(`Batter Name` == input$player, level == input$level)

    if (szn_num == 2026) {
      qual <- plot_data %>% filter(BIP > 10)
    } else {
      qual <- plot_data %>% filter(BIP > 249)
    }

    plot_data <- unique(rbind(indv, qual))

    current_data <- apply_percentile_calcs(plot_data %>% select(-BIP)) %>%
      filter(`Batter.Name` == input$player) %>%
      mutate(metric = factor(metric, levels = c(
        "wOBA", "wOBACON", "xwOBA", "xDamage",
        "Avg EV", "EV90", "Max EV",
        "stdev(LA)", "Barrel%",
        "Z-Con%", "Z-Swing%", "O-Con%",
        "Chase%", "Whiff%", "Swing%", "SwStr%"
      ))) %>%
      arrange(metric)

    pos <- position_value()
    BBE_count <- sum(BBE$BBE, na.rm = TRUE)

    current_data$color <- scales::gradient_n_pal(c("#325aa1", "#90A4AE", "#D82129"))(current_data$percentile / 100)

    # Labels plot
    labels_plot <- ggplot() +
      annotate("text", x = c(10, 50, 90), y = 1.2,
               label = c("Poor", "Average", "Great"),
               color = c("#3661ad", "#90A4AE", "#DC3545"),
               family = "Roboto Condensed", size = 6) +
      annotate("text", x = c(10, 50, 90), y = .5,
               label = "\u25B2",
               color = c("#3661ad", "#90A4AE", "#DC3545"), size = 12) +
      scale_x_continuous(limits = c(-16, 113), expand = c(0, 0)) +
      scale_y_continuous(limits = c(0.5, 1.5)) +
      theme_void()

    # Main plot
    main_plot <- ggplot(current_data, aes(y = factor(metric, levels = rev(metric)))) +
      geom_tile(aes(x = 50, width = 100),
                fill = "#c7dcdc", alpha = 0.3, height = 0.25) +
      geom_tile(aes(x = percentile / 2, width = percentile, fill = color),
                height = 0.7) +
      annotate("segment", x = c(10, 50, 90), xend = c(10, 50, 90),
               y = 0, yend = 16.35,
               color = c("white"),
               linewidth = 1.5, alpha = 0.5) +
      geom_segment(aes(x = -2, xend = -16,
                       y = as.numeric(factor(metric, levels = rev(metric))) - 0.3,
                       yend = as.numeric(factor(metric, levels = rev(metric))) - 0.3),
                   linetype = "longdash", color = "#399098", size = 1) +
      geom_segment(aes(x = 102, xend = 113,
                       y = as.numeric(factor(metric, levels = rev(metric))) - 0.3,
                       yend = as.numeric(factor(metric, levels = rev(metric))) - 0.3),
                   linetype = "longdash", color = "#399098", size = 1) +
      geom_text(aes(x = -3, label = metric),
                hjust = 1, size = 6, family = "Roboto Condensed") +
      geom_text(aes(x = 103, label = value),
                hjust = 0, size = 6, family = "Roboto Condensed") +
      geom_point(aes(x = percentile, color = "white", fill = color),
                 size = 12, shape = 21, stroke = 3) +
      geom_text(aes(x = percentile, label = percentile),
                size = 5, color = "white", fontface = "bold", family = "Roboto Condensed") +
      scale_x_continuous(limits = c(-16, 113), expand = c(0, 0)) +
      scale_fill_identity() +
      scale_color_identity() +
      theme_minimal() +
      theme(
        axis.text = element_blank(),
        axis.title = element_blank(),
        panel.grid = element_blank(),
        plot.margin = margin(t = 0, r = 0, b = -20, l = 0),
        text = element_text(family = "Roboto Condensed")
      )

    # Logo
    if (current_team() == "MLB") {
      logo_url <- "https://a.espncdn.com/combiner/i?img=/i/teamlogos/leagues/500/mlb.png?w=400&h=400&transparent=true"
    } else {
      logo_url <- sprintf("https://a.espncdn.com/combiner/i?img=/i/teamlogos/mlb/500/%s.png&h=200&w=200",
                          current_team())
    }
    logo_img <- image_read(logo_url)
    logo_raster <- as.raster(logo_img)

    # Player headshot
    player_url <- get_player_image(current_data[1, 2])
    player_img <- image_read(player_url)
    player_raster <- as.raster(player_img)

    # Title grobs
    title_grob <- textGrob(paste0(input$player, " - ", pos,
                                  "\n BBE - ", BBE_count, "\n", input$level,
                                  " Percentile Rankings - ", input$szn),
                           gp = gpar(fontsize = 25, fontface = "bold",
                                     fontfamily = "Roboto Condensed"))
    logo_grob <- rasterGrob(logo_raster, x = 0, width = unit(.5, "npc"), hjust = 0)
    player_grob <- rasterGrob(player_raster, x = 0.5, width = unit(.5, "npc"), hjust = 0)
    title_with_logo <- arrangeGrob(logo_grob, title_grob, player_grob, ncol = 3,
                                   widths = c(.25, .5, .25))
    caption_grob <- textGrob("Viz by: @TimStats | tim-stats.com | Data: MLB",
                             gp = gpar(fontsize = 15, fontface = "bold",
                                       fontfamily = "Roboto Condensed"))

    # Final arrangement
    final_plot <- grid.arrange(
      title_with_logo,
      labels_plot,
      main_plot,
      caption_grob,
      heights = c(0.15, 0.05, 0.75, 0.05)
    )

    grid.arrange(
      gtable_add_padding(
        final_plot,
        padding = unit(c(20, 20, 20, 20), "points")
      )
    )
  }, height = 1000, width = 1000, res = 97, pointsize = 12)
}

shinyApp(ui = ui, server = server)