TimStats/SpringPitchCompare
0
1# Load required libraries2library(shiny)3library(DT)4library(baseballr)5library(dplyr)6library(xgboost)7library(httr)8 9Sys.setenv(TZ='EST')10download_private_csv <- function(repo_id, filename) {11 url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)12 response <- GET(url, add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))))13 14 if (status_code(response) == 200) {15 content <- content(response, "text")16 con <- textConnection(content)17 18 # Try different read options19 data <- read.csv(con, 20 header = TRUE,21 check.names = FALSE, # This prevents R from modifying column names22 fileEncoding = "UTF-8",23 stringsAsFactors = FALSE)24 close(con)25 return(data)26 } else {27 stop("Failed to download dataset")28 }29}30download_private_parquet <- function(repo_id, filename) {31 library(httr)32 library(arrow)33 34 # Create the direct download URL based on your example35 url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename, "?download=true")36 37 # Create a temporary file38 temp_file <- tempfile(fileext = ".parquet")39 40 # Download directly to file41 response <- GET(42 url,43 add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))),44 write_disk(temp_file, overwrite = TRUE)45 )46 47 # Check if download was successful48 if (status_code(response) == 200) {49 tryCatch({50 # Read the parquet file51 data <- read_parquet(temp_file)52 file.remove(temp_file)53 return(data)54 }, error = function(e) {55 file.remove(temp_file)56 stop(paste("Error reading parquet file:", e$message))57 })58 } else {59 file.remove(temp_file)60 stop(paste("Failed to download file. Status code:", status_code(response)))61 }62}63 64 65MLB <- download_private_parquet("TimStats/StatcastDataAll", "MLB25.parquet")66AAA <- download_private_parquet("TimStats/StatcastDataAll", "AAA25.parquet")67FSL <- download_private_parquet("TimStats/StatcastDataAll", "FSL25.parquet")68 69 70MLB <- MLB %>% 71 select(72 `Pitcher Name`, `Pitcher ID`, pitch_name, start_speed, spin_rate, extension,73 IVB, HB, x0, z074 )75 76# Same selection for AAA before rbind77AAA <- AAA %>%78 select(79 `Pitcher Name`, `Pitcher ID`, pitch_name, start_speed, spin_rate, extension,80 IVB, HB, x0, z081 )82 83FSL <- FSL %>%84 select(85 `Pitcher Name`, `Pitcher ID`, pitch_name, start_speed, spin_rate, extension,86 IVB, HB, x0, z087 )88# Helper functions89calculate_EAA <- function(extension) {90 extension / 6.391}92 93calculate_SADiff <- function(pfxX, pfxZ, spinDirection) {94 inSA <- atan2(pfxZ, pfxX) * 180/pi + 9095 inSA <- ifelse(inSA < 0, inSA + 360, inSA)96 SADiff <- spinDirection - inSA97 SADiff <- ifelse(SADiff > 180, SADiff - 360, SADiff)98 SADiff <- ifelse(SADiff < -180, SADiff + 360, SADiff)99 return(SADiff)100}101 102calculate_VAA <- function(vz0, ay, az, vy0, y0) {103 -atan((vz0+(az*(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))-vy0)/104 ay))/(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))))*(180/pi)105}106 107pitcher_summary <- function(game_pk, date) {108 gdate <- as.Date.character(date)109 gdate <- as.Date(gdate)110 tmilb <- mlb_pbp(game_pk)111 tmilb <- tmilb %>%112 filter(type == "pitch") %>%113 select(matchup.batter.fullName, matchup.batter.id, matchup.pitcher.fullName,114 matchup.pitcher.id, matchup.pitchHand.code, details.type.description,115 pitchData.startSpeed, pitchData.breaks.spinRate, pitchData.extension,116 pitchData.coordinates.x0, pitchData.coordinates.y0, pitchData.coordinates.z0,117 pitchData.coordinates.aX, pitchData.coordinates.aY, pitchData.coordinates.aZ,118 pitchData.coordinates.vX0, pitchData.coordinates.vZ0, pitchData.coordinates.vY0,119 pitchData.coordinates.pfxX, pitchData.coordinates.pfxZ,120 pitchData.breaks.breakVerticalInduced, pitchData.breaks.breakHorizontal,121 pitchData.breaks.spinDirection)122 123 colnames(tmilb) <- c("Batter Name", "Batter ID", "Pitcher Name", "Pitcher ID",124 "phand", "pitch_name", "start_speed", "spin_rate", "extension",125 "x0", "y0", "z0", "ax", "ay", "az", "vx0", "vz0", "vy0",126 "pfxX", "pfxZ", "IVB", "HB", "spinDirection")127 128 tmilb <- tmilb %>%129 mutate(date = gdate)130 131 return(tmilb)132}133 134calculate_timstuff <- function(game) {135 game <- game %>%136 mutate(VAA = calculate_VAA(vz0, ay, az, vy0, y0),137 EAA = calculate_EAA(extension),138 SADiff = calculate_SADiff(pfxX, pfxZ, spinDirection),139 ishandL = ifelse(phand == "L", 1, 0))140 141 feature_vars <- c("ishandL", "start_speed", "IVB", "HB", "EAA", "x0", "z0", "spin_rate", "SADiff")142 complete_rows <- complete.cases(game[, feature_vars])143 game_complete <- game[complete_rows, ]144 game_na <- game[!complete_rows,]145 game_na$TimStuff <- NA146 147 game_complete$TimStuff <- scale_TimStuff(148 predict(model, as.matrix(cbind(game_complete$ishandL, game_complete$start_speed,149 game_complete$IVB, game_complete$HB, game_complete$EAA,150 game_complete$x0, game_complete$z0, game_complete$spin_rate,151 game_complete$SADiff))),152 -0.002620635, 0.006021368)153 154 game_complete <- rbind(game_complete, game_na)155 return(game_complete)156}157 158scale_TimStuff <- function(raw_score, model_mean, model_sd) {159 scaled_score <- (raw_score - model_mean) / model_sd160 result <- 100 - (scaled_score * 10)161 return(result)162}163 164summary_table <- function(data) {165 # Current year summary166 current_summary <- data %>%167 group_by(`Pitcher Name`, `Pitcher ID`, pitch_name) %>%168 summarize(169 Pitches = n(),170 'Velo' = round(mean(start_speed, na.rm = TRUE), 1),171 'Spin' = round(mean(spin_rate, na.rm = TRUE), 0),172 'Ext' = round(mean(extension, na.rm = TRUE), 1),173 'IVB' = round(mean(IVB, na.rm = TRUE), 1),174 'HB' = round(mean(HB, na.rm = TRUE), 1),175 'RelX' = round(mean(x0, na.rm = TRUE), 1),176 'RelZ' = round(mean(z0, na.rm = TRUE), 1),177 'TimStuff' = round(mean(TimStuff, na.rm = TRUE), 0),178 .groups = "drop"179 )180 181 data_2024 <- rbind(MLB,AAA,FSL) %>%182 group_by(`Pitcher Name`, `Pitcher ID`, pitch_name) %>%183 summarize(184 'Velo25' = round(mean(start_speed, na.rm = TRUE), 1),185 'Spin25' = round(mean(spin_rate, na.rm = TRUE), 0),186 'Ext25' = round(mean(extension, na.rm = TRUE), 1),187 'IVB25' = round(mean(IVB, na.rm = TRUE), 1),188 'HB25' = round(mean(HB, na.rm = TRUE), 1),189 'RelX25' = round(mean(x0, na.rm = TRUE), 1),190 'RelZ25' = round(mean(z0, na.rm = TRUE), 1),191 .groups = "drop"192 )193 194 # Join and calculate differences195 combined_data <- current_summary %>%196 left_join(data_2024, by = c("Pitcher Name", "Pitcher ID", "pitch_name")) %>%197 mutate(198 'Velo_Diff' = round(Velo - Velo25, 1),199 'Spin_Diff' = round(Spin - Spin25, 1),200 'Ext_Diff' = round(Ext - Ext25, 1),201 # IVB calculation modified to handle sign changes correctly202 'IVB_Diff' = round(ifelse(sign(IVB) != sign(IVB25), 203 sign(IVB) * (abs(IVB) + abs(IVB25)),204 ifelse(IVB < 0,205 -1 * (abs(IVB) - abs(IVB25)),206 abs(IVB) - abs(IVB25))), 1),207 # HB shows increased movement in either direction as positive208 'HB_Diff' = round(abs(HB) - abs(HB25), 1),209 'RelX_Diff' = round(RelX - RelX25, 1),210 'RelZ_Diff' = round(RelZ - RelZ25, 1)211 ) %>%212 arrange(-Pitches)213 214 return(combined_data)215}216# Load TimStuff model217model <- xgb.load('TimStuff2.ubj')218 219# UI Definition220ui <- fluidPage(221 titlePanel("Spring Training Pitch Comparison Dashboard (Not Mobile Compatible)"),222 sidebarLayout(223 sidebarPanel(224 width = 2,225 dateInput("date", "Date:"),226 selectizeInput("level", "Level:", 227 c("MLB")),228 actionButton("submit", "Get Dashboard"),229 downloadButton("download_summary", "Download Summary")230 ),231 mainPanel(232 dataTableOutput("schedule")233 )234 )235)236 237# Server Definition238server <- function(input, output, session) {239 data <- reactiveVal()240 games <- reactiveVal()241 summary <- reactiveVal()242 243 observeEvent(input$submit, {244 season <- format(input$date, "%Y")245 246 # Get schedule based on selected level247 schedule_data <- switch(input$level,248 "MLB" = mlb_schedule(season = season, level_ids = "1"),249 "AAA" = mlb_schedule(season = season, level_ids = "11"),250 "FSL" = mlb_schedule(season = season, level_ids = "14"),251 "College (Statcast Parks Only)" = mlb_schedule(season = season, level_ids = "22"),252 "Futures Game" = mlb_schedule(season = season, level_ids = "21"),253 "AFL" = {254 sbid <- mlb_schedule(2026, 17) %>%255 filter(teams_away_team_name %in% c("Glendale Desert Dogs", "Mesa Solar Sox",256 "Peoria Javelinas", "Salt River Rafters",257 "Scottsdale Scorpions", "Surprise Saguaros")) %>%258 filter(gameday_type == "E")259 sbid260 }261 )262 263 data(schedule_data)264 schedule <- data() %>% filter(date == input$date)265 266 # Initialize empty games dataframe267 games_data <- data.frame()268 269 # Process each game270 for(n in 1:nrow(schedule)) {271 tryCatch({272 game1 <- pitcher_summary(schedule[n,6], schedule[n,1])273 games_data <- rbind(game1, games_data)274 }, error = function(e) {275 message(paste("Error occurred for game:", schedule[n,6], "on", schedule[n,1]))276 })277 }278 279 # Calculate TimStuff and create summary280 games_data <- calculate_timstuff(games_data)281 games(games_data)282 summary_data <- summary_table(games_data)283 summary(summary_data)284 285 # Render comparison table286 output$schedule <- renderDT({287 datatable(summary_data,288 options = list(289 pageLength = 10,290 lengthMenu = c(10, 25, 50, 100),291 scrollX = TRUE, # Enable horizontal scrolling292 fixedColumns = list(left = 4), # Freeze first 3 columns (Name, ID, Pitch)293 columnDefs = list(294 list(className = 'dt-center', targets = "_all"),295 # Names and identifiers296 list(width = '150px', targets = c(0, 1)), # Pitcher Name, Pitcher ID297 list(width = '100px', targets = 2), # pitch_name298 list(width = '70px', targets = 3), # Pitches299 # Current year stats300 list(width = '50px', targets = c(4:11)), # Velo, Spin, Ext, IVB, HB, RelX, RelZ, TimStuff301 # 2024 stats302 list(width = '10px', targets = c(12:18)), # Velo_2024, Spin_2024, Ext_2024, IVB_2024, HB_2024, RelX_2024, RelZ_2024303 # Difference columns304 list(width = '50px', targets = c(19:25)) # All _Diff columns305 )306 ),307 extensions = 'FixedColumns'308 ) %>%309 formatStyle(310 c('Velo_Diff', 'Spin_Diff', 'Ext_Diff', 'IVB_Diff', 311 'HB_Diff', 'RelX_Diff', 'RelZ_Diff'),312 backgroundColor = styleInterval(313 cuts = 0,314 values = c('#ffcdd2', '#c8e6c9')315 )316 )317 })318 319 })320 321 # Download handler for summary CSV322 output$download_summary <- downloadHandler(323 filename = function() {324 paste("comparison_data_", Sys.Date(), ".csv", sep = "")325 },326 content = function(file) {327 write.csv(summary(), file, row.names = FALSE)328 }329 )330}331 332shinyApp(ui, server)