Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Chicago Bears Receivers / Anthony Miller
library(tidyverse)
library(dplyr)
library(ggplot2)
library(ggrepel)
pbp_all <-
readRDS("pbpdata2009to2019.rds")
pbp_2018 <-
pbp_all %>% filter(season == 2018)
#Love Copy + Pasting Ben Baldwin's code
pbp_2018_rp <- pbp_2018 %>%
filter(!is.na(epa), !is.na(posteam), play_type=="no_play" | play_type=="pass" | play_type=="run") %>%
mutate(
pass = if_else(str_detect(desc, "(pass)|(sacked)|(scramble)"), 1, 0),
rush = if_else(str_detect(desc, "(left end)|(left tackle)|(left guard)|(up the middle)|(right guard)|(right tackle)|(right end)") & pass == 0, 1, 0),
success = ifelse(epa>0, 1 , 0),
passer_player_name = ifelse(play_type == "no_play" & pass == 1,
str_extract(desc, "(?<=\\s)[A-Z][a-z]*\\.\\s?[A-Z][A-z]+(\\s(I{2,3})|(IV))?(?=\\s((pass)|(sack)|(scramble)))"),
passer_player_name),
receiver_player_name = ifelse(play_type == "no_play" & str_detect(desc, "pass"),
str_extract(desc, "(?<=to\\s)[A-Z][a-z]*\\.\\s?[A-Z][A-z]+(\\s(I{2,3})|(IV))?"),
receiver_player_name),
rusher_player_name = ifelse(play_type == "no_play" & rush == 1,
str_extract(desc, "(?<=\\s)[A-Z][a-z]*\\.\\s?[A-Z][A-z]+(\\s(I{2,3})|(IV))?(?=\\s((left end)|(left tackle)|(left guard)| (up the middle)|(right guard)|(right tackle)|(right end)))"),
rusher_player_name),
name = ifelse(!is.na(passer_player_name), passer_player_name, rusher_player_name),
yards_gained=ifelse(play_type=="no_play",NA,yards_gained),
play=1
) %>%
filter(pass==1 | rush==1)
#First, let's calculate some of Mitch's stats so we can use them later
goat_stats <-
pbp_2018_rp %>%
filter(posteam == "CHI",
play_type == "pass",
!is.na(receiver_player_name),
passer_player_name == "M.Trubisky") %>%
summarize(success_rate = mean(success), mean_epa = mean(epa), dropbacks = n(), mean_adot = mean(air_yards, na.rm = TRUE))
#Define Bears dataset
pbp_bears_receivers <-
pbp_2018_rp %>%
filter(posteam == "CHI",
!is.na(receiver_player_name),
play_type == "pass",
down <= 4) %>%
group_by(receiver_player_name)
#Success Rate vs EPA
pbp_bears_receivers_epa <-
pbp_bears_receivers %>%
summarize(success_rate = mean(success), mean_epa = mean(epa), targets = n()) %>%
filter(targets >= 30)
ggplot(pbp_bears_receivers_epa, aes(x = success_rate, y = mean_epa)) +
geom_point(aes(size = targets)) +
geom_text_repel(aes(label = receiver_player_name),
nudge_y = .0125,
nudge_x = .0125) +
theme_bw() +
geom_hline(yintercept = goat_stats$mean_epa, lty = 2, color = "blue") +
geom_vline(xintercept = goat_stats$success_rate, lty = 2, color = "blue") +
annotate("text", x = .49, y= .225, angle = 0,label = "Mitch Averages", size = 3.5, color = "blue") +
labs(x = "Success Rate",
y = "EPA per Target",
title = "Bears Receivers: Success Rate and EPA",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('successratevsepa.png', dpi=1000)
#Receivers aDOT
pbp_bears_receivers_adot <-
pbp_bears_receivers %>%
summarize(adot = mean(air_yards), targets = n()) %>%
filter(targets >= 30)
ggplot(data = pbp_bears_receivers_adot, aes(x = receiver_player_name, y = adot)) +
geom_bar(stat = "identity", color = "blue", fill = "orange") +
geom_hline(yintercept = goat_stats$mean_adot, lty = 2, color = "blue") +
annotate("text", x = 4, y= 9.37, angle = 0,label = "Mitch Avg aDOT", size = 3.5, color = "blue") +
theme_bw() +
labs(
x = "Receiver",
y = "aDOT",
title = "Bears Receivers Average Depth of Target",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('aDOTeachreceiver.png', dpi=1000)
#Receivers YAC
pbp_bears_receivers_yac <-
pbp_bears_receivers %>%
summarize(yac = mean(yards_after_catch, na.rm = TRUE), targets = n()) %>%
filter(targets >= 30)
ggplot(data = pbp_bears_receivers_yac, aes(x = receiver_player_name, y = yac)) +
geom_bar(stat = "identity", color = "blue", fill = "orange") +
theme_bw() +
labs(
x = "Receiver",
y = "YAC",
title = "Bears Receivers Average YAC",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('YACeachreceiver.png', dpi=1000)
#Receivers aDOT but a boxplot
pbp_bears_receivers_adot_boxplot <-
pbp_bears_receivers %>%
filter(receiver_player_name %in% c("A.Miller", "A.Robinson II", "T.Burton", "T.Cohen", "T.Gabriel")) %>%
select(receiver_player_name, air_yards)
ggplot(data = pbp_bears_receivers_adot_boxplot, aes(x = receiver_player_name, y = air_yards)) +
geom_boxplot() +
geom_hline(yintercept = goat_stats$mean_adot, lty = 2, color = "blue") +
geom_hline(yintercept = 0, lty = 2, color = "red") +
theme_bw() +
labs(
x = "Receiver",
y = "aDOT",
title = "Bears Receivers Average Depth of Target",
subtitle = "Minimum 30 Targets (Only Mitch Throws)",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('adotboxplot.png', dpi=1000)
#Receivers Density Targets
pbp_bears_receivers_adot_density <-
pbp_bears_receivers %>%
group_by(receiver_player_name,air_yards) %>%
summarize(targets = n()) %>%
filter(receiver_player_name %in% c("A.Miller", "A.Robinson II", "T.Burton", "T.Cohen", "T.Gabriel"))
ggplot(data = pbp_bears_receivers_adot_density, aes(x=air_yards, y=..density..)) +
geom_density(aes(fill= receiver_player_name), position="stack") +
theme_classic() +
labs(
x = "aDOT",
y = "Density",
fill = "Receiver Name",
title = "Mitch Trubisky's Average Depth of Target Density Chart",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('adotdensity.png', dpi=1000)
#Now by Violin
pbp_bears_receivers_adot_violin <-
pbp_bears_receivers %>%
group_by(receiver_player_name,air_yards) %>%
summarize(targets = n()) %>%
filter(receiver_player_name %in% c("A.Miller", "A.Robinson II", "T.Burton", "T.Cohen", "T.Gabriel"))
ggplot(pbp_bears_receivers_adot_violin, aes(factor(receiver_player_name), y= air_yards)) +
geom_violin(aes(fill = receiver_player_name)) +
theme_bw() +
geom_hline(yintercept = goat_stats$mean_adot, lty = 2, color = "blue") +
geom_hline(yintercept = 0, lty = 2, color = "red") +
annotate("text", x = 3, y= 11, angle = 0,label = "Average aDOT", size = 3.5, color = "blue") +
labs(
x = "Receiver",
y = "aDOT",
fill = "Receiver Name",
title = "Bears Receivers Average Depth of Target",
subtitle = "Minimum 30 Targets (Only Mitch Throws)",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('adotviolin.png', dpi=1000)
#aDOT vs. Catch Rate
pbp_receivers_adot_vs_catch <-
pbp_2018_rp %>%
filter(!is.na(receiver_player_name) & play_type == "pass" & down <= 4) %>%
group_by(posteam, receiver_player_name) %>%
summarize(adot = mean(air_yards), targets = n(), catch_rate = sum(complete_pass)/targets) %>%
filter(adot >= 5 & targets >= 50)
ggplot(data = pbp_receivers_adot_vs_catch, aes(x = adot, y = catch_rate)) +
geom_point() +
geom_text_repel(
data = subset(pbp_receivers_adot_vs_catch, (posteam == "CHI")),
aes(label = receiver_player_name),
color = "blue",
fontface = "bold",
nudge_y = .045,
nudge_x = .55) +
geom_text_repel(
data = subset(pbp_receivers_adot_vs_catch,
((posteam != "CHI") & catch_rate > .8
|(posteam != "CHI") & catch_rate < .5
|(posteam != "CHI") & adot > 15)),
aes(label = paste(receiver_player_name, posteam, sep=" "))) +
geom_smooth(method = lm, se = FALSE, linetype = "dashed", color = "black") +
scale_y_continuous(breaks = c(.4,.45,.5,.55,.6,.65,.7,.75,.8,.85)) +
scale_x_continuous(breaks = c(6,8,10,12,14,16,18,20)) +
geom_hline(yintercept = mean(pbp_receivers_adot_vs_catch$catch_rate), lty = 2, color = "red") +
geom_vline(xintercept = mean(pbp_receivers_adot_vs_catch$adot), lty = 2, color = "red") +
theme_bw() +
labs(x = "aDOT",
y = "Catch Rate",
title = "Catch Rate vs aDOT",
subtitle = "Minimum 50 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('catchratevsadot.png', dpi=1000)
#Not a single outlier for Anthony Miller? Curiousity's sake:
doesanthonymillergodeep <-
pbp_bears_receivers %>%
filter(receiver_player_name == "A.Miller") %>%
arrange(desc(air_yards))
doesanthonymillergodeep[(1:5), "air_yards"]
#Maybe Better in Red Zone?
pbp_bears_receivers_epa_redzone <-
pbp_bears_receivers %>%
mutate(redzone = (ifelse(yardline_100 <= 20, "redzone", "not redzone"))) %>%
group_by(receiver_player_name, redzone) %>%
summarize(success_rate = mean(success), mean_epa = mean(epa), targets = n()) %>%
filter(receiver_player_name %in% c("A.Miller", "A.Robinson II", "T.Burton", "T.Cohen", "T.Gabriel"))
#Let's get target distribution
ggplot(data = pbp_bears_receivers_epa_redzone , aes(x=receiver_player_name, y= targets)) +
geom_bar(aes(fill= redzone), stat = "identity") +
geom_text(x = 1, y = 7.5, label = "20.3%") +
geom_text(x = 2, y = 7.5, label = "12.8%") +
geom_text(x = 3, y = 7.5, label = "18.4%") +
geom_text(x = 4, y = 7.5, label = "15.6%") +
geom_text(x = 5, y = 5, label = "8.7%") +
theme_bw() +
labs(
x = "Receiver",
y = "Total Targets",
fill = "Redzone",
title = "Bears Receivers Average Depth of Target",
subtitle = "Minimum 30 Targets (Only Mitch Throws)",
caption = "Data from nflscrapR \n \n @ChiBearsStats"
)
ggsave('redzonetargets.png', dpi=1000)
#Then by EPA
ggplot(pbp_bears_receivers_epa_redzone, aes(x = receiver_player_name, y = mean_epa)) +
geom_point(aes(color = receiver_player_name, shape = redzone), size = 5) +
labs(x = "Receiver",
y = "EPA per Target",
shape = "Field Position",
color = "Receiver Name",
title = "Bears Receivers: Difference in Red Zone EPA?",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats")
ggsave('eparedzone.png', dpi=1000)
#Now by Success Rate
ggplot(pbp_bears_receivers_epa_redzone, aes(x = receiver_player_name, y = success_rate)) +
geom_point(aes(color = receiver_player_name, shape = redzone), size = 5) +
labs(x = "Receiver",
y = "Success Rate",
shape = "Field Position",
color = "Receiver Name",
title = "Bears Receivers: Difference in Success Rate?",
subtitle = "Minimum 30 Targets",
caption = "Data from nflscrapR \n \n @ChiBearsStats")
ggsave('successrateredzone.png', dpi=1000)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment