Week 8 DraftKings Optimal Lineups

Setup

library(data.table)
library(dtplyr)
library(tidyverse)
library(rPref)
library(kableExtra)

week <- 8

proj <- readRDS(paste0('week_', week, '_proj.RDS'))

sal <- read_csv(paste0('DKSalaries_wk_', week, '.csv'))

I’ll start with the optimized lineups pulled for week 4, with the same details as last time: 10,000 lineups, using the standard deviation of projections, completely individually based (still working on that).

sim_lu <- readRDS(paste0('sim_lineups_week_', week, '.RDS')) %>%
  rename(pts_base=points) %>%
  select(lineup, Name, team, position, pts_base, pts_pred, sd_pts, Salary)

glimpse(sim_lu)

## Observations: 90,000
## Variables: 8
## Groups: Name [169]
## $ lineup   <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2,...
## $ Name     <chr> "Jaguars", "DeAndre Hopkins", "Josh Hill", "Cameron B...
## $ team     <chr> "JAC", "HOU", "NOS", "TBB", "LAR", "CIN", "HOU", "DET...
## $ position <chr> "DST", "WR", "TE", "TE", "RB", "WR", "QB", "WR", "RB"...
## $ pts_base <dbl> 8.296376, 21.096072, 7.121320, 7.771596, 17.685417, 1...
## $ pts_pred <dbl> 11.160235, 22.598214, 11.408854, 9.940246, 20.022272,...
## $ sd_pts   <dbl> 1.7968880, 0.8933727, 1.7777746, 1.2992043, 1.6497544...
## $ Salary   <dbl> 2900, 8100, 3200, 2700, 7400, 5100, 7100, 6400, 7000,...

sim_lu %>%
  filter(lineup<=3) %>%
  arrange(lineup, position, desc(pts_pred)) %>%
  mutate_at(vars(pts_base, pts_pred, sd_pts), function(x) round(x, 2)) %>%
  knitr::kable() %>%
  kable_styling() %>%
  column_spec(1, bold=TRUE) %>%
  collapse_rows(columns = 1, valign = 'top') %>%
  scroll_box(height = '600px', width = '100%')

Who is in Optimal Lineups?

sim_lu %>%
  group_by(Name, position, Salary) %>%
  dplyr::summarize(lu=n_distinct(lineup)) %>%
  ungroup() %>%
  group_by(position) %>%
  top_n(10, lu) %>%
  ungroup() %>%
  arrange(position, desc(lu)) %>%
  mutate(Name=factor(Name),
         Name=fct_reorder(Name, lu)) %>%
  ggplot(aes(x=Name, y=lu/1000, fill=Salary)) +
  geom_bar(stat='identity') +
  facet_wrap(~position, ncol = 3, scales='free') +
  coord_flip() +
  scale_y_continuous(labels = scales::comma) +
  scale_fill_viridis_c() +
  xlab('') +
  ylab('Lineups (Thousands)') +
  ggtitle('Top 10 Players Present by Position') 

Some of my observations:

• We’ve kind of seen QBs go back and forth between one heavy favorite and lots of parity. This is one of the heavy favorite weeks, with DeShaun Watson is over half of lineups. (Note, I removed Matt Ryan from being considered due to him being unlikely to play)

• Conversely this is a week with lots of parity at the RB spot. Devonta Freeman is in the most lineups, likely due to his modest price. They’re still pricing Saquon Barkley VERY high.

• Michael Thomas is the favorite at WR, showing up in almost 50% of lineups, followed up by a group of WRs. Interestingly Boyd has been a play for most weeks, these analysts are seemingly big on a rebound for him.

• It’s the usual story at TE, there are only a few worth playing. Usually there’s two tiers, but this week Austin Hooper looks to be a big favorite.

• Raiders, Jags and Panthers are the most common defenses most likely due to their price. Over the last few weeks, the model has selected the Defenses with the lowest prices.

Who is getting placed in Lineups?

DraftKings provides scoring for 425 players this week, but only 169 make it into optimized lineups. Why is that? To determine, I’ll plot projected points vs salary, colored by whether or not they make it into optimized lineups, and sized by their projection standard deviation

plyr_lu <- sim_lu %>%
  group_by(Name, position) %>%
  dplyr::summarize(lu=n_distinct(lineup)) %>%
  ungroup() 

proj %>% 
  filter(avg_type=='weighted') %>%
  mutate(Name = ifelse(pos=="DST", last_name, paste(first_name, last_name))) %>%
  inner_join(sal, by=c("Name")) %>%
  select(Name, team, position, points, Salary, sd_pts) %>%
  left_join(plyr_lu, by='Name') %>%
  replace_na(list(lu=0)) %>%
  mutate(lu_bin=ifelse(lu==0, '0 Lineups', '>=1 Lineups'),
         lu_5=cut(lu,5, labels = FALSE)) %>%
  ggplot(aes(x=Salary, y=points, color=lu_bin, size=sd_pts)) +
  geom_point() +
  scale_color_manual(values = c('red', 'blue'), name="") +
  geom_smooth(inherit.aes = FALSE, aes(x=Salary, y=points), method = 'lm', se=FALSE) +
  ylab('Projected Points') +
  xlab('Salary') +
  ggtitle('Who makes it into Optimized Lineups?') +
  scale_x_continuous(labels=scales::dollar)

This week, not many players below the line get into lineups, but some above get excluded due to their small uncertainty. Remember, this method takes players who have the potential to blow up rather than players with solid floors.

Flex Configurations

In DFS lineups, you have an extra spot to use on an RB, WR, and TE of your chosing

sim_lu %>%
  group_by(lineup) %>%
  mutate(lineup_pts=sum(pts_pred)) %>%
  group_by(lineup, position) %>%
  mutate(n=n()) %>%
  select(lineup, position, n, lineup_pts) %>%
  distinct() %>%
  spread(key=position, value=n) %>%
  filter(RB>=2, TE>=1, WR>=3) %>%
  mutate(flex=case_when(RB==3 ~ 'RB',
                        TE==2 ~ 'TE',
                        WR==4 ~ 'WR')) %>%
  group_by(flex) %>%
  dplyr::summarize(pts=median(lineup_pts),
                   cases=n()) %>%
  knitr::kable() %>%
  kable_styling(full_width = FALSE)

Pretty even flex configurations, with WRs being the most popular RB’s the second, and TE’s a distance third

Pareto Lineups

lu_df <- sim_lu %>%
  group_by(lineup) %>%
  dplyr::summarize(lineup_pts=sum(pts_pred),
                   lineup_sd=sum(sd_pts)) %>%
  ungroup()

pto <- psel(lu_df, low(lineup_sd) * high(lineup_pts))


ggplot(lu_df, aes(y=lineup_pts, x=lineup_sd)) +
  geom_point() +
  geom_point(data=pto, size=5) +
  ylab('Lineup Points') +
  xlab('Lineup Points St Dev') +
  ggtitle('Lineup Points vs Uncertainty',
          subtitle = 'Pareto Lineups Bolded')

Here’s a look at the pareto lineups.

psel(lu_df, low(lineup_sd) * high(lineup_pts)) %>%
  left_join(sim_lu, by='lineup') %>%
  group_by(lineup) %>%
  arrange(lineup_pts, position, desc(Salary)) %>%
  select(lineup, lineup_pts, lineup_sd, Name, team, position, pts_pred, sd_pts, Salary) %>%
  mutate_at(vars(lineup_pts, lineup_sd, pts_pred, sd_pts), function(x) round(x, 2)) %>%
  knitr::kable() %>%
  kable_styling(fixed_thead = T) %>%
  column_spec(1:3, bold=TRUE) %>%
  collapse_rows(columns = 1:3, valign = 'top') %>%
  scroll_box(height = '500px', width = '100%')

Week 8 optimal lineups can be found here