Week 11 DraftKings Optimal Lineups

Setup

library(data.table)
library(dtplyr)
library(tidyverse)
library(rPref)
library(kableExtra)
library(plotly)
library(scales)
library(labeling)


week <- 11

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

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

I’ll start with the optimized lineups pulled for the week, 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 [153]
## $ lineup   <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2,...
## $ Name     <chr> "Cardinals", "Tyler Kroft", "Leonard Fournette", "Chr...
## $ team     <chr> "ARI", "BUF", "JAC", "CAR", "JAC", "TBB", "WAS", "CAR...
## $ position <chr> "DST", "TE", "RB", "RB", "WR", "WR", "WR", "QB", "RB"...
## $ pts_base <dbl> 5.841981, 3.451956, 18.860242, 26.315687, 10.922359, ...
## $ pts_pred <dbl> 7.115542, 9.499117, 24.304505, 30.701401, 14.070445, ...
## $ sd_pts   <dbl> 1.4228211, 2.1754744, 1.9781903, 3.2835311, 1.6836537...
## $ Salary   <dbl> 1500, 2800, 7900, 10500, 4500, 7300, 3300, 5300, 6900...

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?

ggplotly(
  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=round(lu/1000, 2), fill=Salary, text=paste(Name, 'in', lu, 'lineups with', dollar(Salary), 'salary'))) +
  geom_bar(stat='identity') +
  facet_wrap(~position, ncol = 3, scales='free_y') +
  coord_flip() +
  #scale_y_continuous(labels = scales::comma) +
  scale_fill_viridis_c() +
  xlab('') +
  ylab('Lineups (Thousands)') +
  ggtitle('Top 10 Players Present by Position') 
) %>% ggplotly(tooltip = 'text')

(Still new to Plotly, sorry about the weird facet widths and funky labels, but since I’m short on time, I thought the benefit of interactivity was worth the funky formatting)

Some of my observations:

• A top-heavy week at QB, we’re still riding Lamar Jackson and Deshaun Watson, with Dak Prescott thrown in there

• Alvin Kamar is the top RB represented, with Brian Hill and Miles Sanders being the value plays.

• They really upped Michael Thomas’ salary, so we won’t be riding him as hard this week. Deebo Samuel is the most represented WR this week, due to low salary. Hopefully he fixes the drops this week

• Second week in a row with a heavy TE favorite, this week being Darren Waller. Eric Ebron is the second most represented.

• Cardinals, Saints, and Lions D Most Represented

Who is getting placed in Lineups?

DraftKings provides scoring for 379 players this week, but only 153 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() 

ggplotly(
proj %>% 
  dplyr::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, text=Name)) +
  geom_point() +
  theme_minimal() +
  scale_color_manual(values = c('red', 'blue'), name="") +
  geom_smooth(inherit.aes = FALSE, aes(x=Salary, y=points), method = 'lm') +
  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)

HEAVY RB week this week, with more than 60% of Flex Spots being taken by RBs

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 = '700px', width = '100%')

Week 11 optimal lineups can be found here