Trubisky the Scrambler

Trubisky the Scrambler

library(tidyverse)
library(dplyr)
library(ggplot2)
library(ggrepel)
library(ggimage)
library(ggthemes)
library(cowplot)

#Pre-Loaded Data. See Ben Baldwin's Tutorial for help loading/wrangling the pbp data (https://gist.github.com/guga31bb/5634562c5a2a7b1e9961ac9b6c568701)
pbp_all_rp <- 
  readRDS("pbprp2009to2018.rds")

#Load the NFL colors from nflscrapR 
library(nflscrapR)
nflcolors <- nflteams

#Load the NFL team Logos
library(RCurl)
url.logo <- getURL("https://raw.githubusercontent.com/statsbylopez/BlogPosts/master/nfl_teamlogos.csv")
df.logos <- read.csv(text = url.logo)

#Load Trubisky's Head
library(magick)
trubisky_head <- image_read("Mitch Trubisky.png")

#Let's take our pbp data and filter only for scrambles
qb_scrambles <-
  pbp_all_rp %>% 
  select(name, posteam, season, desc, epa, pass, rush, yards_gained, success) %>% 
  mutate(scramble = if_else(str_detect(desc, "scramble"), 1, 0)) %>% 
  filter(scramble == 1) %>% 
  #Now Calculate/Summarize what we want
  group_by(posteam, name, season) %>% 
  summarise(scrambles = n(),
            epa = sum(epa),
            epa_per_scramble = epa/scrambles,
            successes = sum(success),
            success_rate = successes/scrambles) %>% 
  filter(scrambles > 10) %>% 
  #Bring in the Logos for our plot
  left_join(df.logos, by = c("posteam" = "team_code"))

  
scramble_plot_2018 <-
  ggplot(filter(qb_scrambles, season == 2018), aes(x = success_rate, y = epa_per_scramble)) +
  #This is where we bring the logo in
  geom_image(aes(image = url), size = .06) +
  theme_clean() +
  labs(x = "Success Rate",
       y = "EPA per Scramble",
       title = "Trubisky was one of the most dangerous scramblers last year",
       subtitle = "QB Scrambles in 2018 (Minimum 10 Scrambles)",
       caption = "@ChiBearsStats\nData courtesy of @nflscrapR ") +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "grey")

#Use Cowplot to draw Trubisky's head on the graph. Credit to @CardinalsViz for teaching me this one
ggdraw() + 
  draw_plot(scramble_plot_2018) + 
  draw_image(trubisky_head, x=0.01, y=-0.4, width=0.1)

ggsave("scrambleplot2018.png", dpi = 1000)

#Now let's look at careers
#Some code repeats, but let's also include WPA so we can look at that in a bit

qb_scrambles_career <-
  pbp_all_rp %>% 
  select(name, posteam, season, desc, epa, wpa, pass, rush, yards_gained, success) %>% 
  mutate(scramble = if_else(str_detect(desc, "scramble"), 1, 0)) %>% 
  filter(scramble == 1) %>% 
  group_by(posteam, name) %>% 
  summarise(scrambles = n(),
            epa = sum(epa, na.rm = TRUE),
            wpa = sum(wpa, na.rm = TRUE),
            epa_per_scramble = epa/scrambles,
            wpa_per_scramble = wpa/scrambles,
            successes = sum(success),
            success_rate = successes/scrambles) %>% 
  filter(scrambles > 25) %>% 
  #Bring in the NFL colors for our plot
  left_join(select(nflcolors, primary, abbr), by = c("posteam" = "abbr"))

scramble_plot_career <-
  ggplot(qb_scrambles_career, aes(x = success_rate, y = epa_per_scramble, color = posteam)) +
  geom_point(aes(size = scrambles/5), alpha = .5) +
  theme_clean() +
  theme(legend.position = "none",
        axis.line = element_line(size = 3)) +
  scale_color_manual(values = nflcolors$primary, 
                     guide = FALSE) +
  geom_text_repel(data = subset(qb_scrambles_career, epa_per_scramble > .7 | epa_per_scramble < .05),
                  aes(label = name)) +
  geom_text_repel(data = subset(qb_scrambles_career, name == "R.Wilson"),
                  aes(label = "R.Wilson with 331 Scrambles!"),
                  nudge_x = .1,
                  nudge_y = -.1) +
  labs(x = "Success Rate",
       y = "EPA per Scramble",
       title = "Trubisky has been one of the most dangerous scramblers of the last decade",
       subtitle = "QB Scrambles from 2009-2018 (Minimum 25 Scrambles)",
       caption = "@ChiBearsStats\nData courtesy of @nflscrapR ") +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "grey")
  
ggdraw() + 
  draw_plot(scramble_plot_career) + 
  draw_image(trubisky_head, x=0.025, y=-0.4, width=0.15)

ggsave("scrambleplotcareer.png", dpi = 1000)


#Now by WPA

scramble_plot_career_wpa <-
ggplot(qb_scrambles_career, aes(x = success_rate, y = wpa_per_scramble, color = posteam)) +
  geom_point(aes(size = scrambles/5), alpha = .5) +
  theme_clean() +
  #This takes out the legend that is more disruptive that helpful
  theme(legend.position = "none",
        axis.line = element_line(size = 3)) +
  scale_color_manual(values = nflcolors$primary, 
                     guide = FALSE) +
  geom_text_repel(data = subset(qb_scrambles_career, wpa_per_scramble > .02 | wpa_per_scramble < 0),
                  aes(label = name)) +
  labs(x = "Success Rate",
       y = "WPA per Scramble",
       title = "Trubisky's Scrambles have added the most Win Probability in the NFL",
       subtitle = "QB Scrambles from 2009-2018 (Minimum 25 Scrambles)",
       caption = "@ChiBearsStats\nData courtesy of @nflscrapR ")

ggdraw() + 
  draw_plot(scramble_plot_career_wpa) + 
  draw_image(trubisky_head, x=0.025, y=-0.4, width=0.12)

ggsave("scrambleplotcareerwpa.png", dpi = 1000)