R/nfl_model.R

Defines functions get_posRB_val get_posQB_val get_posWR_val get_posTE_val get_posD_val get_posFLEX_val get_pts get_sal get_injury get_team get_opp_team

load(file = "./data/example_nfl.Rda")
library(tidyverse)
library(RCurl)

# download rotogrinders projected points
url_base <- "https://rotogrinders.com/projected-stats/nfl-"
url_suffix <- ".csv?site=fanduel"
positions_csv <- c("qb","rb","wr","te","defense")

urls <- paste0(url_base,positions_csv,url_suffix)

proj <- NULL
for(u in urls){
  proj <- bind_rows(proj,read_csv(getURL(u),col_names = FALSE))
}
proj <- proj %>% rename(Nickname = X1, Salary = X2, Team = X3, Position = X4,proj_points = X8)
head(proj)

# set total salary
tot_sal <- 60000

dat <- example_nfl
dat <- dat %>% rename(first = `First Name`, last = `Last Name`, injury_flag = `Injury Indicator`, injury_desc = `Injury Details`)
dat <- dat %>% mutate(posRB = as.integer(Position == "RB"),
                      posQB = as.integer(Position == "QB"),
                      posWR = as.integer(Position == "WR"),
                      posTE = as.integer(Position == "TE"),
                      posD = as.integer(Position == "D"),
                      posFLEX = as.integer(!(Position == "QB"|Position == "D")))

proj <- proj %>% mutate(Team = case_when(Team == "KCC" ~ "KC",
                                         Team == "TBB" ~ "TB",
                                         Team == "GBP" ~ "GB",
                                         Team == "SFO" ~ "SF",
                                         TRUE ~ Team))
proj <- proj %>% mutate(init = str_extract(Nickname,"(?<= )[[:alpha:]]"))
dat <- dat %>% mutate(init = str_extract(Nickname,"(?<= )[[:alpha:]]"))

dat <- dat %>% left_join(proj, by = c("Team","Position","Salary","init"))
sum(!is.na(dat$proj_points))

dat <- dat %>% mutate(proj_points = replace_na(proj_points,0))


get_posRB_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posRB)
}
get_posQB_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posQB)
}
get_posWR_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posWR)
}
get_posTE_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posTE)
}
get_posD_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posD)
}
get_posFLEX_val <- function(rownum,poscol){
  dat %>% filter(row_number() == rownum) %>% pull(posFLEX)
}



# need to update this to get expected points from projection website
get_pts <- function(rownum){
  dat %>% filter(row_number() == rownum) %>% pull(FPPG)
}

get_sal <- function(rownum){
  dat %>% filter(row_number() == rownum) %>% pull(Salary)
}

get_injury <- function(rownum){
  dat %>% filter(row_number() == rownum) %>% mutate(inj = as.integer(!is.na(injury_flag))) %>% pull(inj)
}

#get number of players
n = nrow(dat)

# start model
library(ompr)
library(ompr.roi)
library(ROI.plugin.glpk)


model <- MIPModel() %>%
  add_variable(x[i], i = 1:n, type = "binary") %>%
  # set objective (maximize points)
  set_objective(sum_expr(colwise(get_pts(i))* x[i], i = 1:n)) %>%
  add_constraint(sum_expr(colwise(get_sal(i))* x[i], i = 1:n) <= tot_sal) %>%
  add_constraint(sum_expr(colwise(get_posQB_val(i))*x[i], i = 1:n) == 1) %>%
  add_constraint(sum_expr(colwise(get_posRB_val(i))*x[i], i = 1:n) <= 3) %>%
  add_constraint(sum_expr(colwise(get_posWR_val(i))*x[i], i = 1:n) <= 4) %>%
  add_constraint(sum_expr(colwise(get_posTE_val(i))*x[i], i = 1:n) <= 2) %>%
  add_constraint(sum_expr(colwise(get_posD_val(i))*x[i], i = 1:n) == 1) %>%
  add_constraint(sum_expr(colwise(get_posRB_val(i))*x[i], i = 1:n) >= 2) %>%
  add_constraint(sum_expr(colwise(get_posWR_val(i))*x[i], i = 1:n) >= 3) %>%
  add_constraint(sum_expr(colwise(get_posTE_val(i))*x[i], i = 1:n) >= 1) %>%
  add_constraint(sum_expr(colwise(get_posFLEX_val(i))*x[i], i = 1:n) == 7) %>%
  #add injury constraint
  add_constraint(sum_expr(colwise(get_injury(i))*x[i], i = 1:n) == 0)


#we dont want QB and D to face each other
# from this codebase:
# https://github.com/dfs-with-r/coach/tree/master/R
penalty <- 33
total_teams <- length(unique(dat$Team))
get_team <- function(team,rownum){
  dat %>% filter(row_number() == rownum) %>% mutate(t = as.integer(Team == team)) %>% pull(t)
}
get_opp_team <- function(team,rownum){
  dat %>% filter(row_number() == rownum) %>% mutate(t = as.integer(Opponent == team)) %>% pull(t)
}


for (j in unique(dat$Team)) {
  model <- add_constraint(
    model,
    sum_expr(colwise(get_opp_team(j, i)*get_posQB_val(i)*penalty +  get_team(j, i)*get_posD_val(i)) * x[i], i = 1:n) <= penalty)
}


result <- solve_model(model, with_ROI(solver = "glpk", verbose = TRUE))
res <- dat %>% filter(row_number() %in% (result %>% get_solution(x[i]) %>% filter(value == 1) %>% .$i)) %>% arrange(Position)
res
jasbner/dfs documentation built on Dec. 3, 2019, 8:10 p.m.