R/nba_model.R

Defines functions get_posSF_val get_posPG_val get_posPF_val get_posC_val get_posSG_val get_pts get_sal get_injury get_min get_team_val

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")
jasbner/dfs documentation built on Dec. 3, 2019, 8:10 p.m.