app.R

# Load required libraries
library(shiny)
library(plotly)
library(bslib)
library(DT)
library(rsconnect)
library(baseballr)
library(dplyr)
library(ggplot2)
library(xgboost)
library(httr)

#pdf(file = NULL)
Sys.setenv(TZ='EST')

# Helper functions
format_output_data <- function(data) {
  data <- data |>
    select(`Pitcher Name`, `Pitcher ID`, `Batter Name`, `Batter ID`, pitch_name, pitchNum, des, start_speed, spin_rate, extension,
           IVB, HB, x0, z0, SADiff, TimStuff) |>
    mutate(
      `Pitch` = pitch_name,
      `Pitch Number` = pitchNum,
      `Pitch Description` = des,
      `Pitch Speed` = round(start_speed, 1),
      `Spin Rate` = round(spin_rate, 0),
      `Extension` = round(extension, 1),
      `Induced Vertical Break` = round(IVB, 1),
      `Horizontal Break` = round(HB, 1),
      `Horizontal Release Point` = round(x0, 1),
      `Vertical Release Point` = round(z0, 1),
      `Spin Axis Difference` = round(SADiff, 0),
      `TimStuff` = round(TimStuff, 0)
    ) |>
    select(`Pitcher Name`, `Pitcher ID`, `Batter Name`, `Batter ID`, `Pitch`, `Pitch Number`, `Pitch Description`, `Pitch Speed`, 
           `Spin Rate`, `Extension`, `Induced Vertical Break`, `Horizontal Break`, `Horizontal Release Point`, 
           `Vertical Release Point`,`Spin Axis Difference`, `TimStuff`)
  
  return(data)
}

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)
}

VAA <- function(milbtotal){
  milbtotal <- milbtotal %>%
    mutate(VAA = -atan((vz0+(az*(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))-vy0)/
                               ay))/(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))))*(180/pi))
}

calculate_EAA <- function(extension) {
  extension / 6.3
}

calculate_SADiff <- function(pfxX, pfxZ, spinDirection) {
  inSA <- atan2(pfxZ, pfxX) * 180/pi + 90
  inSA <- ifelse(inSA < 0, inSA + 360, inSA)
  SADiff <- spinDirection - inSA
  SADiff <- ifelse(SADiff > 180, SADiff - 360, SADiff)
  SADiff <- ifelse(SADiff < -180, SADiff + 360, SADiff)
  return(SADiff)
}

calculate_VAA <- function(vz0, ay, az, vy0, y0) {
  -atan((vz0+(az*(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))-vy0)/
                ay))/(-sqrt((vy0*vy0)-(2*ay*(y0-(17/12))))))*(180/pi)
}

pitcher_summary <- function(game_pk,date){
  gdate <- as.Date.character(date)
  gdate <- as.Date(gdate)
  tmilb <- mlb_pbp(game_pk)
  tmilb <- tmilb %>%
    filter(type == "pitch")
  tmilb <- tmilb %>%
    select(matchup.batter.fullName,matchup.batter.id,matchup.pitcher.fullName,matchup.pitcher.id,
           matchup.pitchHand.code, pitchNumber,result.event,details.description,details.type.description,
           result.description,pitchData.startSpeed,pitchData.plateTime,pitchData.zone,
           pitchData.breaks.spinRate,pitchData.extension, pitchData.coordinates.pX,
           pitchData.coordinates.pZ,pitchData.coordinates.x0, pitchData.coordinates.y0,
           pitchData.coordinates.z0,pitchData.coordinates.aX,pitchData.coordinates.aY,
           pitchData.coordinates.aZ,pitchData.coordinates.vX0,pitchData.coordinates.vZ0,
           pitchData.coordinates.vY0,pitchData.coordinates.pfxX,pitchData.coordinates.pfxZ,
           pitchData.breaks.breakVerticalInduced,pitchData.breaks.breakHorizontal,
           hitData.launchSpeed,hitData.launchAngle,hitData.totalDistance,details.isInPlay,
           last.pitch.of.ab,pitchData.breaks.spinDirection)
  colnames(tmilb) <- c("Batter Name","Batter ID","Pitcher Name","Pitcher ID","phand",
                       "pitchNum","result","description","pitch_name","des","start_speed",
                       "plateTime","zone","spin_rate","extension","px","pz","x0",
                       "y0","z0","ax","ay","az","vx0","vz0","vy0","pfxX","pfxZ",
                       "IVB","HB","hit_speed","hit_angle","hit_distance","inPlay",
                       "lastPitch","spinDirection")
  tmilb <- is_barrel(tmilb)
  tmilb <- tmilb %>%
    mutate(is_strike_swinging = ifelse(description == "Swinging Strike" |
                                         description == "Foul Tip",TRUE,FALSE))
  tmilb <- tmilb %>%
    mutate(date = gdate)
  return(tmilb)
}

calculate_timstuff <- function(game) {
 # game <- calculate_primary(game)
  game <- game %>%
    mutate(VAA = calculate_VAA(vz0, ay, az, vy0, y0),
           EAA = calculate_EAA(extension),
           SADiff = calculate_SADiff(pfxX, pfxZ, spinDirection),
           team_fielding_id = ifelse(description %in% c("Called Strike", "Swinging Strike", "Swinging Strike (Blocked)"), 1, 0),
           swing = ifelse(description %in% c("Foul", "Foul Pitchout", "In play, no out", "In play, out(s)", "In play, run(s)", "Swinging Strike", "Swinging Strike (Blocked)", "Foul Tip"), 1, 0),
           is_strike_swinging = ifelse(is_strike_swinging, 1, 0),
           Pitch = pitch_name,
           ishandL = ifelse(phand == "L",1,0))
  # game <- calculate_primary(game)
  
  feature_vars <- c("ishandL","start_speed", "IVB", "HB", "EAA", "x0", "z0", "spin_rate","SADiff")
  complete_rows <- complete.cases(game[, feature_vars])
  game_complete <- game[complete_rows, ]
  game_na <- game[!complete_rows,]
  game_na$TimStuff <- NA
  
  rhp <- game_complete
  
  # rhp <- game_complete[game_complete$ishandL == 0]
  # 
  # lhp$TimStuff <- scale_TimStuff(predict(model, as.matrix(cbind(lhp$ishandL,lhp$start_speed, lhp$IVB, lhp$HB, lhp$EAA, lhp$x0, lhp$z0, lhp$spin_rate, lhp$SADiff,lhp$primary_speed,lhp$primary_IVB,lhp$primary_HB))), -0.00249975,  0.007566558)
  
  rhp$TimStuff <- scale_TimStuff(predict(model, as.matrix(cbind(rhp$ishandL,rhp$start_speed, rhp$IVB, rhp$HB, rhp$EAA, rhp$x0, rhp$z0, rhp$spin_rate, rhp$SADiff))),   -0.002620635,   0.006021368)
  
  game_complete <- rbind(rhp,game_na)
  return(game_complete)
}

scale_TimStuff <- function(raw_score, model_mean, model_sd) {
  scaled_score <- (raw_score - model_mean) / model_sd
  result <- 100 - (scaled_score * 10)
  return(result)
}

pitch_plot <- function(game){
  ggplot()+
    geom_point(game,mapping = 
                 aes(x=px, y = pz,color = pitch_name),size = 3.5) +
    geom_segment(aes(x=-0.71,xend = 0.71, y = 1.5,yend = 1.5))+
    geom_segment(aes(x=-0.71,xend = 0.71, y = 3.6,yend = 3.6))+
    geom_segment(aes(x= 0.71,xend = 0.71, y = 1.5,yend = 3.6))+
    geom_segment(aes(x=-0.71,xend = -0.71, y = 1.5,yend =3.6))+
    xlab(" ")+
    ylab(" ") +
    xlim(-3,3)+
    ylim(0.2,4)+
    coord_fixed(ratio = 1) +
    ggthemes::theme_few()+
    guides(color = guide_legend(title = "Pitch Type"))+
    theme(axis.text.x=element_blank(), 
          axis.ticks.x=element_blank(), 
          axis.text.y=element_blank(), 
          axis.ticks.y=element_blank())
}

# Load models
model <- xgb.load('TimStuff2.ubj')

summary_table <- function(data,pitchern){
  # rows <- nrow(data)
  data <- data %>%
    group_by(data[,3],Pitch) %>%
    summarize(
      Pitches = n(),
      #'Pitch%' = round(sum(Pitches)/sum(rows) * 100, digits = 1),
      'Avg. Velo' = round(mean(start_speed, na.rm = TRUE), digits = 1),
      'Spin Rate' = round(mean(spin_rate, na.rm = TRUE), digits = 0),
      'Extension' = round(mean(extension, na.rm = TRUE), digits = 1),
      'IVB' = round(mean(IVB, na.rm = TRUE), digits = 1),
      'HB' = round(mean(HB, na.rm = TRUE), digits = 1),
      'Horz. Release Point' = round(mean(x0,na.rm = TRUE),digits = 1),
      'Vert. Release Point' = round(mean(z0,na.rm = TRUE),digits = 1),
      'Spin Axis Difference (in degrees)' = round(mean(SADiff,na.rm = TRUE),digits = 0),
      'VAA' = round(mean(VAA, na.rm = TRUE), digits = 1),
      'CSW%' = round(sum(team_fielding_id, na.rm = TRUE) / sum(!is.na(team_fielding_id)) * 100, digits = 1),
      'Whiff%' = round(sum(is_strike_swinging, na.rm = TRUE) / sum(swing, na.rm = TRUE) * 100, digits = 1),
      'TimStuff+' = round(mean(TimStuff, na.rm = TRUE), digits = 0)
    ) %>%
    arrange(-Pitches)
  
  return(data)
}

# UI Definition
ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      @media (max-width: 768px) {
        .sidebar { width: 100%; float: none; }
        .main-content { margin-left: 0; }
        .selectize-input { font-size: 14px; }
        .form-group { margin-bottom: 10px; }
        .action-button { width: 100%; }
      }
    "))
  ),
  titlePanel("MLB/AAA/FSL Stuff Dashboard (Load Times may take a while as app gathers Statcast Data)"),
  sidebarLayout(
    sidebarPanel(
      width = 2,
      dateRangeInput("date", "Date:"),
      selectizeInput("level", "Level:", c("MLB", "AAA", "FSL", "College (Statcast Parks Only)", "Draft League","AFL","Appy League")),
      actionButton("submit", "Get Dashboard"),
      downloadButton("download_summary", "Download Summary"),
      selectizeInput("pitcherf", "Pitcher Pitch Level Stuff", c("")),
      actionButton("pls", "Get Pitch Level Stuff"),
      downloadButton("download_pitch_level", "Download Pitch Level")
    ),
    mainPanel(
      dataTableOutput("schedule")
    )
  )
)

server <- function(input, output, session) {
  data <- reactiveVal()
  games <- reactiveVal()
  summary <- reactiveVal()
  pitch_level_data <- reactiveVal()
  
  observeEvent(input$submit, {
    season <- format(input$date[1], "%Y")
    if (input$level == "MLB") {
      data(mlb_schedule(season = season, level_ids = "1"))
    } else if (input$level == "AAA") {
      data(mlb_schedule(season = season, level_ids = "11"))
    } else if (input$level == "FSL") {
      data(mlb_schedule(season = season, level_ids = "14"))
    } else if (input$level == "College (Statcast Parks Only)") {
      data(mlb_schedule(season = season, level_ids = "22"))
    } else if (input$level == "Draft League"){
      draft <- mlb_schedule(season = season, level_ids = "22") %>%
        filter(teams_away_team_name == "Frederick Keys" |
              teams_away_team_name == "State College Spikes" |
              teams_away_team_name == "Trenton Thunder" |
              teams_away_team_name == "Williamsport Crosscutters" |
              teams_away_team_name == "West Virginia Black Bears" |
              teams_away_team_name == "Mahoning Valley Scrappers")
      data(draft)
    } 
      else if (input$level == "Appy League"){
      draft <- mlb_schedule(season = season, level_ids = "22") %>%
        filter(teams_away_team_name == "Bluefield Ridge Runners" |
              teams_away_team_name == "Burlington Sock Puppets" |
              teams_away_team_name == "Danville Otterbots" |
              teams_away_team_name == "Elizabethton River Riders" |
              teams_away_team_name == "Greeneville Flyboys" |
              teams_away_team_name == "Pulaski River Turtles" |
              teams_away_team_name == "Johnson City Doughboys" |
              teams_away_team_name == "Kingsport Axmen")
      data(draft)
    }
      else if (input$level == "AFL") {
      sbid <- mlb_schedule(2024,17) 
      sbid <- sbid %>%
          filter(teams_away_team_name == "Glendale Desert Dogs" |
              teams_away_team_name == "Mesa Solar Sox" |
              teams_away_team_name == "Peoria Javelinas" |
              teams_away_team_name == "Salt River Rafters" |
              teams_away_team_name == "Scottsdale Scorpions" |
              teams_away_team_name == "Surprise Saguaros") %>%
          filter(gameday_type == "E")
      data(sbid) 
    }
    
    schedule <- data()
    schedule <- schedule[schedule$date >= input$date[1] & schedule$date <= input$date[2], ]
    games <- data.frame(
      "Batter Name" = character(), "Batter ID" = numeric(), "Pitcher Name" = character(), "Pitcher ID" = numeric(),
      "result" = character(), "description" = character(), "pitch_name" = character(), "des" = character(),
      "start_speed" = numeric(), "plateTime" = numeric(), "zone" = numeric(), "spin_rate" = numeric(),
      "extension" = numeric(), "px" = numeric(), "pz" = numeric(), "x0" = numeric(), "y0" = numeric(), "z0" = numeric(),
      "ax" = numeric(), "ay" = numeric(), "az" = numeric(), "vx0" = numeric(), "vz0" = numeric(), "vy0" = numeric(),
      "pfxX" = numeric(), "pfxZ" = numeric(), "IVB" = numeric(), "HB" = numeric(), "hit_speed" = numeric(),
      "hit_angle" = numeric(), "hit_distance" = numeric(), "inPlay" = logical(), "lastPitch" = logical(),
      "spinDirection" = numeric(), "phand" = character(), "barrel" = numeric(), "is_strike_swinging" = numeric(),
      "date" = as.Date(character())
    )
    
    for(n in 1:nrow(schedule)){
      tryCatch({
        game1 <- pitcher_summary(schedule[n,6], schedule[n,1])
        games <- rbind(game1, games)
      }, error = function(e) {
        message(paste("Error occurred for game:", schedule[n,6], "on", schedule[n,1], "- Skipping this game."))
      })
    }
    
    games <- calculate_timstuff(games)
    games(games)
    summary_data <- summary_table(games)
    summary(summary_data)
    output$schedule <- renderDT({
      datatable(summary_data, options = list(
        pageLength = 10,
        lengthMenu = c(10, 25, 50, 100),
        columnDefs = list(
          list(className = 'dt-center', targets = "_all")
        )
      ))
    })
    updateSelectizeInput(session = getDefaultReactiveDomain(), "pitcherf", "Pitcher Pitch Level Stuff", games[, "Pitcher Name"])
  })
  
  observeEvent(input$pls, {
    games_data <- isolate(games())
    if (!is.null(games_data) && !is.null(input$pitcherf) && input$pitcherf != "") {
      games_data <- games_data[games_data$`Pitcher Name` == input$pitcherf, ]
      formatted_data <- format_output_data(games_data)
      pitch_level_data(formatted_data)
      output$schedule <- renderDT({
        datatable(formatted_data, options = list(
          pageLength = 10,
          lengthMenu = c(10, 25, 50, 100),
          columnDefs = list(
            list(className = 'dt-center', targets = "_all")
          )
        ))
      })
    } else {
      output$schedule <- renderDataTable(NULL)
      pitch_level_data(NULL)
    }
  })
  
  # Download handler for summary CSV
  output$download_summary <- downloadHandler(
    filename = function() {
      paste("summary_data_", Sys.Date(), ".csv", sep = "")
    },
    content = function(file) {
      write.csv(summary(), file, row.names = FALSE)
    }
  )
  
  # Download handler for pitch level CSV
  output$download_pitch_level <- downloadHandler(
    filename = function() {
      paste("pitch_level_data_", Sys.Date(), ".csv", sep = "")
    },
    content = function(file) {
      write.csv(pitch_level_data(), file, row.names = FALSE)
    }
  )
}

shinyApp(ui, server)