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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.