Writing faster code means that you can run more tests and try out more possibilities, so in this lab, we’ll write a function that calculates ELO many times faster than the for loop we used before. We’ll also take home field advantage for the first time and write our functions so that they’re relatively flexible and will make it easier to take scoring margin into account in the future.
We need to recreate the “reg” data.frame so that it has more information including the scores for both teams. We’re also adding a column “loc” that takes the value of 1 if the team played at home, -1 if the team played on the road and 0 for a neutral site game.
reg <- read.csv('/home/rstudioshared/shared_files/data/RegularSeasonCompactResults.csv')library(dplyr)
reg1 <- reg %>% rename(team = Wteam, opp.team=Lteam, score=Wscore, opp.score=Lscore) %>% mutate(win=1, loc= (Wloc=="H") - (Wloc=="A"))
reg2 <- reg %>% rename(team= Lteam, opp.team=Wteam, score=Lscore, opp.score=Wscore) %>% mutate(win=0, loc= (Wloc=="A") - (Wloc=="H"))
reg <- rbind(reg1, reg2)Let’s also make our Ewins and RatingAdjust functions more flexible.
The Ewins function below takes locations (“loc”) as an input as well as the size of the HFA in ELO points. “HFA=100” set the default value of home field advantage to 100 points of ELO.
Ewins <- function(rating, opp.rating, loc=0, HFA=100)
{ 1/(1 + 10^((opp.rating-rating-loc*HFA)/400))}Similarly, our RatingAdjust function now takes HFA into account. We’re also adding inputs for the scoring margin and something called Kmargin which would allow us to give some weight to the margin when margin of victory. We’re not using this yet but we’ll add it now to make our procedure easier to adapt in the future.
RatingAdjust <- function(rating, opp.rating, wins, K=32, loc, HFA=100, margin=0, Kmargin=0){
rating + K*(wins - Ewins(rating, opp.rating, loc, HFA))
}Let’s take a look at home much we now adjust a team’s rating for beating a team of equal quality first at home, then at a neutral site and finally on the road:
RatingAdjust(1500,1500,1, loc=1)## [1] 1511.518RatingAdjust(1500,1500,1, loc=0)## [1] 1516RatingAdjust(1500,1500,1, loc=-1)## [1] 1520.482I promised a faster ELO calculator and here it is – this wall of R code. This actually, is a function for updating ELO ratings. Take a look at it’s inputs. “df” is the dataframe of game results that it uses to update ELO ratings. “K” is the same K we’ve seen before in our ratings adjustments. “start.elos” can be a second data.frame with the starting ELO’s for each team. This can also be left blank in which case each team will start with an ELO rating of 1500 by default. Any teams that aren’t included in the start.elos data.frame will also be 1500 by default. The final parameter “HFA” let’s you adjust the importance of home field advantage in ELO points.
This function is much faster than our old for loop. Rather than going line by line through every game played one at a time, this for loop updates ELO’s based on the next game for each team simultaneously. So, if each team plays 30 games, this for loop needs to run 30 times rather than 30 multiplied by the number of teams (30*341 = 10,230 times). The trade off is that we do need a more complicated function. This function returns a data.frame with updated ELO’s for each team.
Run the entire block of code below to create this updateELO function.
updateELO <- function(df, K = 25, start.elos=NA, HFA=100){
d <- df
print(nrow(d))
d$elo.start <- NA
d$elo.end <- NA
d$opp.elo.start <- NA
d$opp.elo.end <- NA
d <- d %>% arrange(Daynum)
if (!is.data.frame(start.elos)) {
d[!duplicated(d$team),"elo.start"] <- 1500
d[!duplicated(d$team),"opp.elo.start"] <- 1500
} else {
n<-start.elos[match(d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),"team"],start.elos$team),]$elo.end
n[is.na(n)] <- 1500
d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),]$elo.start <- n
n<-start.elos[match(d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),"opp.team"],start.elos$team),]$elo.end
n[is.na(n)] <- 1500
d[is.na(d$opp.elo.end),][!duplicated(d[is.na(d$opp.elo.end),]$team),]$opp.elo.start<-n
}
d <- d %>% mutate(elo.end=RatingAdjust(elo.start, opp.elo.start, wins=win, K=K, margin=score-opp.score, loc=loc, Kmargin=Kmargin))
d <- d %>% mutate(opp.elo.end=RatingAdjust(opp.elo.start, elo.start, wins=1-win, K=K, margin=score-opp.score,loc=loc, Kmargin=Kmargin))
temp.elos <- d %>% filter(!is.na(elo.end)) %>% group_by(team) %>% top_n(1, Daynum) %>% select(elo.end)
while(sum(is.na(d$elo.end))>0){
print(sum(is.na(d$elo.end)))
n<-temp.elos[match(d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),"team"],temp.elos$team),]$elo.end
d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),]$elo.start <- n[!is.na(n)]
n<-temp.elos[match(d[is.na(d$elo.end),][!duplicated(d[is.na(d$elo.end),]$team),"opp.team"],temp.elos$team),]$elo.end
d[is.na(d$opp.elo.end),][!duplicated(d[is.na(d$opp.elo.end),]$team),]$opp.elo.start<-n[!is.na(n)]
d <- d %>% mutate(elo.end=RatingAdjust(elo.start, opp.elo.start, wins=win, K=K, margin=score-opp.score, loc=loc, HFA=HFA, Kmargin=Kmargin))
d <- d %>% mutate(opp.elo.end=RatingAdjust(opp.elo.start, elo.start, wins=1-win, K=K, margin=score-opp.score,loc=loc, HFA=HFA, Kmargin=Kmargin))
temp.elos <- d %>% filter(!is.na(elo.end)) %>% group_by(team) %>% top_n(1, Daynum) %>% select(elo.end)
}
final.elos <- d %>% group_by(team) %>% top_n(1, Daynum) %>% select(elo.end)
return(final.elos %>% arrange(desc(elo.end)))
}Now, let’s give it a shot. We can created ELO’s based on the 2016 season both using no HFA and a HFA of 100 ELO points.
f2016 <- updateELO(reg %>% filter(Season==2016), HFA=0)
f2016h <- updateELO(reg %>% filter(Season==2016), HFA=100)Take a look at both f2016 and f2016h to see how they compare.
We’ll need our RMSE and LogLoss functions:
RMSE <- function(predictions, actuals){
sqrt(mean((predictions-actuals)^2))
}
LogLoss <- function(predictions, actuals){
(-1/length(predictions)) * sum (actuals * log(predictions) + (1-actuals)*log(1-predictions))
}We’ll also want the team names and the tournament results:
teams <- read.csv('/home/rstudioshared/shared_files/data/teams.csv')tourney <- read.csv('/home/rstudioshared/shared_files/data/TourneyCompactResults.csv')Now, let’s take our elo ratings from the end of the 2016 regular season, f2016, and match them with team names to create “final.elos”. Then you can look at final.elos to see if they look reasonable.
Next, we’ll join the tournament games data.frame with the elo ratings and make predictions for each game. The last line of the code below calculates the RMSE and LogLoss for our predictions.
final.elos <- left_join(f2016, teams, by=c("team"="Team_Id"))
tourney2016 <- tourney %>% filter(Season==2016) %>% mutate(win=1, loc=0)
tourney2016 <- left_join(tourney2016, final.elos, by=c("Wteam"="team"))
tourney2016 <- left_join(tourney2016, final.elos, by=c("Lteam"="team"))
tourney2016 <- tourney2016 %>% mutate(prediction = Ewins(elo.end.x, elo.end.y))
tourney2016 %>% summarize(rmse = RMSE(prediction, win), logloss = LogLoss(prediction,win))To put these numbers in perspective, in our first attempt at ELO (based on one year’s worth of data) we have a RMSE of 0.477 and a Log Loss of 0.646. If we can write a procedure that brings our Log Loss down below 0.576 that would have been a top 200 score (out of 598 competitors) last year. 0.551 or lower would be a top 100 score and a procedure this good or better stands a chance of winning the entire tournament with the help of some strategies which we will discuss in class later.
We can create a function that evaluates ELO ratings by calculating the RMSE and Log Loss in tournament games. This function takes the elo.ratings, the tournament data.frame and the season as inputs:
EvaulateELO <- function(elo_df, tourney_df, season){
t_df <- tourney_df %>% filter(Season==season) %>% mutate(win=1, loc=0)
t_df <- left_join(t_df, elo_df, by=c("Wteam"="team"))
t_df <- left_join(t_df, elo_df, by=c("Lteam"="team"))
t_df <- t_df %>% mutate(prediction = Ewins(elo.end.x, elo.end.y))
print(t_df %>% summarize(rmse = RMSE(prediction, win), logloss = LogLoss(prediction,win)))
}We can use it as follows:
EvaulateELO(f2016, tourney, season=2016)## rmse logloss
## 1 0.4728855 0.6379286Now, let’s calculate ELO’s for 2014, use those as starting values for 2015, calculate ELO’s for 2015, use those as input for 2016 and then evaluate our 2016 ELO’s. While this sounds quite complicated, with the help of our functions, it’s relatively easy:
f2014 <- updateELO(reg %>% filter(Season==2014),K=25)
f2015 <- updateELO(reg %>% filter(Season==2015), K=25,start.elos=f2014)
f2016 <- updateELO(reg %>% filter(Season==2016), K=25, start.elos=f2015)
final.elos <- left_join(f2016, teams, by=c("team"="Team_Id"))
EvaulateELO(f2016, tourney, season=2016)We can also chance K and see if that improves our projections. This code sets K to 35 but you can try an value you wish (try a few!):
K=35
f2014 <- updateELO(reg %>% filter(Season==2014),K=K)
f2015 <- updateELO(reg %>% filter(Season==2015), K=K,start.elos=f2014)
f2016 <- updateELO(reg %>% filter(Season==2016), K=K, start.elos=f2015)
final.elos <- left_join(f2016, teams, by=c("team"="Team_Id"))
EvaulateELO(f2016, tourney, season=2016)What if the final ELO ratings for 2015 aren’t exactly the right starting values for 2016? While, the teams that were good in 2015 tend to be good in 2016, the best teams in 2015 were probably not quite as good in 2016 and the worst teams in 2015 probably weren’t quite as bad. This sounds like regression towards the mean, and we can create a function that regresses ELO ratings towards the mean (1500) so that we can use regressed ELOs form the prior year as our starting values. The parameter “regression” determines how much regression towards the mean we use. Setting regression - 0.4 would regress our ELO ratings 40% of the way towards 1500.
RegressElos <- function(df, regression=0.5){
df[,2] <- regression*1500 + (1-regression)*df[,2]
return(df)
}Now, let’s try it out. The code below uses a K of 35 and 40% regression towards the mean when predicting team EL) from their ELO a year prior. You can try out different K’s and different regression amounts.
K=35; R = 0.4
f2014 <- updateELO(reg %>% filter(Season==2014),K=K)
f2014reg <- RegressElos(f2014, R)
f2015 <- updateELO(reg %>% filter(Season==2015), K=K,start.elos=f2014reg)
f2015reg <- RegressElos(f2015, R)
f2016 <- updateELO(reg %>% filter(Season==2016), K=K, start.elos=f2015reg)
final.elos <- left_join(f2016, teams, by=c("team"="Team_Id"))
EvaulateELO(f2016, tourney, season=2016)Finally, what if one set of ELO’s is simply lucky for one tournament? We might want to judge our procedures using more than one tournament’s worth of data. The following code starts building ELO’s using data from all the way back in 2012 and then evaluates the predictions made in the 2014, 2015 and 2016 tournaments. Of course, you need not limit yourself to three seasons, our data set does all the way back to 1985.
K=35; R = 0.4
f2012 <- updateELO(reg %>% filter(Season==2012), K=K)
f2012reg <- RegressElos(f2012, R)
f2013 <- updateELO(reg %>% filter(Season==2013), K=K,start.elos=f2012reg)
f2013reg <- RegressElos(f2013, R)
f2014 <- updateELO(reg %>% filter(Season==2014), K=K,start.elos=f2013reg)
f2014reg <- RegressElos(f2014, R)
f2015 <- updateELO(reg %>% filter(Season==2015), K=K,start.elos=f2014reg)
f2015reg <- RegressElos(f2015, R)
f2016 <- updateELO(reg %>% filter(Season==2016), K=K, start.elos=f2015reg)EvaulateELO(f2014, tourney, season=2014)
EvaulateELO(f2015, tourney, season=2015)
EvaulateELO(f2016, tourney, season=2016)In our next lab, we will change our functions to take into account margins of victory!