Created
August 12, 2019 03:29
-
-
Save ChiBearsStats/78e33baeed3cd6d3cac0040b47d4ec69 to your computer and use it in GitHub Desktop.
RIP Parkey & the Insignificance of Kickers
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(dplyr) | |
library(nflscrapR) | |
library(tidyverse) | |
library(ggrepel) | |
library(ggimage) | |
pbp_all <- readRDS("pbpdata2009to2019.rds") #I just use prescraped data, but if you don't know where to get this, I would recommend reading Ben Baldwin's tutorial: | |
#(https://gist.github.com/guga31bb/5634562c5a2a7b1e9961ac9b6c568701) | |
field_goals <- | |
pbp_all %>% | |
filter(play_type == "field_goal") %>% | |
select(play_type, desc, field_goal_result, kick_distance, fg_prob, field_goal_attempt, kicker_player_name, posteam, kicker_player_id, season, wpa, epa) %>% | |
mutate(made_kick = ifelse(field_goal_result == "made", 1, 0), | |
kick_distance = ifelse(kick_distance < 56, kick_distance, 56)) | |
expected_field_goals <- | |
field_goals %>% | |
group_by(kick_distance) %>% | |
summarize(expected_makes = sum(made_kick), attempts = n()) %>% | |
mutate(expected_kick_percentage = expected_makes/attempts) %>% | |
select(-c(expected_makes, attempts)) | |
actual_field_goals <- | |
field_goals %>% | |
group_by(kicker_player_name, season, kick_distance) %>% | |
summarize(actual_makes = sum(made_kick), attempts = n(), | |
epa = sum(epa, na.rm = TRUE), wpa = sum(wpa, na.rm = TRUE)) %>% | |
left_join(expected_field_goals, by = c("kick_distance")) %>% | |
mutate(expected_makes = (expected_kick_percentage * attempts)) %>% | |
group_by(kicker_player_name, season) %>% | |
summarise(attempts = sum(attempts), | |
actual_makes = sum(actual_makes), | |
expected_makes = sum(expected_makes), | |
makes_over_expectation = (actual_makes - expected_makes), | |
epa = sum(epa, na.rm = TRUE), | |
wpa = sum(wpa, na.rm = TRUE)) | |
#Density Plot of FGoE | |
ggplot(actual_field_goals, aes(x=makes_over_expectation, y=..density..)) + | |
geom_vline(data = subset(actual_field_goals, kicker_player_name == "C.Parkey" & season == "2018"), | |
aes(xintercept = makes_over_expectation, color = "orange")) + | |
geom_density() + | |
annotate("label", x = -1.5, y= .025,label = "Cody Parkey, 2018 \n -2.76", size = 2.5, color = "black") + | |
theme_classic() + | |
theme(axis.text.y=element_blank()) + | |
guides(color = FALSE) + | |
labs( | |
x = "Made Field Goals Over Expectation", | |
y = "Density", | |
title = "How Much Do Kickers Out-Kick or Under-Kick Expectations?", | |
subtitle = "2009-2018", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('fieldgoalsoverexpectation.png', dpi=1000) | |
#How much EPA do Kickers bring? | |
ggplot(actual_field_goals, aes(x=epa, y=..density..)) + | |
geom_vline(data = subset(actual_field_goals, kicker_player_name == "C.Parkey" & season == "2018"), | |
aes(xintercept = epa, color = "orange")) + | |
geom_density() + | |
annotate("label", x = -7, y= .01,label = "Cody Parkey, 2018 \n -12.0", size = 2.5, color = "black") + | |
theme_classic() + | |
theme(axis.text.y=element_blank()) + | |
guides(color = FALSE) + | |
labs( | |
x = "Total EPA", | |
y = "Density", | |
title = "Kickers EPA", | |
subtitle = "2009-2018", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('kickerepa.png', dpi=1000) | |
#How much WPA do Kickers bring? | |
ggplot(actual_field_goals, aes(x=wpa, y=..density..)) + | |
geom_vline(data = subset(actual_field_goals, kicker_player_name == "C.Parkey" & season == "2018"), | |
aes(xintercept = wpa, color = "orange")) + | |
geom_density() + | |
annotate("label", x = -.2, y= .1,label = "Cody Parkey, 2018 \n -.45", size = 2.5, color = "black") + | |
theme_classic() + | |
theme(axis.text.y=element_blank()) + | |
guides(color = FALSE) + | |
labs( | |
x = "Total WPA", | |
y = "Density", | |
title = "Kickers WPA", | |
subtitle = "2009-2018", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('kickerwpa.png', dpi=1000) | |
#Let's take a look at accuracy vs attempts | |
attempts_lm = lm(makes_over_expectation ~ attempts, data=actual_field_goals) | |
rsquared <- summary(attempts_lm)$r.squared | |
rsquared <- signif(rsquared, digits = 2) | |
rsquaredlabel <- expression(paste(" ",R^2 ,"= .05")) | |
ggplot(actual_field_goals, aes(x = attempts, makes_over_expectation)) + | |
geom_point() + | |
geom_point(data = subset(actual_field_goals, (kicker_player_name == "C.Parkey")), | |
color = "orange", | |
size = 2) + | |
geom_image( | |
data = subset(actual_field_goals, (kicker_player_name == "C.Parkey" & season == 2018)), | |
aes(image = "https://upload.wikimedia.org/wikipedia/commons/thumb/5/5c/Chicago_Bears_logo.svg/100px-Chicago_Bears_logo.svg.png"), size = .05) + | |
annotate("text", x = 50, y= -4,label = rsquaredlabel, size = 4, color = "black") + | |
geom_hline(yintercept = 0, lty = 4, color = "black") + | |
geom_text_repel( | |
data = subset(actual_field_goals, (makes_over_expectation > 5) | |
| attempts > 50 | |
| makes_over_expectation < -5), | |
aes(label = paste(kicker_player_name, substr(season, 3, 4)))) + | |
geom_text_repel( | |
data = subset(actual_field_goals, (kicker_player_name == "C.Parkey")), | |
aes(label = substr(season, 3, 4)), | |
color = "blue", | |
nudge_y = 1, | |
nudge_x = 1) + | |
theme_classic() + | |
labs( | |
x = "Total Attempts", | |
y = "Made Field Goals Over Expectation", | |
title = "FGoE vs Attempts (Cody Parkey Seasons Highlighted)", | |
subtitle = "2009-2018", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('madefieldgoalsvsattempts.png', dpi=1000) | |
#Careers | |
actual_field_goals_career <- | |
field_goals %>% | |
group_by(kicker_player_name, kick_distance) %>% | |
summarize(actual_makes = sum(made_kick), attempts = n(), | |
epa = sum(epa, na.rm = TRUE), wpa = sum(wpa, na.rm = TRUE)) %>% | |
left_join(expected_field_goals, by = c("kick_distance")) %>% | |
mutate(expected_makes = (expected_kick_percentage * attempts)) %>% | |
group_by(kicker_player_name) %>% | |
summarise(attempts = sum(attempts), | |
actual_makes = sum(actual_makes), | |
expected_makes = sum(expected_makes), | |
makes_over_expectation = ((actual_makes - expected_makes)/expected_makes), | |
epa = sum(epa, na.rm = TRUE), | |
wpa = sum(wpa, na.rm = TRUE)) %>% | |
filter(attempts > 20) | |
ggplot(actual_field_goals_career, aes(x = attempts, makes_over_expectation)) + | |
geom_point() + | |
geom_point(data = subset(actual_field_goals_career, (kicker_player_name == "C.Parkey")), | |
color = "orange", | |
size = 2) + | |
geom_hline(yintercept = 0, lty = 4, color = "black") + | |
geom_text_repel( | |
data = subset(actual_field_goals_career, (makes_over_expectation > .05) | |
| attempts > 300 | |
| makes_over_expectation < -.15), | |
aes(label = kicker_player_name)) + | |
geom_text_repel( | |
data = subset(actual_field_goals_career, (kicker_player_name == "C.Parkey")), | |
aes(label = kicker_player_name), | |
color = "blue", | |
nudge_y = -.005, | |
nudge_x = .1) + | |
theme_classic() + | |
labs( | |
x = "Total Attempts", | |
y = "Made Field Goals Over Expectation", | |
title = "Field Goals Over Expectation (%)", | |
subtitle = "2009-2018, minimum of 20 Attempts", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('careerfgattempts.png', dpi=1000) | |
#Year Over Year Kicker Accuracy | |
actual_field_goals_yoy <- | |
actual_field_goals %>% | |
filter(attempts >= 10) %>% | |
mutate(following_season = season + 1) %>% | |
left_join(select(actual_field_goals_yoy, kicker_player_name, season, makes_over_expectation), | |
by = c("kicker_player_name", "following_season" = "season")) %>% | |
filter(!is.na(makes_over_expectation.y)) | |
yoy_lm = lm(makes_over_expectation.x ~ makes_over_expectation.y, data=actual_field_goals_yoy) | |
rsquared_yoy <- summary(yoy_lm)$r.squared | |
rsquared_yoy <- signif(rsquared_yoy, digits = 2) | |
rsquaredlabel_yoy <- expression(paste(" ",R^2 ,"= .043")) | |
#Graph | |
ggplot(actual_field_goals_yoy, aes(x = makes_over_expectation.x, makes_over_expectation.y)) + | |
geom_point() + | |
geom_point(data = subset(actual_field_goals_yoy, (kicker_player_name == "C.Parkey")), | |
color = "orange", | |
size = 2) + | |
annotate("text", x = 5, y= -4,label = rsquaredlabel_yoy, size = 4, color = "black") + | |
geom_abline(intercept = 0, slope = 1, lty = 2) + | |
geom_vline(xintercept = 0, lty = 2) + | |
geom_hline(yintercept = 0, lty = 2) + | |
geom_text_repel( | |
data = subset(actual_field_goals_yoy, (makes_over_expectation.y > 5) | |
| makes_over_expectation.x > 5 | |
| makes_over_expectation.y < -5 | |
| makes_over_expectation.x < -5), | |
aes(label = paste(kicker_player_name, substr(season, 3, 4), "-", substr(following_season, 3, 4)))) + | |
geom_text_repel( | |
data = subset(actual_field_goals_yoy, (kicker_player_name == "C.Parkey")), | |
aes(label = paste(substr(season, 3, 4), "-", substr(following_season, 3, 4))), | |
color = "blue", | |
nudge_y = .5, | |
nudge_x = .5) + | |
theme_classic() + | |
labs( | |
x = "Year X", | |
y = "Year X + 1", | |
title = "Field Goals Over Expectation, Year Over Year", | |
subtitle = "2009-2018, Minimum 10 Attempts", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('yearoveryearfieldgoals.png', dpi=1000) | |
#Let's do it proportionally to make sure we're not penalizing high attempt seasons | |
actual_field_goals_yoy <- | |
actual_field_goals %>% | |
filter(attempts >= 10) %>% | |
mutate(following_season = season + 1, | |
difference_percentage = ((actual_makes - expected_makes)/expected_makes)) %>% | |
left_join(select(actual_field_goals_yoy, kicker_player_name, season, difference_percentage), | |
by = c("kicker_player_name", "following_season" = "season")) %>% | |
filter(!is.na(difference_percentage.y)) | |
yoyper_lm = lm(difference_percentage.x ~ difference_percentage.y, data=actual_field_goals_yoy) | |
rsquared_yoyper <- summary(yoyper_lm)$r.squared | |
rsquared_yoyper <- signif(rsquared_yoy, digits = 2) | |
rsquaredlabel_yoyper <- expression(paste(" ",R^2 ,"= .043")) | |
#Graph | |
ggplot(actual_field_goals_yoy, aes(x = difference_percentage.x, difference_percentage.y)) + | |
geom_point() + | |
geom_point(data = subset(actual_field_goals_yoy, (kicker_player_name == "C.Parkey")), | |
color = "orange", | |
size = 2) + | |
annotate("text", x = .2, y= -.2,label = rsquaredlabel_yoy, size = 4, color = "black") + | |
geom_abline(intercept = 0, slope = 1, lty = 2) + | |
geom_vline(xintercept = 0, lty = 2) + | |
geom_hline(yintercept = 0, lty = 2) + | |
geom_text_repel( | |
data = subset(actual_field_goals_yoy, (difference_percentage.x > .2) | |
| difference_percentage.y > .2 | |
| difference_percentage.x < -.2 | |
| difference_percentage.y < -.22), | |
aes(label = paste(kicker_player_name, substr(season, 3, 4), "-", substr(following_season, 3, 4)))) + | |
geom_text_repel( | |
data = subset(actual_field_goals_yoy, (kicker_player_name == "C.Parkey")), | |
aes(label = paste(substr(season, 3, 4), "-", substr(following_season, 3, 4))), | |
color = "blue", | |
nudge_y = .05, | |
nudge_x = .05) + | |
theme_classic() + | |
labs( | |
x = "Year X", | |
y = "Year X + 1", | |
title = "Field Goals Over Expectation (%), Year Over Year", | |
subtitle = "2009-2018, Minimum 10 Attempts", | |
caption = "Data from nflscrapR \n \n @ChiBearsStats" | |
) | |
ggsave('yearoveryearfieldgoalspercentage.png', dpi=1000) | |
#Lastly, let's look at "clutch" kicks | |
actual_field_goals_clutch <- | |
pbp_all %>% | |
filter(play_type == "field_goal") %>% | |
select(game_seconds_remaining, game_half, score_differential, play_type, desc, field_goal_result, kick_distance, fg_prob, field_goal_attempt, kicker_player_name, posteam, kicker_player_id, season, wpa, epa) %>% | |
mutate(made_kick = ifelse(field_goal_result == "made", 1, 0), | |
kick_distance = ifelse(kick_distance < 56, kick_distance, 56)) %>% | |
filter((game_seconds_remaining < 300 & score_differential <= 3 & score_differential >= -3) | | |
game_half == "Overtime") %>% | |
group_by(kicker_player_name, kick_distance) %>% | |
summarize(actual_makes = sum(made_kick), attempts = n(), | |
epa = sum(epa, na.rm = TRUE), wpa = sum(wpa, na.rm = TRUE)) %>% | |
left_join(expected_field_goals, by = c("kick_distance")) %>% | |
mutate(expected_makes = (expected_kick_percentage * attempts)) %>% | |
group_by(kicker_player_name) %>% | |
summarise(attempts = sum(attempts), | |
actual_makes = sum(actual_makes), | |
expected_makes = sum(expected_makes), | |
difference_percentage = ((actual_makes - expected_makes)/expected_makes), | |
makes_over_expectation = (actual_makes - expected_makes)) %>% | |
filter(attempts > 10) %>% | |
left_join(actual_field_goals_career, by = c("kicker_player_name")) %>% | |
mutate(difference_percentage_career = ((actual_makes.y - expected_makes.y)/expected_makes.y)) | |
clutch_lm = lm(difference_percentage ~ difference_percentage_career, data=actual_field_goals_clutch) | |
rsquared_clutch <- summary(clutch_lm)$r.squared | |
rsquared_clutch <- signif(rsquared_clutch, digits = 2) | |
rsquaredlabel_clutch <- expression(paste(" ",R^2 ,"= .17")) | |
ggplot(actual_field_goals_clutch, aes(x = difference_percentage,difference_percentage_career)) + | |
geom_point() + | |
geom_point(data = subset(actual_field_goals_clutch, (kicker_player_name == "C.Parkey")), | |
color = "orange", | |
size = 2) + | |
geom_smooth(method = lm) + | |
annotate("text", x = .2, y= -.05,label = rsquaredlabel_clutch, size = 4, color = "black") + | |
geom_abline(intercept = 0, slope = 1, lty = 2) + | |
geom_vline(xintercept = 0, lty = 2) + | |
geom_hline(yintercept = 0, lty = 2) + | |
geom_text_repel( | |
data = subset(actual_field_goals_clutch, (difference_percentage > .05) | |
| difference_percentage_career > .05 | |
| difference_percentage < -.15 | |
| difference_percentage < -.22), | |
aes(label = kicker_player_name)) + | |
geom_text_repel( | |
data = subset(actual_field_goals_clutch, (kicker_player_name == "C.Parkey")), | |
aes(label = kicker_player_name), | |
color = "blue", | |
nudge_y = .005, | |
nudge_x = -.005) + | |
theme_classic() + | |
labs( | |
x = "Clutch Kicks Above Expectation (%)", | |
y = "All Kicks", | |
title = "Clutch Kicking", | |
subtitle = "2009-2018, Minimum 10 Attempts", | |
caption = "Clutch Kick = <5 minutes remaining in Reg. or in OT in a 3 point game. \n Data from nflscrapR \n @ChiBearsStats" | |
) | |
ggsave('clutchkicks.png', dpi=1000) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment