Game Weights and Submisssions

Game Weights

Ben suggested that we might want to give some games more weight than others in our ELO ratings. More specifically, we might give more weight to games between evenly matched teams (when the two teams are likely giving their regular rotation the most minutes) and the least weight to woefully uneven match-ups.

Thankfully, we already have a function, Ewins, that gives us the odds of either teams winning the game so one way to give close games the most weight is to assign the most weight to games where Ewins returns a value close to 0.5. To use this to assign weights, we need to use or create a function that reaches its maximum at 0.5 and decreases as we approach 0 or 1. Double thankfully, we know just such a function:

We can use this function to turn our expected wins into weights. In the code below, the denominator “dnorm(0)” is used so that when the expected numbers of wins equals 0.5 (a perfectly even match up) the game is given a weight of 1.

expected.wins <- seq(0.01, 0.99, 0.01)

weights <- dnorm(qnorm(expected.wins))/dnorm(0)

plot(expected.wins, weights, type="l")

Does this weighting look too extreme? In other words, are we giving uneven games too little relative weight? If so, we can fix that by raising our weights to a power less than 1. If, on the other hand, we want to make our weighting scheme more extreme we could raise our weights to a power greater than 1. Take a careful look at our graphs (including the y-axis) for each of the following:

plot(expected.wins, weights^0.1, type="l")
plot(expected.wins, weights^10, type="l")
plot(expected.wins, weights^0, type="l")

Game Weight Function

Let’s write this up as a function:

GameWeight <- function(rating, opp.rating, loc, HFA, power=0.5){
  (dnorm(qnorm(Ewins(rating, opp.rating, loc, HFA)))/dnorm(0))^power}

To actually use these weights, we’ll have to incorporate this function into our RatingAdjust function. Here’s the old function along with a new one which multiplies K and Kmargin by the our new game weights. In this new function, we can change the power that we raise the weights to (we call that power “gw.power”). Remember, higher powers lead to more extreme weights. A gw.power of 0, the default, leads to every game getting the same weight. gw.powers in the 0 to 1 range likely the most reasonable. Note that as we use higher gw.powers, we may have to increase K and Kmargin to compensate – since if some games are getting less weight we might want other games to get more.

RatingAdjust <- function(rating, opp.rating, wins, K=32, loc, HFA=100, margin=0, Kmargin=0){
  rating + K*(wins - Ewins(rating, opp.rating, loc, HFA)) + 
          Kmargin*(MarginWins(margin) - Ewins(rating, opp.rating, loc, HFA) )
}



RatingAdjust <- function(rating, opp.rating, wins, K=32, loc, HFA=100, margin=0, Kmargin=0, gw.power=0.5){
  rating + (K*(wins - Ewins(rating, opp.rating, loc, HFA)) + 
          Kmargin*(MarginWins(margin) - Ewins(rating, opp.rating, loc, HFA)))*
        GameWeight(rating=rating, opp.rating=opp.rating, loc=loc, HFA=HFA, power=gw.power)
        
}

We should also create a new version of our updateELO function that allows us to alter gw.power and have it effect our ELO ratings:

updateELO <- function(df, K = 25, Kmargin=0, start.elos=NA, HFA=100, gw.power=0){
  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, gw.power=gw.power))
  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, gw.power=gw.power))
  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, gw.power=gw.power))
    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, gw.power=gw.power))
    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)))
}

Submitting Predictions to Kaggle

First let’s take a look at the sample submission file. Our submission will need to take this form – two columns one of which is the id for the game and the other is our prediction for that game.

sub <- read.csv('/home/rstudioshared/shared_files/data/sample_submission.csv')
View(sub)

If you look closely at the id column in the sample submission, you’ll see that it contains three pieces of information separated by underscores: the year, the team id for the 1st team and the team id for the 2nd team. The predictions are our estimated probabilities that the first team wins the game.

We can use the separate function in the tidyr package to separate this id column into three columns.

library(tidyr);library(dplyr)
sub %>% separate(id, into=c("year", "team", "opp.team"), sep="_", remove=FALSE)
View(sub)

Creating a Submission file from ELO’s

Now, let’s make predictions based on our ELO ratings. Better yet, let’s make a function that does that for us. This function will look considerably like our CheckELO function but instead of updating ELO using regular season games and then checking predictions using tournament games, this function will update ELOs using regular season games and then simply make predictions on tournament games (without checking them) and create a .csv file of predictions that can be submitted to Kaggle.

CreateSubmissionFile <- function(K=20, Kmargin=20, R=0.1, start.season=2010, end.season=2016, gw.power=0){
  sub <- sub[,c("id", "pred")]  %>% separate(id, into=c("year", "team", "opp.team"), sep="_", remove=FALSE)
  elos.by.year <- data.frame(year=character(), team = character(), elo=numeric())
  f <- updateELO(reg %>% filter(Season==start.season), K=K, Kmargin=Kmargin, gw.power=gw.power)
  elos.by.year <- rbind(elos.by.year, data.frame(year=as.character(start.season), team=as.character(f$team), elo=f$elo.end))
  if(length(start.season:end.season)>1){
    for (i in seq_along((start.season:end.season)[-1])){
      f <- RegressElos(f, R)
      f <- updateELO(reg %>% filter(Season==start.season+i), K=K, Kmargin=Kmargin, gw.power=gw.power, start.elos=f)
      elos.by.year <- rbind(elos.by.year, data.frame(year=as.character(start.season+i), team=as.character(f$team), elo=f$elo.end))
    }
  }
  sub <- left_join(sub, elos.by.year, by=c("year", "team"))
  sub <- left_join(sub, elos.by.year, by=c("year", "opp.team" = "team"))
  sub <- sub %>% mutate(pred = Ewins(elo.x, elo.y, loc=0, HFA=100))
  write.csv(sub %>% select(id, pred), 'submission.csv', row.names=FALSE)
  
}

We can use this function the same way we would use our CheckELO function. Each time we run it a “submission.csv” file should be created in our project folder.

CreateSubmissionFile(K=35, Kmargin=15, R=0.1, start.season=2009, end.season=2016, gw.power=0.5)

CreateSubmissionFile(K=35, Kmargin=15, R=0.1, start.season=2009, end.season=2016, gw.power=0.25)

After, you’ve created a Kaggle account, you can join the March Machine Learning 2017 competition, download this file from your Rstudio account and then submit it to Kaggle.

Note that you can only submit two ballots per day. This means that we might still want to check the accuracy of our models ourselves. An additional advantage of checking our results ourselves is that we can check our models using more than four years worth of data. With that in mind, let’s create a new CheckELO function that allows us to give more weight to close games:

New CheckELO function

CheckELO <- function(K=20, Kmargin=20, R=0.1, start.season=2012, end.season=2016, gw.power=0){
  results <- data.frame(season=numeric(), RMSE=numeric(), LogLoss=numeric())
  f <- updateELO(reg %>% filter(Season==start.season), K=K, Kmargin=Kmargin, gw.power=0)
  res <- EvaluateELO(f, tourney, season=start.season)
  results[1,] <- as.numeric(c(start.season, res))
  if(length(start.season:end.season)>1){
    for (i in seq_along((start.season:end.season)[-1])){
      f <- RegressElos(f, R)
      f <- updateELO(reg %>% filter(Season==start.season+i), K=K, Kmargin=Kmargin, gw.power=0,start.elos=f)
      res <- EvaluateELO(f, tourney, season=start.season+i)
      results[1+i,] <- as.numeric(c(start.season+i, res))
    }
      
  }
  return(results)
}

Have fun!

At this point, it’s just a matter of finding the best values for K, Kmargin, R, HFA and gw.power. Good luck!