Instantly share code, notes, and snippets.

Embed
What would you like to do?
Use empirical priors to find true td rates for NFL Qbs
library(ggplot2)
library(tidyverse)
library(ebbr)
### SQL to generate the data from nfldb. https://github.com/BurntSushi/nfldb
# SELECT a.player_id , b.full_name ,a.passing_att, a.passing_tds
# FROM play_player a
# INNER JOIN player b ON a.player_id = b.player_id
# INNER JOIN game c ON a.gsis_id = c.gsis_id
# WHERE a.passing_att = 1 AND c.season_type = 'Regular' AND b.position = 'QB'
# Read the file
raw <- read_csv('data/td_rate_09-17.csv')
# group and summarize
grouped <- raw %>%
group_by(full_name) %>%
summarize(att = sum(passing_att), td = sum(passing_tds))
# filter to just Qbs with 100 or more career attempts, because reasons
filtered <-grouped %>%
filter(att >= 100)
# Create an empirical beta prior. Ebbr available from: https://github.com/dgrtwo/ebbr
prior <-filtered %>%
ebb_fit_prior(td, att)
# Now fit each player's actual results to the prior
fitted <- augment(prior, data = filtered) %>%
arrange(-.fitted)
# Set up the plot labels
chart_title <- "'True' Touchdown Rate for Active NFL QBs, minimum 100 Pass Attempts 2009-2017\n"
fitted$att <- paste(fitted$full_name, " (", fitted$td, "/", fitted$att, ")", sep="")
# Graph the plot
fitted %>%
top_n(n = 96, wt = .fitted) %>%
mutate(name = reorder(att, .fitted)) %>%
ggplot(aes(x = .fitted, y = name)) +
geom_point() +
geom_point(aes(.raw, color='red')) +
geom_errorbarh(aes(xmin = .low, xmax = .high)) +
labs(x = "\nTouchdown Rate: 'True' in black w/ 95% CI. Observed in red.",
y = "", title = chart_title) +
theme_bw() +
# Set the entire chart region to a light gray color
theme(panel.background=element_rect(fill="#F0F0F0")) +
theme(plot.background=element_rect(fill="#F0F0F0")) +
theme(panel.border=element_rect(colour="#F0F0F0")) +
# Format the grid
theme(panel.grid.major=element_line(colour="#D0D0D0",size=.85)) +
scale_x_continuous(minor_breaks=0,breaks=seq(0.01,.08,.01),limits=c(0.01,.08)) +
theme(axis.ticks=element_blank()) +
# Dispose of the legend
theme(legend.position="none") +
theme(plot.title=element_text(face="bold",hjust=-.08,vjust=2,colour="#3C3C3C",size=20)) +
theme(axis.text.x=element_text(size=11,colour="#535353",face="bold")) +
theme(axis.text.y=element_text(size=11,colour="#535353",face="bold")) +
theme(axis.title.y=element_text(size=11,colour="#535353",face="bold",vjust=1.5)) +
theme(axis.title.x=element_text(size=11,colour="#535353",face="bold",vjust=-.5)) +
# Plot margins
theme(plot.margin = unit(c(1, 1, .1, .65), "cm"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment