Use empirical priors to find true td rates for NFL Qbs

true_td_rate

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"))