Graph of barrel region and GAM fits using 2021 Statcast data

barrels_script.R

# using Statcast data for the 2021 season

# two functions plot_xb_contour_work() and
# plot_woba_contour_work() implement the
# logistic and ordinal fitting algorithms

# ggplot2 code is used to show the barrel
# region over the (launch speed, launch angle)
# space

# curves corresponding to fitted values from
# the GAM models are overlaid

plot_xb_contour_work <- function(sc_ip){
  library(mgcv)
  sc_ip2 <- filter(sc_ip,
                   launch_angle >= 10,
                   launch_angle <= 50,
                   launch_speed >= 95)
  fit <- gam(XB ~ s(launch_angle, launch_speed),
             family = binomial,
             data = sc_ip2)
  grid <- expand.grid(launch_angle =
                        seq(10, 50, length = 50),
                      launch_speed =
                        seq(95, 115, length = 50))
  grid$prob <- predict(fit, grid, type = "response")
  grid
}

plot_woba_contour_work <- function(sc_ip){
  library(mgcv)
  sc_ip2 <- filter(sc_ip,
                  launch_angle >= 10,
                  launch_angle <= 50,
                  launch_speed >= 95)
  sc_ip2 %>%
    mutate(Type_Hit = ifelse(events == "single", 2,
          ifelse(events == "double", 3,
          ifelse(events == "triple", 4,
          ifelse(events == "home_run", 5, 1)
                                    )))) -> sc_ip2
  newfit <- gam(Type_Hit ~ s(launch_angle,
                             launch_speed),
                family = ocat(R = 5),
                data = sc_ip2)
  grid <- expand.grid(launch_angle =
                        seq(10, 50, length = 50),
                      launch_speed =
                        seq(95, 115, length = 50))
  probs <- predict(newfit, grid, type = "response")
  grid$single <- probs[, 2]
  grid$double <- probs[, 3]
  grid$triple <- probs[, 4]
  grid$home_run <- probs[, 5]
  grid$e_woba <- 0.9 * probs[, 2] +
    1.25 * probs[, 3] + 1.6 * probs[, 4] +
    2 * probs[, 5]
  grid
}

######## work with statcast 2021 data
# data is loaded as variable statcast2021

library(dplyr)
library(ggplot2)

# just consider in-play events
# define Barrel and XB variables

statcast2021 %>%
  filter(type == "X")  %>%
  mutate(Barrel = ifelse(barrel == 1,
                         "Yes", "No"),
         XB = ifelse(events %in%
                       c("double", "triple",
                         "home_run"), 1, 0)) ->
  sc_ip

# implements the fitting of the extra base
# hit and woba GAM models

grid2 <- plot_xb_contour_work(sc_ip)
grid3 <- plot_woba_contour_work(sc_ip)

# graph of barrel launch variable region
# with curve P(XB) = 0.5

ggplot() +
  geom_point(data = filter(sc_ip,
                           launch_speed >= 90,
                           launch_speed <= 110,
                           launch_angle >= 0,
                           launch_angle <= 50),
             mapping = aes(launch_speed, launch_angle,
                           color = Barrel)) +
  ggtitle("Launch Conditions for Barrels") +
  scale_color_manual(values = c("lightgrey", "red")) +
  geom_contour(data = grid2,
               mapping = aes(x = launch_speed,
                             y = launch_angle,
                             z = prob),
               breaks = c(0, .5, 1),
               size = 1.5) +
  xlim(95, 110) +
  ylim(5, 50) +
  annotate(geom = "text",
           y = 39, x = 100,
           label ="P(XB) = 0.5",
           size = 5,
           color = "blue") +
  theme(text = element_text(size = 18)) +
  theme(plot.title = element_text(colour = "blue",
                                  size = 18,
              hjust = 0.5, vjust = 0.8, angle = 0))

# graph of barrel launch variable region
# with curve E(wOBA) = 0.9

ggplot() +
  geom_point(data = filter(sc_ip,
                           launch_speed >= 95,
                           launch_speed <= 110,
                           launch_angle >= 5,
                           launch_angle <= 50),
             mapping = aes(launch_speed, launch_angle,
                           color = Barrel)) +
  ggtitle("Launch Conditions for Barrels") +
  scale_color_manual(values = c("lightgrey", "red")) +
  geom_contour(data = grid3,
               mapping = aes(x = launch_speed,
                             y = launch_angle,
                             z = e_woba),
               breaks = 0.90,
               size = 1.5) +
  xlim(95, 110) +
  ylim(5, 50) +
  annotate(geom = "text",
           y = 40, x = 100,
           label ="E(wOBA) = 0.9",
           size = 5,
           color = "blue") +
  theme(text = element_text(size = 18)) +
  theme(plot.title = element_text(colour = "blue",
                                  size = 18,
                                  hjust = 0.5, vjust = 0.8, angle = 0))