The Steep Slide of NFL Draft Salaries

[This article was first published on R – Jesse Piburn, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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

 

 

To leave a comment for the author, please follow the link and comment on their blog: R – Jesse Piburn.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)