Since I am already knocked out of the playoffs (our league playoffs start in week 12), I thought it would be interesting to see which players ended up being the best and worst values of this years draft. It’s only week 13 so these numbers will change by the end of the season and I will update the final results after week 17.

Draft Value (aka you should have drafted Melvin Gordon)

To calculate each players draft value, I simply took the ratio of their Average Draft Position (ADP) to their Value Over Replacement (VOR) rank, the higher the ADP (late round player) and the lower their VOR rank (higher scoring players) the higher this ratio will be.

Biggest Values

Melvin Gordon tops the list of best draft values so far this year, drafted as RB23 at an ADP of 64.5, Gordon is currently 7th in overall scoring putting him at RB3. Other later round guys that have turned into studs so far, DeMarco Murray (drafted as RB18, currently RB4), Matt Ryan (QB19, QB3), LeGarrette Blount (RB38, RB8), and Jordan Howard (RB62, RB12).

Probably the most impressive is David Johnson (RB2, RB1). With a 1st round ADP of 6, he was an expensive pick, but well worth the investment.

Biggest Busts

The players with the lowest value in this years draft are players that were drafted early but got hurt early in the season, Adrian Peterson (RB4, RB118), Keenan Allen (WR8, WR149), and Jamaal Charles (RB8, RB104).

But at least those guys didn’t burn a roster spot all year in the hopes that they would actually produce; you could cut your loses and move on. The guys who really screwed your roster this year were the ones that didn’t miss a single game so far this season. This compost pile consists of DeAndre Hopkins (WR4, WR30), Allen Robinson (WR6, WR28), Todd Gurley (RB1, RB19), and Brandon Marshall (WR9, WR33).

To see the list of worst draft values, sort ascending by the Draft Value column below.

All of the numbers come from FantasyPros and are full point PPR. Also, I removed Defense / Special Teams and Kickers from the list because their ADPs from Fantasy Pros were so low (in the 500s) that they consistently ranked as the top values. If you were to rerun this with your leagues draft position instead of ADP this would correct itself.

The code to reproduce  this is below

library(dplyr)
library(rvest)

## read in data -----
points_url <- "https://www.fantasypros.com/nfl/reports/leaders/ppr.php?year=2016&week=1:13"
fp <- html(points_url) %>% html_table() %>% .[[1]] 

adp_url <- "https://www.fantasypros.com/nfl/adp/ppr-overall.php"
adp <- html(adp_url) %>% html_table() %>% .[[1]] 


## ADP Table -----
teams <- unique(fp$Team)
teams <- c(teams, "DST")
adp_name <- sapply(strsplit(adp$`Player Team (Bye)`, " "), FUN = function(x) {
              
              team_vec <-  x %in% teams
              team_index <- which(team_vec)
              
              if (sum(team_index > 0)) {
                
                name_vec <- x[1:(team_index)]
                out <- paste0(name_vec, collapse = " ")
                
              } else {
                
                out <- paste0(x, collapse = " ")
              }

              out
              }
            )

adp$Player <- adp_name
adp$apd_rank <- adp$Rank

adp <- adp %>% mutate(player = adp_name,
                      adp_rank = Rank,
                      adp_avg = AVG,
                      adp_pos = POS) %>%
  select(player, adp_rank, adp_avg, adp_pos)


## fantasy points table -----
fp$point_rank <- fp$Rank
fp$Player <- paste(fp$Player, fp$Team)
names(fp) <- tolower(names(fp))


## join tables -----

df <- right_join(adp, fp, by = "player")

df[is.na(df$adp_rank), "adp_rank"] <- max(df$adp_rank, na.rm = TRUE) + 1
df[is.na(df$adp_avg), "adp_avg"] <- max(df$adp_avg, na.rm = TRUE) + 1

df <- df %>% select(-rank)

vorp_df <- df %>% group_by(position) %>% arrange(desc(points)) %>% 
  mutate(pos_rank = 1:n(),
         replace_rank = ifelse(position == "QB", 12, 30),
         replace_rank = ifelse(position == "RB", 24, replace_rank),
         replace_rank = ifelse(position == "WR", 24, replace_rank),
         replace_rank = ifelse(position == "TE", 12, replace_rank),
         replace_rank = ifelse(position == "K", 12, replace_rank),
         replace_rank = ifelse(position == "DST", 12, replace_rank),
         replace_value = nth(points, median(replace_rank)),
         vor = points - replace_value,
         vor_per = round( (vor/replace_value) * 100, 2)) %>% ungroup() %>% 
  arrange(desc(vor)) %>% 
  mutate(vor_rank = 1:n(),
         draft_value = adp_avg / vor_rank) %>% ungroup() %>% 
  mutate(pos_rank = paste0(position, pos_rank)) %>%
  filter(!position %in% c("DST", "K"))

## clean up the table -----
final_df <- vorp_df %>% select(player, position, adp_avg, 
                               adp_pos, pos_rank, points, 
                               avg, vor, draft_value) %>% 
  arrange(desc(draft_value))

final_df$draft_value <- round(final_df$draft_value, 3)
final_df$vor <- round(final_df$vor, 1)

names(final_df) <- c("Player", "Pos", "ADP", "Drafted As", "Pos Rank", 
                     "Points", "PPG", "VOR", "Draft Value")

readr::write_csv(final_df, "data/draft_value.csv")