Some friends and I got into a conversation about rookies in the NFL and how much their salaries were. We eventually started guessing how much more the first overall pick makes compared to, Mr. Irrelevant, the last pick of the NFL draft. It’s a pretty steep drop from number 1 to number 256 (7 rounds of 32 teams, plus a maximum of 32 compensatory selections), but it turns out most of that slide happens in the first 2 rounds. Below is the chart I came up with. Here is a higher res link

Here is the R code to reproduce the chart above, including the function to download the data from spotrac, which is a great site by the way.

####################################################################
# Create nfl draft salary chart
# date: 2/16/2017
# author: Jesse Piburn
#
####################################################################

# gtable and grid used to add the source text at the bottom -----
library(ggplot2)
library(ggthemes)
library(gtable)
library(grid)
library(dplyr)

getDraftContracts <- function(year) {
  
  x <- rvest::html(paste0("http://www.spotrac.com/nfl/draft/", year))
  x <- rvest ::html_table(x)
  
  # each round is its own table -----
  x <- lapply(1:length(x), FUN = function(i) {
    
    df <- x[[i]]
    df$Round <- i
    df$Cond_Pick <- grepl(" \\(C\\)", df$Pick)
    df$Pick <- as.numeric(gsub(" \\(C\\)", "", df$Pick))
    df$Yrs <- as.numeric(df$Yrs)
    
    df
    
  })
  
  df <- dplyr::bind_rows(x)
  
  df$`Total Value` <- as.numeric(gsub("\\$|,", "", df$`Total Value`))
  
  df$`Signing Bonus` <- as.numeric(gsub("\\$|,", "", df$`Signing Bonus`))
  cap_index <- which(names(df) == paste(year, "Cap"))
  df[, cap_index] <- as.numeric(gsub("\\$|,", "", df[, cap_index]))
  names(df)[cap_index] <- "Rookie Cap Hit"
  df$`Yearly Avg` <- df$`Total Value`/ df$Yrs
  df$Season <- year
  
  df
}

yrs <- 2011:2016

df_list <- lapply(yrs, getDraftContracts)

df <- dplyr::bind_rows(df_list)
df$Season <- factor(df$Season)

plot_title <- "Average Annual Salary of Rookie Contract"
plot_subtitle <- "Due to compensatory picks rounds 3 through 7 will have varying numbers of selections per season"

p1 <- ggplot(df, aes(x = Pick, y = `Yearly Avg`, colour = Season, group = Season)) + 
  geom_line(size = .8) + theme_fivethirtyeight() +
  ylab("Avg Yearly Value of Rookie Contract") +
  xlab("Pick") +
  scale_x_continuous(breaks = seq.default(1, 225, 32), 
                     labels =c(paste("Round", 1:3), 
                               paste("Pick", seq.default(1, 225, 32)[4:8]))) +
  scale_y_continuous(breaks = seq.default(1000000, 7000000, 1000000),
                     labels = paste0("$", 1:7, " mil"), expand = c(0,100000)) +
  labs(title = plot_title, 
       subtitle = plot_subtitle) +
  guides(colour = guide_legend(nrow = 1))

# outliers -----
label_df <- df %>% filter(Player %in% c("Kyle Rudolph", "Colin McCarthy", 
                                        "Julius Thomas", "Theo Riddick", 
                                        "Braxton Miller"))
label_df$label <- paste0(label_df$Player," (", label_df$Pos, ")")

p1 <- p1 + geom_text(data = label_df, aes(x = Pick, y = `Yearly Avg`, colour = Season, label = label),
                     fontface = "bold", show.legend = FALSE, nudge_x = c(-25, 15, -25, 20, -5), 
                     nudge_y = c(-60000, 120000, 0, 150000, 120000))

# turn into grob and add the bottom text -----
p1 <- ggplotGrob(p1)

subtext <- textGrob("Source: spotrac",
                    gp = gpar(fontsize = 12, fontface = "italic",
                              fontfamily = "sans", col = "#696969"),
                    just = "left", x = unit(0.01, "npc"))

p1 <- gtable_add_rows(p1, heights = unit(0, "mm"), pos = -1)
p1 <- gtable_add_grob(p1, grobTree(subtext), t = nrow(p1), l = 1, 
                      b = nrow(p1)-1, r = 7)
grid.draw(p1)

ggsave(filename = "plots/rookie salaries.png", plot = p1, width = 8*1.2, height = 6*1.2, dpi = 600, units = "in")