Week 9 DraftKings Optimal Lineups

Setup

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

week <- 9

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 [151]
## $ lineup   <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2,...
## $ Name     <chr> "Panthers", "Demaryius Thomas", "Keenan Allen", "Darr...
## $ team     <chr> "CAR", "NYJ", "LAC", "OAK", "PHI", "ARI", "LAC", "TBB...
## $ position <chr> "DST", "WR", "WR", "TE", "QB", "RB", "TE", "WR", "RB"...
## $ pts_base <dbl> 8.776187, 9.556592, 16.401666, 15.610270, 18.016345, ...
## $ pts_pred <dbl> 8.631199, 12.272273, 17.432967, 19.602710, 19.975860,...
## $ sd_pts   <dbl> 0.9123280, 2.2259666, 1.7393016, 2.4085707, 1.1623662...
## $ Salary   <dbl> 2800, 4000, 6400, 6300, 5700, 4500, 6000, 7300, 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:

• Interesting week this week, given the uncertainty around the Chiefs QB Situation. Also, most weeks the model hammers DeShaun Watson and Lamar Jackson, and neither are on the main slate. This week we’re hammering a lot of Russell Wilson. The ‘buy low’ options at QB are Philip Rivers and Ryan Fitzpatrick

• Lots of interchangability at the top of the RB pool, with McCaffrey, Chubb, Jones, Henry, and Bell all making string appearances.

• Keenan Allen showing up a lot at WR, hopefully he breaks out, as he’s tweeted. Both Bucs WRs showing up as well. Model doesn’t have us really paying up for WR this week

• It’s the usual story at TE, there are only a few worth playing, but less segmented than usual, with Doyle and Gesicki bridging the gap.

• Pathers, Redskins, and Dolphins at D again. As with most weeks, the model has selected the Defenses with the lowest prices.

Who is getting placed in Lineups?

DraftKings provides scoring for 355 players this week, but only 151 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)

RB’s lead flex configurations, WR’s second, and TE’s 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 9 optimal lineups can be found here