Spaces:

TimStats
/

TMSumC

Paused

TMSumC / app.R
Update app.R
fdb7bad verified over 1 year ago
35.4 kB
library(shiny)
library(plotly)
library(gridlayout)
library(bslib)
library(DT)
library(rsconnect)
library(baseballr)
library(dplyr)
library(tidyverse)
library(rvest)
library(ggplot2)
library(janitor)
library(ggthemes)
library(ggpubr)
library(jsonlite)
library(utils)
library(grid)
library(gridExtra)
library(png)
library(lightgbm)
library(httr)
library(jpeg)
library(zoo)
library(gtable)
library(xgboost)

options(shiny.maxRequestSize = 10000000 * 1024^2)
pdf(file = NULL)
Sys.setenv(TZ='EST')

check_patreon_access <- function(email) {
  campaign_id <- Sys.getenv("PATREON_CAMPAIGN_ID")
  access_token <- Sys.getenv("PATREON_ACCESS_TOKEN")
  
  base_url <- paste0("https://www.patreon.com/api/oauth2/v2/campaigns/", campaign_id, "/members")
  
  params <- list(
    `include` = "currently_entitled_tiers",
    `fields[member]` = "patron_status,email",
    `fields[tier]` = "title"
  )
  
  response <- GET(
    base_url,
    query = params,
    add_headers(
      `Authorization` = paste("Bearer", access_token),
      `User-Agent` = "R/httr"
    )
  )
  
  content <- fromJSON(rawToChar(response$content))
  
  # Check in data$attributes for matching email
  matching_row <- which(content$data$attributes$email == email)
  
  if (length(matching_row) > 0) {
    # Get patron status
    patron_status <- content$data$attributes$patron_status[matching_row]
    
    if (patron_status == "active_patron") {
      # Get tier info
      tier_data <- content$data$relationships$currently_entitled_tiers$data[[matching_row]]

      tier_id <- tier_data$id
      
      result <- tier_id %in% c("25062090")
      
      return(result)
    }
  }
  
  return(FALSE)
}

model <- xgb.load('TimStuff2.model')

# Helper functions
download_and_process_image <- function(url) {
  tryCatch({
    response <- GET(url)
    content_type <- http_type(response)
    
    if (content_type %in% c("image/png", "image/jpeg")) {
      temp_file <- tempfile(fileext = ifelse(content_type == "image/png", ".png", ".jpg"))
      writeBin(content(response, "raw"), temp_file)
      
      if (content_type == "image/png") {
        img <- readPNG(temp_file)
      } else {
        img <- readJPEG(temp_file)
      }
      
      return(list(img = img, type = content_type))
    } else {
      warning(paste("Unsupported image type:", content_type))
      return(NULL)
    }
  }, error = function(e) {
    warning(paste("Error processing image:", e$message))
    return(NULL)
  })
}

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

pitcher_summary <- function(tmilb){
  tmilb %>%
    select(Batter,Pitcher,PlayResult,PitchCall,TaggedPitchType,RelSpeed,SpinRate,
           Extension,PlateLocSide,PlateLocHeight,RelSide,RelHeight,ax0,ay0,az0,vx0,
           vz0,vy0,pfxx,pfxz,InducedVertBreak,HorzBreak,SpinAxis,PitcherThrows,BatterSide,PitchofPA,VertApprAngle,AutoPitchType) %>%
    rename(
      "Batter Name" = Batter, "Pitcher Name" = Pitcher, result = PlayResult,
      description = PitchCall, pitch_name = TaggedPitchType, start_speed = RelSpeed,
      spin_rate = SpinRate, extension = Extension, px = PlateLocSide, pz = PlateLocHeight,
      x0 = RelSide, z0 = RelHeight, ax = ax0, ay = ay0, az = az0, vx0 = vx0,
      vz0 = vz0, vy0 = vy0, pfxX = pfxx, pfxZ = pfxz, IVB = InducedVertBreak,
      HB = HorzBreak, spinDirection = SpinAxis, phand = PitcherThrows,
      bhand = BatterSide, PitchNum = PitchofPA, VAA = VertApprAngle, AutoPitchType = AutoPitchType
    ) %>%
    mutate(
      is_strike_swinging = ifelse(description == "StrikeSwinging", TRUE, FALSE),
      phand = ifelse(phand == "Right", "R", "L"),
      bhand = ifelse(bhand == "Right", "R", "L")
    )
}

break_plot <- function(game){
  game <- game %>% mutate(
    pitch_name = case_when(
      pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
      pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
      pitch_name %in% c("ChangeUp") ~ "Changeup",
      pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
      pitch_name %in% c("CutFastBall") ~ "Cutter",
      pitch_name %in% c('Undefined') ~ AutoPitchType,
      TRUE ~ pitch_name
    ))
  pitch_colors <- c(
    "Four-Seam"= "#FF4136", "Sinker"= "#FF851B", "Cutter"= "#FFDC00",
    "Changeup"= "#2ECC40", "Slider"= "#0074D9", "Sweeper"= "#ED68ED",
    "Curveball"= "#B10DC9", "Splitter"= "#01FF70", "Knuckle Curve"= "#85144b",
    "Slurve"= "#3D9970", "Knuckle Ball"= "#39CCCC", "Two-Seam Fastball"= "#F012BE",
    "Eephus"= "#AAAAAA", "Fastball"= "#7FDBFF", "Slow Curve"= "#DDDDDD",
    "Screwball"= "#FF69B4"
  )
  ggplot(game, aes(x = HB, y = IVB, color = pitch_name)) +
    geom_point(size = 2) +
    geom_vline(xintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    geom_hline(yintercept = 0, color = "lightblue", linewidth = 1, linetype = 4) +
    scale_color_manual(values = pitch_colors) +
    labs(x = "Horizontal Break (in)", y = "Induced Vertical Break (in)", 
         title = "Pitch Movement") +
    xlim(-25, 25) + ylim(-25, 25) + theme_minimal() +
    theme(
      legend.position = "bottom",
      plot.title = element_text(hjust = 0.5, face = "bold"),
      panel.grid.minor = element_line(color = "gray", size = 0.25, linetype = 1),
      aspect.ratio = 1
    ) +
    guides(color = guide_legend(title = "Pitch Type", nrow = 1))
}

pitch_plot <- function(game, title) {
  game <- game %>% mutate(
    pitch_name = case_when(
      pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
      pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
      pitch_name %in% c("ChangeUp") ~ "Changeup",
      pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
      pitch_name %in% c("CutFastBall") ~ "Cutter",
      pitch_name %in% c('Undefined') ~ AutoPitchType,
      TRUE ~ pitch_name
    ))
  pitch_colors <- c(
    "Four-Seam"= "#FF4136", "Sinker"= "#FF851B", "Cutter"= "#FFDC00",
    "Changeup"= "#2ECC40", "Slider"= "#0074D9", "Sweeper"= "#ED68ED",
    "Curveball"= "#B10DC9", "Splitter"= "#01FF70", "Knuckle Curve"= "#85144b",
    "Slurve"= "#3D9970", "Knuckle Ball"= "#39CCCC", "Two-Seam Fastball"= "#F012BE",
    "Eephus"= "#AAAAAA", "Fastball"= "#7FDBFF", "Slow Curve"= "#DDDDDD",
    "Screwball"= "#FF69B4"
  )
  ggplot(game, aes(x = px, y = pz, color = pitch_name)) +
    geom_point(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)) +
    scale_color_manual(values = pitch_colors) +
    labs(x = NULL, y = NULL, title = title) +
    xlim(-3, 3) + ylim(0.2, 4) + coord_fixed(ratio = 1) + theme_minimal() +
    theme(
      legend.position = "bottom",
      plot.title = element_text(hjust = 0.5, face = "bold"),
      axis.text = element_blank(),
      axis.ticks = element_blank()
    ) +
    guides(color = guide_legend(title = "Pitch Type", nrow = 1))
}

left_batter <- png::readPNG("left_batter.png")
right_batter <- png::readPNG("right_batter.png")

pitch_plot_split <- function(game, title) {
  game_lhb <- game %>% filter(bhand == "L") %>% mutate(
    pitch_name = case_when(
      pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
      pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
      pitch_name %in% c("ChangeUp") ~ "Changeup",
      pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
      pitch_name %in% c("CutFastBall") ~ "Cutter",
      pitch_name %in% c('Undefined') ~ AutoPitchType,
      TRUE ~ pitch_name
    ))
  game_rhb <- game %>% filter(bhand == "R") %>% mutate(
    pitch_name = case_when(
      pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
      pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
      pitch_name %in% c("ChangeUp") ~ "Changeup",
      pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
      pitch_name %in% c("CutFastBall") ~ "Cutter",
      pitch_name %in% c('Undefined') ~ AutoPitchType,
      TRUE ~ pitch_name
    ))
  
  # Define home plate coordinates (adjusted position)
  home_plate <- data.frame(
    x = c(0.6, -0.6, -0.7083, 0, 0.7083),  # Keep x-coordinates
    y = c(0.5, 0.5, 0.25, 0, 0.25)  # Adjust y-coordinates to put point at 0
  )
  
  pitch_colors <- c(
    "Four-Seam"= "#FF4136", "Sinker"= "#FF851B", "Cutter"= "#FFDC00",
    "Changeup"= "#2ECC40", "Slider"= "#0074D9", "Sweeper"= "#ED68ED",
    "Curveball"= "#B10DC9", "Splitter"= "#01FF70", "Knuckle Curve"= "#85144b",
    "Slurve"= "#3D9970", "Knuckle Ball"= "#39CCCC", "Two-Seam Fastball"= "#F012BE",
    "Eephus"= "#AAAAAA", "Fastball"= "#7FDBFF", "Slow Curve"= "#DDDDDD",
    "Screwball"= "#FF69B4"
  )  
  
  # Create left-handed batter plot
  plot_lhb <- ggplot(game_lhb, aes(x = -px, y = pz, color = pitch_name)) +
    # Add home plate first (so it appears under the points)
    geom_polygon(data = home_plate, aes(x = x, y = y), 
                 fill = "white", color = "black", inherit.aes = FALSE) +
    # Add batter image (now using left_batter on right side)
    annotation_custom(rasterGrob(left_batter, 
                                 width = unit(.75, "npc"),
                                 height = unit(1.5, "npc")),
                      xmin = .7, xmax = 3.2,
                      ymin = 1, ymax = 5) +
    geom_point(size = 3) +
    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)) +
    scale_color_manual(values = pitch_colors) +
    labs(x = NULL, y = NULL, title = "LHB") +
    xlim(-3, 3) +
    ylim(0, 5) +
    coord_fixed(ratio = 1) +
    theme_void() +
    theme(
      legend.position = "none",
      plot.title = element_text(hjust = 0.5, face = "bold"),
      axis.text = element_blank(),
      axis.ticks = element_blank()
    )
  
  # Create right-handed batter plot
  plot_rhb <- ggplot(game_rhb, aes(x = -px, y = pz, color = pitch_name)) +
    # Add home plate first
    geom_polygon(data = home_plate, aes(x = x, y = y), 
                 fill = "white", color = "black", inherit.aes = FALSE) +
    # Add batter image (now using right_batter on left side)
    annotation_custom(rasterGrob(right_batter, 
                                 width = unit(.75, "npc"),
                                 height = unit(1.5, "npc")),
                      xmin = -3, xmax = -0.5,
                      ymin = 1, ymax = 5) +
    geom_point(size = 3) +
    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)) +
    scale_color_manual(values = pitch_colors) +
    labs(x = NULL, y = NULL, title = "RHB") +
    xlim(-3, 3) +
    ylim(0, 5) +
    coord_fixed(ratio = 1) +
    theme_void() +
    theme(
      legend.position = "none",
      plot.title = element_text(hjust = 0.5, face = "bold"),
      axis.text = element_blank(),
      axis.ticks = element_blank()
    )
  
  return(list(lhb = plot_lhb, rhb = plot_rhb))
}

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

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

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

transform_statcast_data <- function(df, 
                                    release_extension_col = "extension",
                                    vx0_col = "vx0", 
                                    vy0_col = "vy0", 
                                    vz0_col = "vz0",
                                    ax_col = "ax", 
                                    ay_col = "ay", 
                                    az_col = "az",
                                    arm_angle_col = NULL,
                                    p_throws_col = NULL) {
  
  # Constants
  MOUND_DISTANCE <- 60.5
  STATCAST_INITIAL_MEASUREMENT <- 50.0
  Z_CONSTANT <- 32.174
  HOME_PLATE_HEIGHT <- 17/12  # Convert 17 inches to feet
  print("etds")
  # Compute release position
  df$release_pos_y <- MOUND_DISTANCE - df[[release_extension_col]]
  print("etds1")
  # Compute release time
  df$release_time <- (-df[[vy0_col]] - 
                        sqrt((df[[vy0_col]]^2) - 
                               (2 * df[[ay_col]] * (STATCAST_INITIAL_MEASUREMENT - df$release_pos_y)))) / df[[ay_col]]
  print("etds23")
  # Compute release velocities
  df$vxR <- df[[vx0_col]] + (df[[ax_col]] * df$release_time)
  df$vyR <- df[[vy0_col]] + (df[[ay_col]] * df$release_time)
  df$vzR <- df[[vz0_col]] + (df[[az_col]] * df$release_time)
  print("etds2")
  # Compute time to home plate
  df$tf <- (-df$vyR - sqrt(df$vyR^2 - 2 * df[[ay_col]] * (df$release_pos_y - HOME_PLATE_HEIGHT))) / df[[ay_col]]
  print("etds3")
  # Compute average velocities
  df$vxbar <- (2 * df$vxR + df[[ax_col]] * df$tf) / 2
  df$vybar <- (2 * df$vyR + df[[ay_col]] * df$tf) / 2
  df$vzbar <- (2 * df$vzR + df[[az_col]] * df$tf) / 2
  
  # Compute average velocity magnitude
  df$vbar <- sqrt(df$vxbar^2 + df$vybar^2 + df$vzbar^2)
  print("etds4")
  # Compute drag acceleration
  df$adrag <- -(df[[ax_col]] * df$vxbar + 
                  df[[ay_col]] * df$vybar + 
                  (df[[az_col]] + Z_CONSTANT) * df$vzbar) / df$vbar
  
  # Compute Magnus force components
  df$amagx <- df[[ax_col]] + df$adrag * df$vxbar / df$vbar
  df$amagy <- df[[ay_col]] + df$adrag * df$vybar / df$vbar
  df$amagz <- df[[az_col]] + df$adrag * df$vzbar / df$vbar + Z_CONSTANT
  
  # Compute Magnus force magnitude
  df$amag <- sqrt(df$amagx^2 + df$amagy^2 + df$amagz^2)
  
  # Original transformation calculations
  df$v_mag <- sqrt(df$vxR^2 + df$vyR^2 + df$vzR^2)
  
  # Compute tangential unit vectors
  df$tang_x <- df$vxR / df$v_mag
  df$tang_y <- df$vyR / df$v_mag
  df$tang_z <- df$vzR / df$v_mag
  print("etds5")
  # Handle arm angle and handedness
  if (!is.null(arm_angle_col)) {
    df$handedness_factor <- ifelse(df[[p_throws_col]] == "R", 1, -1)
    df$temp_x <- cos(df[[arm_angle_col]]) * df$handedness_factor
    df$temp_y <- 0
    df$temp_z <- sin(df[[arm_angle_col]])
  } else {
    df$temp_x <- 0
    df$temp_y <- rep(0, nrow(df))
    df$temp_z <- 1
  }
  
  # Compute horizontal vector
  df$horz_x <- df$temp_y * df$tang_z - df$temp_z * df$tang_y
  df$horz_y <- df$temp_z * df$tang_x - df$temp_x * df$tang_z
  df$horz_z <- df$temp_x * df$tang_y - df$temp_y * df$tang_x
  print("etds6")
  # Normalize horizontal vector
  df$horz_mag <- sqrt(df$horz_x^2 + df$horz_y^2 + df$horz_z^2)
  df$horz_x <- df$horz_x / df$horz_mag
  df$horz_y <- df$horz_y / df$horz_mag
  df$horz_z <- df$horz_z / df$horz_mag
  
  # Compute vertical vector
  df$vert_x <- df$tang_y * df$horz_z - df$tang_z * df$horz_y
  df$vert_y <- df$tang_z * df$horz_x - df$tang_x * df$horz_z
  df$vert_z <- df$tang_x * df$horz_y - df$tang_y * df$horz_x
  print("etds7")
  # Project accelerations
  df$a_tang <- df[[ax_col]] * df$tang_x + df[[ay_col]] * df$tang_y + df[[az_col]] * df$tang_z
  df$a_horz <- df[[ax_col]] * df$horz_x + df[[ay_col]] * df$horz_y + df[[az_col]] * df$horz_z
  df$a_vert <- df[[ax_col]] * df$vert_x + df[[ay_col]] * df$vert_y + df[[az_col]] * df$vert_z
  print("ets")
  # Clean up intermediate columns
  intermediate_cols <- c("temp_x", "temp_y", "temp_z", "handedness_factor",
                         "horz_mag", "horz_x", "horz_y", "horz_z",
                         "vert_x", "vert_y", "vert_z",
                         "tang_x", "tang_y", "tang_z")
  df <- df[, !names(df) %in% intermediate_cols]
  
  return(df)
}

calculate_timstuff <- function(game) {
  game <- game %>%
    mutate(
      VAA = calculate_VAA(vz0, ay, az, vy0, 50),
      EAA = calculate_EAA(extension),
      SADiff = calculate_SADiff(pfxX, pfxZ, spinDirection),
      Pitch = pitch_name,
      ishandL = ifelse(phand == "L", 1, 0)
    )
  
  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 <- if(any(!complete_rows)) {
    na_rows <- game[!complete_rows, ]
    na_rows$TimStuff <- NA
    na_rows
  } else {
    # Create empty data frame with same structure plus TimStuff
    empty_df <- game_complete[0, ]  # Get structure from game_complete
    empty_df$TimStuff <- numeric()  # Add empty TimStuff column
    empty_df
  }  
  
  if(nrow(game_complete) > 0) {
    pred_matrix <- as.matrix(game_complete[, feature_vars])
    predictions <- predict(model, pred_matrix)
    game_complete$TimStuff <- scale_TimStuff(predictions, -0.002620635, 0.006021368)
  }
  
  if(nrow(game_complete) > 0 && nrow(game_na) > 0) {
    game_result <- rbind(game_complete, game_na)
  } else if(nrow(game_complete) > 0) {
    game_result <- game_complete
  } else if(nrow(game_na) > 0) {
    game_result <- game_na
  } else {
    game_result <- game
  }
  
  return(game_result)
}
summary_table <- function(game) {
  
  game <- calculate_timstuff(game)
  
  if("TimStuff" %in% colnames(game)) {
    game <- game %>%
      mutate(TimStuff = ifelse(TimStuff < 50, NA, TimStuff))
  }
  
  # Calculate main summary
  main_summary <- game %>%
    mutate(
      team_fielding_id = ifelse(description %in% c("StrikeCalled", "StrikeSwinging"), 1, 0),
      swing = ifelse(description %in% c("FoulBall", "StrikeSwinging", "InPlay","FoulBallNotFieldable"), 1, 0),
      is_strike_swinging = as.integer(is_strike_swinging),
      pitch_name = case_when(
        pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
        pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
        pitch_name %in% c("ChangeUp") ~ "Changeup",
        pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
        pitch_name %in% c("CutFastBall") ~ "Cutter",
        pitch_name %in% c('Undefined') ~ AutoPitchType,
        TRUE ~ pitch_name
      ),
      Pitch = pitch_name,
      FPS = case_when(description %in% c("StrikeCalled","StrikeSwinging","FoulBallNotFieldable","FoulBall","InPlay") ~ TRUE, TRUE ~ FALSE),
    ) %>%
    group_by(Pitch) %>%
    summarize(
      Pitches = n(),
      'Pitch%' = round(n() / nrow(game) * 100, 1),
      "FP Strike%" = round(mean(FPS[PitchNum == 1], na.rm = TRUE) * 100, 1),
      'Avg. Velo' = round(mean(start_speed, na.rm = TRUE), 1),
      'Top Velo' = round(max(start_speed, na.rm = TRUE), 1),  # Add Top Velo
      'Spin Rate' = round(mean(spin_rate, na.rm = TRUE), 0),
      'Extension' = round(mean(extension, na.rm = TRUE), 1),
      'IVB' = round(mean(IVB, na.rm = TRUE), 1),
      'HB' = round(mean(HB, na.rm = TRUE), 1),
      'RelH' = round(mean(z0, na.rm = TRUE), digits = 1),
      'RelS' = round(mean(x0, na.rm = TRUE), digits = 1),
      'VAA' = round(mean(VAA, na.rm = TRUE), 1),
      'CSW%' = round(sum(team_fielding_id, na.rm = TRUE) / sum(!is.na(team_fielding_id)) * 100, 1),
      'Whiff%' = round(sum(is_strike_swinging, na.rm = TRUE) / sum(swing, na.rm = TRUE) * 100, 1),
      'TimStuff+' = if("TimStuff" %in% colnames(game)) round(mean(TimStuff, na.rm = TRUE), 0) else NA
    ) %>%
    arrange(-Pitches)
  
  # Calculate totals
  total_row <- game %>%
    mutate(
      team_fielding_id = ifelse(description %in% c("StrikeCalled", "StrikeSwinging"), 1, 0),
      swing = ifelse(description %in% c("FoulBall", "StrikeSwinging", "InPlay","FoulBallNotFieldable"), 1, 0),
      is_strike_swinging = as.integer(is_strike_swinging),
      FPS = case_when(description %in% c("StrikeCalled","StrikeSwinging","FoulBallNotFieldable","FoulBall") ~ TRUE, TRUE ~ FALSE)
    ) %>%
    summarize(
      Pitch = "Total",
      Pitches = n(),
      'Pitch%' = 100,
      "FP Strike%" = round(mean(FPS[PitchNum == 1], na.rm = TRUE) * 100, 1),
      'Avg. Velo' = NA_real_,
      'Top Velo' = round(max(start_speed, na.rm = TRUE), 1),  # Add overall top velo
      'Spin Rate' = NA_real_,
      'Extension' = round(mean(extension, na.rm = TRUE), 1),
      'IVB' = NA_real_,
      'HB' = NA_real_,
      'RelH' = round(mean(z0, na.rm = TRUE), digits = 1),
      'RelS' = round(mean(x0, na.rm = TRUE), digits = 1),
      'VAA' = round(mean(VAA, na.rm = TRUE), 1),
      'CSW%' = round(sum(team_fielding_id, na.rm = TRUE) / sum(!is.na(team_fielding_id)) * 100, 1),
      'Whiff%' = round(sum(is_strike_swinging, na.rm = TRUE) / sum(swing, na.rm = TRUE) * 100, 1),
      'TimStuff+' = if("TimStuff" %in% colnames(game)) round(mean(TimStuff, na.rm = TRUE), 0) else NA
    )
  
  # Combine main summary with total row
  combined_summary <- bind_rows(main_summary, total_row) %>%
    rename(
      "Type" = Pitch, "#" = Pitches, "Velo" = `Avg. Velo`,
      "Top" = `Top Velo`,  # Rename Top Velo to shorter column name
      "Spin" = `Spin Rate`, "Ext" = Extension, "Usage%" = `Pitch%`
    ) %>%
    mutate(
      "Usage%" = paste0(`Usage%`, "%"),
      "Spin" = ifelse(Type == "Total", "-", format(round(as.numeric(Spin)), big.mark = ",")),
      "Velo" = ifelse(Type == "Total", "-", as.character(Velo)),
      "IVB" = ifelse(Type == "Total", "-", as.character(IVB)),
      "HB" = ifelse(Type == "Total", "-", as.character(HB)),
      `CSW%` = paste0(`CSW%`, "%"),
      `Whiff%` = paste0(`Whiff%`, "%"),
      `FP Strike%` = paste0(`FP Strike%`, "%")
    )
  
  return(combined_summary)
}

# Modify the UI
ui <- fluidPage(
  theme = bs_theme(bg = "#ffffff", fg = "#333333", primary = "#428bca"),
    tagList(
    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; }
        .login-screen {
          max-width: 400px;
          margin: 100px auto;
          padding: 20px;
          border: 1px solid #ddd;
          border-radius: 5px;
          box-shadow: 0 0 10px rgba(0,0,0,0.1);
        }
        .login-header {
          text-align: center;
          margin-bottom: 20px;
        }
      "))
    ),
    
    # Use uiOutput to conditionally render either login or main page
    uiOutput("page")
  )
)

# Server Definition
server <- function(input, output, session) {
  credentials <- reactiveValues(logged_in = FALSE)
  output$page <- renderUI({
    if (!credentials$logged_in) {
      # Login page
      div(class = "login-screen",
          div(class = "login-header",
              h2("Baseball Stats Visualization"),
              p("Please log in with your Patreon email")
          ),
          textInput("email", "Email:"),
          actionButton("login", "Login", class = "btn-primary"),
          p(style = "margin-top: 20px; text-align: center;",
            "Access requires Veteran or Hall of Fame tier on Patreon")
      )
    } else {
    fluidPage(
      titlePanel("Trackman Summary Card"),
      sidebarLayout(
        sidebarPanel(
          width = 3,
          fileInput("incsv", "Input File", accept = c(".csv"), multiple = FALSE),
          actionButton("update", "Load Pitchers", icon("magnifying-glass"),
                       class = "btn-primary btn-block"),
          selectizeInput("pitcher", "Pitcher Name:", NULL),
          numericInput("rollnum", "Rolling Pitch #", c("1")),
          actionButton("update1", "Make Card", icon("plus"),
                       class = "btn-success btn-block"),
          downloadButton("downloadPlot", "Download Card", class = "btn-info btn-block")
        ),
      mainPanel(
        div(style = "width: 1000px; height: 1000px; overflow: auto;",
            plotOutput("combinedPlot", width = "100%", height = "100%")
        )
      )
      )
    )
    }
  })
  observeEvent(input$login, {
    
    # Check Patreon access
    has_access <- check_patreon_access(input$email)
    
    if (has_access) {
      credentials$logged_in <- TRUE
    } else {
      showModal(modalDialog(
        title = "Access Denied",
        "This email does not have access. Please make sure you're using the email associated with your Patreon account and you have an active Hall of Fame tier subscription.",
        easyClose = TRUE
      ))
    }
  })

  game_data <- reactiveVal()
  
  observeEvent(input$update, {
    req(input$incsv)
    df <- read.csv(input$incsv$datapath)
    pname <- pitcher_summary(df)
    game_data(pname)
    if(nrow(pname) == 0) {
      showNotification("No pitchers found for the selected game.", type = "warning")
    } else {
      updateSelectizeInput(session, "pitcher", "Pitcher:", choices = unique(pname$`Pitcher Name`))
      game_data(pname)
    }
  })
  
  rolling_timstuff <- reactive({
    req(input$update1, game_data())
    game <- game_data() %>% filter(`Pitcher Name` == input$pitcher)# %>%
    #   mutate(
    #    pitch pitch_name %in% c("ChangeUp") ~ "Changeup",
    #       _name = case_when(
    #        pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
    #        pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
    #        pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
    #       pitch_name %in% c("CutFastBall") ~ "Cutter",
    #        TRUE ~ pitch_name
    #      ))
    game <- calculate_timstuff(game)
    print("Test")
    print(game)
    print(nrow(game))
    #names(game)
    game <- game %>%
      mutate(TimStuff = ifelse(TimStuff < 40, NA, TimStuff))
    
    custom_rollmean <- function(x, k) {
      n <- length(x)
      result <- numeric(n)
      
      for (i in 1:n) {
        if (i < k) {
          # For the first k-1 points, use a window size of 1 (i.e., the point itself)
          result[i] <- x[i]
        } else {
          # For k and onwards, use the specified rolling window
          window <- x[(i-k+1):i]
          result[i] <- mean(window, na.rm = TRUE)
        }
      }
      
      return(result)
    }
    
    result <- game %>%
      group_by(pitch_name) %>%
      mutate(
        TimStuff = as.numeric(TimStuff),
        rolling_timstuff = custom_rollmean(TimStuff, k = input$rollnum),
        pitch_number = row_number()
      ) %>%
      ungroup()
    
    return(result)
  })
  
  combinedPlot <- reactiveVal()
  
  observeEvent(input$update1,{
      req(game_data())
      game <- game_data() %>% filter(`Pitcher Name` == input$pitcher)
      
      if(nrow(game) == 0) {
        showNotification("No data available for the selected pitcher.", type = "warning")
        return()
      }
      get_logo <- function() {
        if (FALSE) {
          # Try to get team logo using the selected team ID
          logo_url <- paste0("https://static.trumedianetworks.com/images/ncaabaseball/teams/", input$teamName, ".png")
          img_result <- download_and_process_image(logo_url)
          
          if (!is.null(img_result)) {
            return(rasterGrob(img_result$img, interpolate = TRUE))
          }
        }
        
        # Fallback to default logo
        default_url <- "https://pbs.twimg.com/profile_images/1754697221595910144/xziLC-5v_400x400.jpg"
        img_result <- download_and_process_image(default_url)
        
        if (!is.null(img_result)) {
          return(rasterGrob(img_result$img, interpolate = TRUE))
        } else {
          return(textGrob("Image not available", gp = gpar(col = "red", fontsize = 20)))
        }
      }
      
      # Get the logo once and use it twice
      logo_grob <- get_logo()
      
      break_plot <- break_plot(game) + theme(legend.position = "none")
      pitch_plots <- pitch_plot_split(game)
      
      table_data <- summary_table(game)
      num_rows <- nrow(table_data)
      
      print(table_data)  
      table_plot <- tableGrob(table_data, rows = NULL, theme = ttheme_minimal(
        core = list(fg_params = list(hjust = 0.5, x = 0.5), bg_params = list(fill = "white")),
        colhead = list(fg_params = list(hjust = 0.5, x = 0.5, fontface = "bold"), bg_params = list(fill = "#f0f0f0")),
        rowhead = list(fg_params = list(hjust = 0.5, x = 0.5), bg_params = list(fill = "white"))
      ))
      
      total_height <- unit(1, "npc")
      row_height <- total_height / (num_rows + 1)
      table_plot$heights <- unit(rep(row_height, num_rows + 1), "npc")
      
      table_plot$widths <- unit(c(
        0.07,  # Type
        0.04,  # #
        0.08,  # Usage%
        0.08,  # FP Strike%
        0.05,  # Velo
        0.05,  # Top
        0.08,  # Spin
        0.05,  # Ext
        0.05,  # IVB
        0.05,  # HB
        0.04,  # RelH
        0.04,  # RelS
        0.06,  # VAA
        0.06,  # CSW%
        0.06,  # Whiff%
        0.06   # Stuff+
      ), "npc")
      
      for(i in seq(2, nrow(table_plot), 2)) {
        table_plot$grobs[[i]]$gp$fill <- "#f9f9f9"
      }
      
      milb_url <- "https://x.com/TimStats/photo"
      mlb_url <- "https://pbs.twimg.com/profile_images/1754697221595910144/xziLC-5v_400x400.jpg"
      img_result <- download_and_process_image(mlb_url)
      if (is.null(img_result)) {
        img_result <- download_and_process_image(milb_url)
      }
      
      img_grob <- if (!is.null(img_result)) {
        rasterGrob(img_result$img, interpolate = TRUE)
      } else {
        textGrob("Image not available", gp = gpar(col = "red", fontsize = 20))
      }
      
      pitch_colors <- c(
        "Four-Seam"= "#FF4136", "Sinker"= "#FF851B", "Cutter"= "#FFDC00",
        "Changeup"= "#2ECC40", "Slider"= "#0074D9", "Sweeper"= "#ED68ED",
        "Curveball"= "#B10DC9", "Splitter"= "#01FF70", "Knuckle Curve"= "#85144b",
        "Slurve"= "#3D9970", "Knuckle Ball"= "#39CCCC", "Two-Seam Fastball"= "#F012BE",
        "Eephus"= "#AAAAAA", "Fastball"= "#7FDBFF", "Slow Curve"= "#DDDDDD",
        "Screwball"= "#FF69B4"
      )
      
      # Create the rolling TimStuff+ graph
      rolling_data <- rolling_timstuff() %>%
        mutate(
          pitch_name = case_when(
            pitch_name %in% c("Fastball", "FourSeamFastBall") ~ "Four-Seam",
            pitch_name %in% c("TwoSeamFastBall", "OneSeamFastBall", "Sinker") ~ "Sinker",
            pitch_name %in% c("ChangeUp") ~ "Changeup",
            pitch_name %in% c("KnuckleCurve") ~ "Knuckle Curve",
            pitch_name %in% c("CutFastBall") ~ "Cutter",
            pitch_name %in% c('Undefined') ~ AutoPitchType,
            TRUE ~ pitch_name
          ))
      timstuff_plot <- ggplot(rolling_data, aes(x = pitch_number, y = rolling_timstuff, color = pitch_name)) +
        geom_line(size = 1, na.rm = TRUE) +
        geom_point(size = 1, na.rm = TRUE) +
        scale_color_manual(values = pitch_colors) +
        theme_minimal() +
        labs(title = paste0(input$rollnum,"-Pitch Rolling TimStuff+"),
             x = "Pitch Number", y = "TimStuff+") +
        scale_y_continuous(limits = c(70, 130), na.value = NA) +
        scale_x_continuous(breaks = seq(input$rollnum, max(rolling_data$pitch_number, na.rm = TRUE), by = input$rollnum), limits = c(input$rollnum, NA)) +
        theme(
          plot.title = element_text(hjust = 0.5, face = "bold"),
          legend.position = "none",
          panel.grid.major.x = element_line(color = "gray", size = 0.5)
        )
      
      # If there's no valid data, display a message
      if(all(is.na(rolling_data$rolling_timstuff))) {
        timstuff_plot <- ggplot() + 
          theme_void() +
          labs(title = "Insufficient data for Stuff+ calculation") +
          theme(
            plot.title = element_text(hjust = 0.5, face = "bold")
          )
      }
      
      title_text <- textGrob(
        paste(input$pitcher, input$title, "Summary Card by @TimStats"),
        gp = gpar(fontsize = 16, fontface = "bold")
      )
      
      data_source_text <- textGrob(
        " ",
        gp = gpar(fontsize = 8),
        x = unit(1, "npc") - unit(2, "mm"),
        y = unit(2, "mm"),
        just = c("right", "bottom")
      )
      
      legend <- if(nrow(rolling_data) > 0) {
        get_legend(
          ggplot(rolling_data, aes(x = pitch_number, y = rolling_timstuff, color = pitch_name)) +
            geom_point(size = 5) +
            scale_color_manual(values = pitch_colors) +
            theme(legend.position = "bottom",
                  legend.title = element_blank(),
                  text = element_text(size = 12.5),
                  legend.box = "horizontal" ) +
            guides(color = guide_legend(nrow = 1))
        )
      } else {
        ggplotGrob(ggplot() + theme_void())
      }
      
      # Combine all plots
      combined <- grid.arrange(
        # Row 1: Title and Player Image
        arrangeGrob(
          img_grob,
          title_text,
          logo_grob,
          ncol = 3,
          widths = c(1, 2, 1)
        ),
        
        # Row 2: Rolling TimStuff+ graph and boxscore
        arrangeGrob(
          timstuff_plot,
          break_plot,
          ncol = 2,
          widths = c(2,1)
        ),
        
        # Row 3: Three plots in a row
        arrangeGrob(
          pitch_plots$lhb,
          pitch_plots$rhb,
          ncol = 2,
          widths = c(1,1)
        ),
        
        # Row 4: Legend
        legend,
        
        # Row 5: Pitch summary table
        table_plot,
        
        # Layout parameters
        nrow = 5,
        heights = c(0.8, 1.2, 1.2, 0.2, 1)
      )
      grid.arrange(
        gtable_add_padding(
          combined,
          padding = unit(c(20, 20, 20, 20), "points")  # top, right, bottom, left margins
        )
      ) 
      combinedPlot(combined)
      
      output$combinedPlot <- renderPlot({
        grid.draw(combinedPlot())
      }, width = 1200, height = 1200)
      
      output$combinedPlot <- renderPlot({
        grid.draw(combinedPlot())
      }, width = 1000, height = 1000)  # Modified to be square
      
      # Update the download handler dimensions
      output$downloadPlot <- downloadHandler(
        filename = function() {
          paste("baseball_card_", Sys.Date(), ".png", sep = "")
        },
        content = function(file) {
          ggsave(file, plot = combinedPlot(), width = 15, height = 15, dpi = 300, units = "in")  # Modified to be square
        }
      )
  })
}

# Run the application
shinyApp(ui = ui, server = server)