Work on infield alignment data from Baseball Savant

shiftwork.R

# load in packages

library(tidyverse)
library(ggrepel)
library(baseballr)

# read in Statcast data for 2018 season

sc <- read_csv("../StatcastData/statcast2018new.csv")

# look at variation in shifting across teams

sc %>% group_by(game_date, home_team, away_team,
                at_bat_number) %>% 
  arrange(pitch_number) %>% 
  summarize(TopHalf = first(inning_topbot),
            Type = last(type),
            Event = last(events),
            LA = last(launch_angle),
            LS = last(launch_speed),
            Shift = last(if_fielding_alignment),
            Batter = last(player_name),
            Side = last(stand),
            P_Standard = mean(if_fielding_alignment == 
                              "Standard"))  %>% 
  mutate(defense = ifelse(TopHalf == "Top",
                 home_team, away_team)) -> sc_pa

######## scatterplot of shifting pct for both sides

sc_pa %>% group_by(defense, Shift, Side) %>% 
  summarize(N = n()) -> S_side

select(filter(S_side, Side == "L"), -Side) %>% 
  spread(Shift, N) -> S2a
names(S2a) <- c("Team", "Shift_L", "Standard_L",
                "Strategic_L", "NA_L")
S2a %>% mutate(P_L = 100 * Shift_L / 
    (Shift_L + Standard_L + Strategic_L + NA_L)) -> S2a

select(filter(S_side, Side == "R"), -Side) %>% 
  spread(Shift, N) -> S2b
names(S2b) <- c("Team", "Shift_R", "Standard_R",
                "Strategic_R", "NA_R")
S2b %>% mutate(P_R = 100 * Shift_R / 
  (Shift_R + Standard_R + Strategic_R + NA_R)) -> S2b

Sall <- inner_join(S2a, S2b)

ggplot(Sall, aes(P_R, P_L, label = Team)) +
  geom_label_repel() +
  geom_abline(slope = 1, intercept = 0, color = "red") +
  xlab("Shifting Percentage Against Right-Handed Hitters") +
  ylab("Shifting Percentage Against Left-Handed Hitters") 
  

###### shifting for different players

sc_pa %>% group_by(Batter, Shift) %>% 
  summarize(N = n()) -> Sb

Sb %>% spread(Shift, N) -> Sb2
names(Sb2)[2] <- "Shift"

Sb2$P <- with(Sb2, 100 * Shift / (Shift + Standard + Strategic))
Sb2$N <- with(Sb2, Shift + Standard + Strategic)

ggplot(Sb2, aes(N, P, label=Batter)) + 
  geom_point() +
  ylim(0, 100) +
  geom_label_repel(data = filter(Sb2, P > 80)) +
  ylab("Percentage of Shifting") +
  xlab("Plate Appearances")

Sb2 %>% arrange(desc(P)) -> Sb2
head(Sb2)

# who did not shift Joey Gallo?

filter(sc_pa, Batter == "Joey Gallo") %>% 
  group_by(defense, Shift)  %>% 
  summarize(N = n()) -> S4

S4 %>% spread(Shift, N) -> S4a
filter(S4a, Standard > 0)

##########

filter(Sb2, P < 52, P > 48)

filter(sc_pa, Batter == "Kris Bryant") %>% 
  group_by(defense, Shift)  %>% 
  summarize(N = n()) -> S4

S4 %>% spread(Shift, N) -> S4a
names(S4a)[2] <- "Shift"

S4a  %>%  mutate(Shift = ifelse(is.na(Shift), 0, Shift),
         Standard = ifelse(is.na(Standard), 0, Standard),
         Strategic = ifelse(is.na(Strategic), 0, Strategic),
         N = Shift + Standard + Strategic,
         P = 100 * Shift / 
          (Shift + Standard + Strategic)) -> S4a

ggplot(S4a, aes(defense, P)) +
  coord_flip() + geom_point()

############ does shifting work?

fg_guts() %>% filter(season == 2018) -> wts

sc_pa %>% filter(Type == "X", LA < 10) %>% 
  mutate(Hit = ifelse(Event %in% 
            c("single", "double",
            "triple", "home_run"), 1, 0)) %>% 
  group_by(Shift) %>% 
  summarize(BA = mean(Hit, na.rm = TRUE))

sc_pa %>% 
  mutate(woba = wts$w1B * (Event == "single") +
           wts$w2B * (Event == "double") +
           wts$w3B * (Event == "triple") +
           wts$wHR * (Event == "home_run") +
           wts$wBB * (Event == "walk") +
           wts$wHBP * (Event == "hit_by_pitch")) %>% 
  group_by(Shift) %>% 
  summarize(wOBA = mean(woba, na.rm = TRUE))