Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment