app.R

library(shiny)
library(dplyr)
library(ggplot2)
library(utils)
library(httr)

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) {
    # Get content as text first to check if it's an LFS pointer
    content_text <- content(response, "text", encoding = "UTF-8")
    
    # Check if this is an LFS pointer (LFS files start with "version https://git-lfs.github.com/spec/")
    if (grepl("^version https://git-lfs.github.com/spec/", content_text)) {
      # This is an LFS file - extract the oid (hash) from the pointer
      oid_line <- grep("oid sha256:", strsplit(content_text, "\n")[[1]], value = TRUE)
      oid <- gsub("oid sha256:", "", oid_line)
      oid <- trimws(oid)
      
      # Construct the LFS content URL
      lfs_url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/.git/lfs/objects/", 
                        substr(oid, 1, 2), "/", substr(oid, 3, 4), "/", oid)
      
      # Get the actual content from LFS storage
      lfs_response <- GET(lfs_url, add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))))
      
      if (status_code(lfs_response) == 200) {
        content_text <- content(lfs_response, "text", encoding = "UTF-8")
      } else {
        # Alternative LFS URL format
        lfs_url <- paste0("https://huggingface.co/datasets/", repo_id, "/lfs/resolve/main/", filename, "?download=true")
        lfs_response <- GET(lfs_url, add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))))
        
        if (status_code(lfs_response) == 200) {
          content_text <- content(lfs_response, "text", encoding = "UTF-8")
        } else {
          stop(paste("Failed to download LFS content. Status code:", status_code(lfs_response)))
        }
      }
    }
    
    # Process the content (whether it was LFS or regular)
    con <- textConnection(content_text)
    tryCatch({
      data <- read.csv(con, 
                      header = TRUE,
                      check.names = FALSE,
                      fileEncoding = "UTF-8",
                      stringsAsFactors = FALSE)
      return(data)
    }, error = function(e) {
      close(con)
      stop(paste("Error parsing CSV:", e$message))
    }, finally = {
      close(con)
    })
  } else {
    stop(paste("Failed to download dataset. Status code:", status_code(response)))
  }
}
download_private_parquet <- function(repo_id, filename) {
  library(httr)
  library(arrow)
  
  # Create the direct download URL based on your example
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename, "?download=true")
  
  # Create a temporary file
  temp_file <- tempfile(fileext = ".parquet")
  
  # Download directly to file
  response <- GET(
    url,
    add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))),
    write_disk(temp_file, overwrite = TRUE)
  )
  
  # Check if download was successful
  if (status_code(response) == 200) {
    tryCatch({
      # Read the parquet file
      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)))
  }
}
MLB26 <- download_private_parquet("TimStats/StatcastDataAll", "MLB26.parquet")
MLB26$level <- "MLB"
MLB25 <- download_private_parquet("TimStats/StatcastDataAll", "MLB25.parquet")
MLB25$level <- "MLB"
#names(ST)
MLB <- download_private_parquet("TimStats/StatcastDataAll", "MLB.parquet")
MLB$level <- "MLB"
data1 <- rbind(MLB,MLB25,MLB26)
#data1 <- read.csv("data1.csv", header = TRUE, check.names = FALSE, fileEncoding = "UTF-8")
#data1 <- data1[,2:54]

AAaveragePT <- data1 %>%
mutate(arm_angle = round(arm_angle, digits = 0)) %>%
group_by(arm_angle, phand, pitch_name) %>%
summarise(
  AvgIVB = mean(IVB, na.rm = TRUE),
  AvgHB = mean(HB, na.rm = TRUE),
  .groups = 'drop'
  )

pitch_type_lookup <- data.frame(
    pitch_name = c("Changeup", "Curveball", "Cutter", "Eephus", "Forkball", 
                   "Four-Seam Fastball", "Knuckle Ball", "Knuckle Curve", 
                   "Screwball", "Sinker", "Slider", "Slurve", "Splitter", "Sweeper"),
    pitch_abbr = c("CH", "CU", "FC", "EP", "FO", "FF", "KN", "KC", 
                   "SC", "SI", "SL", "SV", "FS", "ST"),
    stringsAsFactors = FALSE
)

pitch_colors <- c(
  "FF" = "#FF4136", 
  "SI" = "#FF851B", 
  "FC" = "#FFDC00",
  "CH" = "#2ECC40", 
  "SL" = "#0074D9", 
  "ST" = "#ED68ED",
  "CU" = "#B10DC9", 
  "FS" = "#01FF70", 
  "KC" = "#85144b",
  "SV" = "#3D9970", 
  "KN" = "#39CCCC", 
  "FO" = "#F012BE",
  "EP" = "#AAAAAA", 
  "FA" = "#7FDBFF", 
  "SC" = "#FF69B4"
)

break_plot_Szn <- function(game, data1, sdate, edate) {
  # Calculate pitch usage percentages
  
  game <- game %>% filter(between(as.Date(date), sdate, edate))
  total_pitches <- nrow(game)
  usage_stats <- game %>%
    group_by(pitch_name) %>%
    summarise(
      count = n(),
      usage = sprintf("%.1f%%", (count/total_pitches) * 100)
    )
  
  game <- game %>% 
    left_join(pitch_type_lookup, by = c("pitch_name")) %>%
    left_join(usage_stats, by = "pitch_name")
  
  
  game <- game %>% filter(!is.na(pitch_abbr))
  title <- paste0(unique(game$`Pitcher Name`)," ",sdate," to ",edate)
  pitcher_hand <- unique(game$phand)
  
  angle_degrees <- round(mean(game$arm_angle,na.rm = TRUE),digits = 1)
  angle_radians <- angle_degrees * (pi / 180)
  
  if(pitcher_hand == "L") {
    leg <- c(0.08, .22)
    factor <- -1
  } else {
    leg <- c(0.92, .22)
    factor <- 1
  }
  
  x_end <- 50 * cos(angle_radians) * factor
  y_end <- 50 * sin(angle_radians)
  
  # Create the base color mapping
  game_pitches <- unique(game$pitch_abbr)
  used_colors <- pitch_colors[game_pitches]
  
  # Add usage to the game data
  avg_locations <- game %>%
    group_by(pitch_abbr) %>%
    summarize(
      avg_HB = mean(HB, na.rm = TRUE),
      avg_IVB = mean(IVB, na.rm = TRUE),
      usage = first(usage)  # Keep the usage info
    )
  
  # Create labels with percentages
  legend_labels <- paste0(names(used_colors), " (", 
                          avg_locations$usage[match(names(used_colors), avg_locations$pitch_abbr)], ")")
  
  # Create the color scale with usage labels
  fill_values <- used_colors
  names(fill_values) <- legend_labels
  
  arm_angle_data <- data1 %>%
    filter(!is.na(arm_angle), !is.na(phand), !is.na(pitch_name)) %>%
    filter(abs(round(arm_angle) - angle_degrees) <= 2, phand == pitcher_hand) %>%
    left_join(pitch_type_lookup, by = c("pitch_name")) %>%
    filter(!is.na(pitch_abbr)) %>%
    filter(pitch_abbr %in% game_pitches)
  
  ggplot(game, aes(x = HB, y = IVB)) +
    geom_vline(xintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    geom_hline(yintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    # Ellipses
    stat_ellipse(
      data = arm_angle_data,
      aes(fill = paste0(pitch_abbr, " (", 
                        avg_locations$usage[match(pitch_abbr, avg_locations$pitch_abbr)], ")")),
      geom = "polygon",
      alpha = 0.2,
      level = 0.68,
      show.legend = FALSE
    ) +
    # Average points
    geom_point(
      data = avg_locations,
      aes(x = avg_HB, y = avg_IVB, 
          fill = paste0(pitch_abbr, " (", usage, ")")),
      color = "black", 
      size = 6, 
      stroke = .5, 
      shape = 21
    ) +
    # Arm angle line
    geom_segment(x = 0, y = 0, xend = x_end, yend = y_end, 
                 color = "red", linewidth = 1, linetype = 5) +
    scale_fill_manual(values = fill_values) +
    labs(
      x = "Horizontal Break (in)",
      y = "Induced Vertical Break (in)", 
      title = title,
      subtitle = paste0("Arm Angle: ", angle_degrees, "\u00b0"),
      caption = "Data: MLB | Viz: @TimStats | tim-stats.com\nEllipses show average movement for same-handed pitchers at similar arm angles"
    ) +
    xlim(-25, 25) +
    ylim(-25, 25) +
    theme_minimal() +
    theme(
      legend.position = leg,
      plot.title = element_text(hjust = 0.5, face = "bold", color = "white"),
      plot.subtitle = element_text(hjust = 0.5, face = "italic", color = "white"),
      aspect.ratio = 1,
      plot.background = element_rect(fill = "#333333", color = NA),
      panel.background = element_rect(fill = "#333333", color = NA),
      axis.text = element_text(color = "white"),
      axis.title = element_text(color = "white"),
      legend.background = element_rect(fill = "#333333"),
      legend.text = element_text(color = "white"),
      legend.title = element_blank(),
      plot.margin = margin(10, 5, 10, 5),
      axis.line = element_blank(),
      axis.ticks = element_line(color = "white"),
      panel.grid = element_blank(),
      legend.key = element_blank(),
      plot.caption = element_text(
        color = "white",
        hjust = 0.5
      ),
      panel.border = element_blank()
    )
}

break_plot_tot <- function(game, data1, sdate, edate) {
  # Calculate pitch usage percentages
  game <- game %>% filter(between(as.Date(date), sdate, edate))
  total_pitches <- nrow(game)
  usage_stats <- game %>%
    group_by(pitch_name) %>%
    summarise(
      count = n(),
      usage = sprintf("%.1f%%", (count/total_pitches) * 100)
    )

  game <- game %>% 
    left_join(pitch_type_lookup, by = c("pitch_name")) %>%
    left_join(usage_stats, by = "pitch_name")

  game <- game %>% filter(!is.na(pitch_abbr))
  title <- paste0(unique(game$`Pitcher Name`)," ",sdate," to ",edate)
  pitcher_hand <- unique(game$phand)
  
  angle_degrees <- round(mean(game$arm_angle,na.rm = TRUE),digits = 1)
  angle_radians <- angle_degrees * (pi / 180)
  
  if(pitcher_hand == "L") {
    leg <- c(0.08, .22)
    factor <- -1
  } else {
    leg <- c(0.92, .22)
    factor <- 1
  }
  
  x_end <- 50 * cos(angle_radians) * factor
  y_end <- 50 * sin(angle_radians)
  
  # Create the base color mapping
  game_pitches <- unique(game$pitch_abbr)
  used_colors <- pitch_colors[game_pitches]
  
  # Add usage to the game data
  avg_locations <- game %>%
    group_by(pitch_abbr) %>%
    summarize(
      avg_HB = mean(HB, na.rm = TRUE),
      avg_IVB = mean(IVB, na.rm = TRUE),
      usage = first(usage)  # Keep the usage info
    )
  
  # Create labels with percentages
  legend_labels <- paste0(names(used_colors), " (", 
                          avg_locations$usage[match(names(used_colors), avg_locations$pitch_abbr)], ")")
  
  # Create the color scale with usage labels
  fill_values <- used_colors
  names(fill_values) <- legend_labels
  
  arm_angle_data <- data1 %>%
    filter(!is.na(arm_angle), !is.na(phand), !is.na(pitch_name)) %>%
    filter(abs(round(arm_angle) - angle_degrees) <= 2, phand == pitcher_hand) %>%
    left_join(pitch_type_lookup, by = c("pitch_name")) %>%
    filter(!is.na(pitch_abbr)) %>%
    filter(pitch_abbr %in% game_pitches)
  
  ggplot(game, aes(x = HB, y = IVB)) +
    geom_vline(xintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    geom_hline(yintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    # Ellipses
    stat_ellipse(
      data = arm_angle_data,
      aes(fill = paste0(pitch_abbr, " (", 
                        avg_locations$usage[match(pitch_abbr, avg_locations$pitch_abbr)], ")")),
      geom = "polygon",
      alpha = 0.2,
      level = 0.68,
      show.legend = FALSE
    ) +
    # Individual points
    geom_point(
      aes(fill = paste0(pitch_abbr, " (", usage, ")")), 
      color = "#c6c6c6", 
      size = 3, 
      stroke = .5, 
      shape = 21
    ) +
    # Average points
    geom_point(
      data = avg_locations,
      aes(x = avg_HB, y = avg_IVB, 
          fill = paste0(pitch_abbr, " (", usage, ")")),
      color = "black", 
      size = 6, 
      stroke = .5, 
      shape = 21
    ) +
    # Arm angle line
    geom_segment(x = 0, y = 0, xend = x_end, yend = y_end, 
                 color = "red", linewidth = 1, linetype = 5) +
    scale_fill_manual(values = fill_values) +
    labs(
      x = "Horizontal Break (in)",
      y = "Induced Vertical Break (in)", 
      title = title,
      subtitle = paste0("Arm Angle: ", angle_degrees, "\u00b0"),
      caption = "Data: MLB | Viz: @TimStats | tim-stats.com\nEllipses show average movement for same-handed pitchers at similar arm angles"
    ) +
    xlim(-25, 25) +
    ylim(-25, 25) +
    theme_minimal() +
    theme(
      legend.position = leg,
      plot.title = element_text(hjust = 0.5, face = "bold", color = "white"),
      plot.subtitle = element_text(hjust = 0.5, face = "italic", color = "white"),
      aspect.ratio = 1,
      plot.background = element_rect(fill = "#333333", color = NA),
      panel.background = element_rect(fill = "#333333", color = NA),
      axis.text = element_text(color = "white"),
      axis.title = element_text(color = "white"),
      legend.background = element_rect(fill = "#333333"),
      legend.text = element_text(color = "white"),
      legend.title = element_blank(),
      plot.margin = margin(10, 5, 10, 5),
      axis.line = element_blank(),
      axis.ticks = element_line(color = "white"),
      panel.grid = element_blank(),
      legend.key = element_blank(),
      plot.caption = element_text(
        color = "white",
        hjust = 0.5
      ),
      panel.border = element_blank()
    )
}
ui <- fluidPage(
  # Application title
  titlePanel("2020-2025 MLB Pitch Plots"),
  
  sidebarLayout(
    sidebarPanel(
      width = 3,  
      selectInput("player", "Select Player:", choices = unique(data1$`Pitcher Name`),
                  width = "100%"),  
      dateRangeInput("date1", "Dates: (Be wary of multi year plots as arm angles may vary over years)", 
                     start = "2026-03-18", 
                     end = Sys.Date(),
                     width = "100%"),  
      radioButtons("type", "Plot Type", 
                   choices = c("Season Average","All Pitches")),
      actionButton("submit", "Update Plot", 
                   class = "btn btn-primary btn-block",  
                   style = "margin-bottom: 10px"), 
      downloadButton("download", "Download Plot", 
                     class = "btn btn-success btn-block") 
    ),
    
    
    mainPanel(
      width = 9, 
      plotOutput("Plot",height = "1200px",width = "100%")
    )
  )
)

# Define server
server <- function(input, output, session) {
  # Create a reactive value to store current plot settings
  plotSettings <- reactiveVal(list(
    player = NULL,
    type = "Season Average",
    dates = c(as.Date("2024-03-20"), as.Date("2024-10-01"))
  ))
  
  # Update settings only when submit is clicked
  observeEvent(input$submit, {
    plotSettings(list(
      player = input$player,
      type = input$type,
      dates = c(input$date1[1], input$date1[2])
    ))
  })
  
  output$Plot <- renderPlot({
    settings <- plotSettings()
    req(settings$player)  # Wait until we have a player selected
    
    game <- data1 %>%
      filter(`Pitcher Name` == settings$player)
    
    if(nrow(game) == 0) {
      return(ggplot() + 
               annotate("text", x = 0.5, y = 0.5, 
                        label = "No data available for selected date range", 
                        color = "white") +
               theme_void() +
               theme(plot.background = element_rect(fill = "#333333", color = NA)))
    }
    
    if(settings$type == "Season Average"){
      break_plot_Szn(game, data1, settings$dates[1], settings$dates[2])
    } else{
      break_plot_tot(game, data1, settings$dates[1], settings$dates[2])
    }
  }, width = 750, height = 750, bg = "#333333")
  
  output$download <- downloadHandler(
    filename = function() {
      settings <- plotSettings()
      paste0(
        gsub(" ", "_", settings$player), "_",
        format(settings$dates[1], "%Y%m%d"), "_to_",
        format(settings$dates[2], "%Y%m%d"), ".png"
      )
    },
    content = function(file) {
      settings <- plotSettings()
      
      game <- data1 %>%
        filter(`Pitcher Name` == settings$player)
      
      plot <- if(settings$type == "Season Average"){
        break_plot_Szn(game, data1, settings$dates[1], settings$dates[2])
      } else{
        break_plot_tot(game, data1, settings$dates[1], settings$dates[2])
      }
      
      ggsave(file,
             plot = plot,
             width = 10,
             height = 10,
             dpi = 300,
             bg = "#333333") 
    }
  )
}

shinyApp(ui = ui, server = server)