load(file = "./data/example_nba.Rda")
library(tidyverse)
# set total salary
tot_sal <- 60000
example_nba <- read_csv("./data-raw/FanDuel-NBA-2019-12-03-41237-players-list.csv")
dat <- example_nba
dat <- dat %>% rename(first = `First Name`, last = `Last Name`, injury_flag = `Injury Indicator`, injury_desc = `Injury Details`)
dat <- dat %>% mutate(posSF = as.integer(Position == "SF"),
posPG = as.integer(Position == "PG"),
posPF = as.integer(Position == "PF"),
posC = as.integer(Position == "C"),
posSG = as.integer(Position == "SG"))
#lets find minutes last 3 games
library(httr)
rotations <- GET("https://www.rotowire.com/basketball/tables/rotations.php")
rotations <- content(rotations)
rotations_df <- data.table::as.data.table(rotations$rotations)
minutes <- pivot_longer(rotations_df, everything(), names_to = "team", values_to = "lst") %>% pull(lst) %>% bind_rows() %>% select(id:lastname,mpgSeason:gm5) %>% select(first = firstname, last = lastname, everything())
minutes <- unique(minutes)
dat <- dat %>% left_join(minutes)
get_posSF_val <- function(rownum,poscol){
dat %>% filter(row_number() == rownum) %>% pull(posSF)
}
get_posPG_val <- function(rownum,poscol){
dat %>% filter(row_number() == rownum) %>% pull(posPG)
}
get_posPF_val <- function(rownum,poscol){
dat %>% filter(row_number() == rownum) %>% pull(posPF)
}
get_posC_val <- function(rownum,poscol){
dat %>% filter(row_number() == rownum) %>% pull(posC)
}
get_posSG_val <- function(rownum,poscol){
dat %>% filter(row_number() == rownum) %>% pull(posSG)
}
# 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(ifelse(injury_flag=="GTD"|is.na(injury_flag),0,1))) %>% pull(inj)
}
get_min <- function(rownum){
dat %>% filter(row_number() == rownum) %>% mutate(min_minutes = as.integer(is.na(mpgSeason))) %>% pull(min_minutes)
}
#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_posPG_val(i))*x[i], i = 1:n) == 2) %>%
add_constraint(sum_expr(colwise(get_posSG_val(i))*x[i], i = 1:n) == 2) %>%
add_constraint(sum_expr(colwise(get_posSF_val(i))*x[i], i = 1:n) == 2) %>%
add_constraint(sum_expr(colwise(get_posPF_val(i))*x[i], i = 1:n) == 2) %>%
add_constraint(sum_expr(colwise(get_posC_val(i))*x[i], i = 1:n) == 1) %>%
#add injury constraint
add_constraint(sum_expr(colwise(get_injury(i))*x[i], i = 1:n) == 0) %>%
add_constraint(sum_expr(colwise(get_min(i))*x[i], i = 1:n) == 0)
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
# rerun 99 times to get additional teams but none the same.
get_team_val <- function(rownum,teamnum){
dat %>% filter(row_number() == rownum) %>% pull(teamnum)
}
for(old_team in 1:99){
#colname
j = paste0("t",old_team)
#add new column to dat of old team
dat <- dat %>% mutate(!!j := as.integer(Id %in% res$Id))
# add constraint that we cant have an old team exactly
model <- model %>% add_constraint(sum_expr(colwise(get_team_val(i,j))*x[i], i = 1:n) <= 8)
# solve new model
result <- solve_model(model, with_ROI(solver = "glpk", verbose = TRUE))
# get result set
res <- dat %>% filter(row_number() %in% (result %>% get_solution(x[i]) %>% filter(value == 1) %>% .$i)) %>% arrange(Position)
}
dat <- dat %>% mutate(t100 := as.integer(Id %in% res$Id))
# get long format team
res_teams <- pivot_longer(dat,cols = t1:t100) %>% filter(value == 1) %>% arrange(name)
# # get actual scores for a night
# load("./data/fd_nba_mapping.rda")
# actual <- res_teams %>% left_join(fd_nba_mapping, by = c("Id")) %>% left_join(daily_season_stats, by = c("PLAYER_ID"))
# library(lubridate)
# oneday <- actual %>% filter(date == "2019-12-01")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.