Update app.R

app.R

@@ -114,7 +114,53 @@ pitcher_summary <- function(game_pk,date){
   return(tmilb)
 }
 
+calculate_primary <- function(data){
+  data <- data %>%
+    # Group by pitch_name, Pitcher Name, Pitcher Id, and date
+    group_by(pitch_name, `Pitcher Name`, `Pitcher ID`, date) %>%
+    
+    # Count occurrences and calculate average start_speed, IVB, and HB for each group
+    mutate(
+      pitch_count = n(),
+      avg_start_speed = mean(start_speed, na.rm = TRUE),
+      avg_IVB = mean(IVB, na.rm = TRUE),
+      avg_HB = mean(HB, na.rm = TRUE)
+    ) %>%
+    
+    ungroup() %>%
+    # Group by Pitcher Name, Pitcher Id, and date
+    group_by(`Pitcher Name`, `Pitcher ID`, date) %>%
+    
+    # Add a column to identify the highest occurrence
+    mutate(
+      is_highest_occurrence = case_when(
+        pitch_count == max(pitch_count) ~ 1,
+        TRUE ~ 0
+      )
+    ) %>%
+    
+    # If there's a tie, use avg_start_speed as a tiebreaker
+    mutate(
+      is_highest_occurrence = case_when(
+        is_highest_occurrence == 1 & pitch_count == max(pitch_count[is_highest_occurrence == 1]) & 
+          avg_start_speed == max(avg_start_speed[is_highest_occurrence == 1]) ~ 1,
+        TRUE ~ 0
+      )
+    ) %>%
+    
+    # Calculate primary pitch metrics
+    mutate(
+      primary_speed = avg_start_speed[is_highest_occurrence == 1][1],
+      primary_IVB = avg_IVB[is_highest_occurrence == 1][1],
+      primary_HB = avg_HB[is_highest_occurrence == 1][1]
+    ) %>%
+    
+    # Ungroup to remove grouping structure
+    ungroup()
+}
+
 calculate_timstuff <- function(game) {
+  game <- calculate_primary(game)
   game <- game %>%
     mutate(VAA = calculate_VAA(vz0, ay, az, vy0, y0),
            EAA = calculate_EAA(extension),
@@ -122,37 +168,31 @@ calculate_timstuff <- function(game) {
            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)
-
-  feature_vars <- c("start_speed", "IVB", "HB", "EAA", "x0", "z0", "spin_rate", "SADiff")
+           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","primary_speed","primary_IVB","primary_HB")
   complete_rows <- complete.cases(game[, feature_vars])
   game_complete <- game[complete_rows, ]
   game_na <- game[!complete_rows,]
   game_na$TimStuff <- NA
   
-  lhp_fb <- game_complete[game_complete$phand == 'L' & game_complete$Pitch %in% c("Four-Seam Fastball", "Sinker", "Cutter", "Fastball"), ]
-  lhp_off <- game_complete[game_complete$phand == 'L' & game_complete$Pitch %in% c("Changeup", "Splitter", "Screwball", "Forkball"), ]
-  lhp_break <- game_complete[game_complete$phand == 'L' & game_complete$Pitch %in% c("Slider", "Slurve", "Sweeper", "Curveball", "Knuckle Curve", "Slow Curve", "Knuckleball"), ]
-
-  rhp_fb <- game_complete[game_complete$phand == 'R' & game_complete$Pitch %in% c("Four-Seam Fastball", "Sinker", "Cutter", "Fastball"), ]
-  rhp_off <- game_complete[game_complete$phand == 'R' & game_complete$Pitch %in% c("Changeup", "Splitter", "Screwball", "Forkball"), ]
-  rhp_break <- game_complete[game_complete$phand == 'R' & game_complete$Pitch %in% c("Slider", "Slurve", "Sweeper", "Curveball", "Knuckle Curve", "Slow Curve", "Knuckleball"), ]
-
-  lhp_fb$TimStuff <- scale_TimStuff(predict(FB, as.matrix(cbind(lhp_fb$start_speed, lhp_fb$IVB, -lhp_fb$HB, lhp_fb$EAA, -lhp_fb$x0, lhp_fb$z0, lhp_fb$spin_rate, lhp_fb$SADiff))), -0.0011801, 0.007989927)
-  lhp_off$TimStuff <- scale_TimStuff(predict(Off, as.matrix(cbind(lhp_off$start_speed, lhp_off$IVB, -lhp_off$HB, lhp_off$EAA, -lhp_off$x0, lhp_off$z0, lhp_off$spin_rate, lhp_off$SADiff))), -0.002239657, 0.01043216)
-  lhp_break$TimStuff <- scale_TimStuff(predict(Break, as.matrix(cbind(lhp_break$start_speed, lhp_break$IVB, -lhp_break$HB, lhp_break$EAA, -lhp_break$x0, lhp_break$z0, lhp_break$spin_rate, lhp_break$SADiff))), -0.004822031, 0.007912765)
-
-  rhp_fb$TimStuff <- scale_TimStuff(predict(FB, as.matrix(cbind(rhp_fb$start_speed, rhp_fb$IVB, rhp_fb$HB, rhp_fb$EAA, rhp_fb$x0, rhp_fb$z0, rhp_fb$spin_rate, rhp_fb$SADiff))), -0.0011801, 0.007989927)
-  rhp_off$TimStuff <- scale_TimStuff(predict(Off, as.matrix(cbind(rhp_off$start_speed, rhp_off$IVB, rhp_off$HB, rhp_off$EAA, rhp_off$x0, rhp_off$z0, rhp_off$spin_rate, rhp_off$SADiff))), -0.002239657, 0.01043216)
-  rhp_break$TimStuff <- scale_TimStuff(predict(Break, as.matrix(cbind(rhp_break$start_speed, rhp_break$IVB, rhp_break$HB, rhp_break$EAA, rhp_break$x0, rhp_break$z0, rhp_break$spin_rate, rhp_break$SADiff))), -0.004822031, 0.007912765)
-
-  game_complete <- rbind(lhp_fb, lhp_off, lhp_break, rhp_fb, rhp_off, rhp_break,game_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,rhp$primary_speed,rhp$primary_IVB,rhp$primary_HB))), -0.00249975,  0.007566558)
+  
+  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 <- 50 - (scaled_score * 10)
+  result <- 100 - (scaled_score * 10)
   return(result)
 }
 
@@ -178,9 +218,7 @@ pitch_plot <- function(game){
 }
 
 # Load models
-FB <- xgb.load('FB.model')
-Off <- xgb.load('Off.model')
-Break <- xgb.load('Break.model')
+model <- xgb.load('TimStuff2.model')
 
 summary_table <- function(data,pitchern){
   # rows <- nrow(data)
@@ -200,7 +238,7 @@ summary_table <- function(data,pitchern){
       '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)
+      'TimStuff+' = round(mean(TimStuff, na.rm = TRUE), digits = 0)
     ) %>%
     arrange(-Pitches)