Previous: 3. Train models

4. Make predictions

In the previous step, five different types of models (glm, lda, nnet, rf, svmLinear) were fitted to the training data of NHL seasons from 2003 to 2014. Now I want to use those models to make predictions for this year.

suppressMessages({
library(plyr)
library(dplyr)
library(caret)
})

Load the models and summary statistics.

gamestats <- readRDS("processed.rds")
models <- readRDS("models.rds")

Any one of the five models could be used to make predictions. One could for example pick the one with the highest accuracy or Kappa statistic. Each model contains these metrics for each combination of parameter values that were evalauted through cross-validation. The parameters with the highest accuracy were chosen for fitting the final model. The following function returns the cross-validated metric for the final model.

metric_for_final_parameters <- function(fit, metric="Accuracy") {
if (fit$maximize) { chosen <- which.max(fit$result[, fit$metric]) } else { chosen <- which.min(fit$result[, fit$metric]) } fit$result[chosen, metric]
}

which.max(sapply(models, metric_for_final_parameters))
## rf
##  4
which.max(sapply(models, metric_for_final_parameters, metric="Kappa"))
## rf
##  4

We can also look at the performance over all resamplings.

resamps <- resamples(models)
summary(resamps)
##
## Call:
## summary.resamples(object = resamps)
##
## Models: glm, lda, nnet, rf, svmLinear
## Number of resamples: 100
##
## Accuracy
##             Min. 1st Qu. Median   Mean 3rd Qu.   Max. NA's
## glm       0.3750  0.5625 0.6250 0.6291  0.7059 0.8824    0
## lda       0.3750  0.5625 0.6360 0.6351  0.7059 0.8824    0
## nnet      0.4375  0.5542 0.6250 0.6221  0.6875 0.8824    0
## rf        0.2941  0.5625 0.6471 0.6464  0.7059 0.8824    0
## svmLinear 0.4118  0.5294 0.6250 0.6274  0.7059 0.8824    0
##
## Kappa
##              Min. 1st Qu. Median   Mean 3rd Qu.   Max. NA's
## glm       -0.2698 0.06849 0.2381 0.2272  0.3761 0.7463    0
## lda       -0.2698 0.06804 0.2381 0.2402  0.3796 0.7463    0
## nnet      -0.1168 0.09677 0.2131 0.2406  0.3599 0.7671    0
## rf        -0.3973 0.09160 0.2388 0.2533  0.3796 0.7571    0
## svmLinear -0.2687 0.06849 0.2381 0.2260  0.3761 0.7463    0
bwplot(resamps, layout=c(2, 1))

dotplot(resamps, metric="Accuracy")

dotplot(resamps, metric="Kappa")

So, if I were to choose one of the models, overall the random forest could be a god choice. But instead of picking just one, here I will use all five, and then take a majority vote on their individual predictions. Here is the function to do that:

winners <- function(games, models, gamestats) {
suppressMessages({ captured <- capture.output({
predictions <- as.data.frame(sapply(models, predict,
})})
if (nrow(games) == 1) {
predictions <- as.data.frame(t(predictions))
row.names(predictions) <- NULL
}
predictions$winner <- apply(predictions, 1, function(x) names(sort(table(x), decreasing=TRUE))[1]) predictions <- ifelse(predictions == "away", games$awayteam, games$hometeam) cbind(games, predictions) } I also need to include the same add_stats() function that was used when training the models. add_stats <- function(games, gamestats, which=c("both", "single", "overall")) { which <- match.arg(which) if (which == "overall") { away <- left_join(games, gamestats[["overall"]], by=c("season", awayteam="team")) home <- left_join(games, gamestats[["overall"]], by=c("season", hometeam="team")) } else { away <- left_join(games, gamestats[["away"]], by=c("season", awayteam="team")) home <- left_join(games, gamestats[["home"]], by=c("season", hometeam="team")) } if (which == "both") { away2 <- left_join(games, gamestats[["home"]], by=c("season", awayteam="team")) home2 <- left_join(games, gamestats[["away"]], by=c("season", hometeam="team")) } games$goals <- away$goals - home$goals
games$shots <- away$shots - home$shots games$faceoffs <- away$faceoffs - home$faceoffs
games$penalties <- away$penalties - home$penalties games$pp <- away$pp - home$pk
games$pk <- away$pk - home$pp if (which == "both") { games$goals2 <- away2$goals - home2$goals
games$shots2 <- away2$shots - home2$shots games$faceoffs2 <- away2$faceoffs - home2$faceoffs
games$penalties2 <- away2$penalties - home2$penalties games$pp2 <- away2$pp - home2$pk
games$pk2 <- away2$pk - home2$pp } games } Before I can go on to the predictions, I need to define who is playing against who. Here I define the actual playoff games for round 1, and all possible combinations of the playoff bracket for subsequent rounds. round1_games <- data_frame(season="20142015", awayteam=c("PIT", "OTT", "DET", "NYI", "WPG", "MIN", "CHI", "CGY"), hometeam=c("NYR", "MTL", "T.B", "WSH", "ANA", "STL", "NSH", "VAN")) round2_possibilities <- data_frame(season="20142015", awayteam=c( "WSH", "NYI", "T.B", "DET", "OTT", "OTT", "PIT", "PIT", "VAN", "CGY", "NSH", "CHI", "MIN", "MIN", "WPG", "CGY"), hometeam=c( "NYR", "NYR", "MTL", "MTL", "T.B", "DET", "WSH", "NYI", "ANA", "ANA", "STL", "STL", "NSH", "CHI", "VAN", "WPG")) round3_possibilities <- data_frame(season="20142015", awayteam=c( "MTL", "T.B", "DET", "OTT", "WSH", "NYI", "PIT", "WSH", "NYI", "PIT", "DET", "OTT", "DET", "OTT", "PIT", "PIT", "STL", "NSH", "CHI", "MIN", "VAN", "WPG", "CGY", "VAN", "WPG", "CGY", "VAN", "WPG", "CGY", "MIN", "WPG", "CGY"), hometeam=c( "NYR", "NYR", "NYR", "NYR", "MTL", "MTL", "MTL", "T.B", "T.B", "T.B", "WSH", "WSH", "NYI", "NYI", "DET", "OTT", "ANA", "ANA", "ANA", "ANA", "STL", "STL", "STL", "NSH", "NSH", "NSH", "CHI", "CHI", "CHI", "VAN", "MIN", "MIN")) round4_possibilities <- data_frame(season="20142015", awayteam=c( "ANA", "STL", "NSH", "CHI", "VAN", "MIN", "WPG", "CGY", "ANA", "STL", "NSH", "CHI", "VAN", "MIN", "WPG", "CGY", "T.B", "WSH", "NYI", "DET", "OTT", "PIT", "T.B", "WSH", "NYI", "DET", "OTT", "PIT", "NSH", "CHI", "VAN", "MIN", "WPG", "CGY", "WSH", "NYI", "DET", "OTT", "PIT", "WSH", "NYI", "DET", "OTT", "PIT", "WSH", "NYI", "DET", "OTT", "PIT", "MIN", "WPG", "CGY", "MIN", "WPG", "CGY", "DET", "OTT", "PIT", "WPG", "CGY", "WPG", "CGY", "PIT", "CGY"), hometeam=c( "NYR", "NYR", "NYR", "NYR", "NYR", "NYR", "NYR", "NYR", "MTL", "MTL", "MTL", "MTL", "MTL", "MTL", "MTL", "MTL", "ANA", "ANA", "ANA", "ANA", "ANA", "ANA", "STL", "STL", "STL", "STL", "STL", "STL", "T.B", "T.B", "T.B", "T.B", "T.B", "T.B", "NSH", "NSH", "NSH", "NSH", "NSH", "CHI", "CHI", "CHI", "CHI", "CHI", "VAN", "VAN", "VAN", "VAN", "VAN", "WSH", "WSH", "WSH", "NYI", "NYI", "NYI", "MIN", "MIN", "MIN", "DET", "DET", "OTT", "OTT", "WPG", "PIT")) And then finally to the predictions: round1 <- winners(round1_games, models, gamestats) round1 ## season awayteam hometeam glm lda nnet rf svmLinear winner ## 1 20142015 PIT NYR NYR NYR NYR PIT NYR NYR ## 2 20142015 OTT MTL MTL MTL MTL MTL MTL MTL ## 3 20142015 DET T.B T.B T.B T.B T.B T.B T.B ## 4 20142015 NYI WSH NYI NYI NYI NYI NYI NYI ## 5 20142015 WPG ANA ANA ANA ANA WPG ANA ANA ## 6 20142015 MIN STL STL STL MIN STL STL STL ## 7 20142015 CHI NSH CHI CHI CHI CHI CHI CHI ## 8 20142015 CGY VAN CGY CGY CGY VAN CGY CGY Now that I have predictions for round 1 winners, I pick only their games from all the possibilities for round 2: round2 <- winners( filter(round2_possibilities, awayteam %in% round1$winner, hometeam %in% round1$winner), models, gamestats) round2 ## season awayteam hometeam glm lda nnet rf svmLinear winner ## 1 20142015 NYI NYR NYR NYR NYR NYR NYI NYR ## 2 20142015 T.B MTL MTL MTL MTL MTL MTL MTL ## 3 20142015 CGY ANA ANA ANA CGY ANA CGY ANA ## 4 20142015 CHI STL CHI CHI CHI STL CHI CHI Similarly for round 3, the conference finals: round3 <- winners( filter(round3_possibilities, awayteam %in% round2$winner, hometeam %in% round2$winner), models, gamestats) round3 ## season awayteam hometeam glm lda nnet rf svmLinear winner ## 1 20142015 MTL NYR NYR NYR NYR NYR NYR NYR ## 2 20142015 CHI ANA CHI CHI CHI ANA CHI CHI And finally the Stanley Cup final: round4 <- winners( filter(round4_possibilities, awayteam %in% round3$winner, hometeam %in% round3\$winner),
models, gamestats)
round4
##     season awayteam hometeam glm lda nnet  rf svmLinear winner
## 1 20142015      CHI      NYR CHI CHI  CHI CHI       CHI    CHI

My prediction for the 2015 Stanley Cup winner is Chicago Blackhawks.

Validation

As the 2014-2015 playoffs are now over, we have our natural validation set available. (Since I could have naturally tampered with the prediction process after the fact to try to get to the real outcome, here is a link to the first GitHub commit that included my predictions. It was made on April 23rd. So, not before the playoffs started on April 15th, but when round 1 was already 3-4 games in, depending on the series.)

The prediction of Chicago Blackhawks as the the Stanley Cup winner turned out to be correct. But in the finals they played against Tampa Bay Lightning, not New York Rangers. So, let us look at predictions for the playoff series that actually ended up happening. Round 1 is of course as above, but my model got two of those series wrong. Instead of New York Islanders and St. Louis Blues, it was Washington Capitals and Minnesota Wild who made it to the second round.

round2_games <- data_frame(season="20142015",
awayteam=c("WSH", "T.B", "CGY", "MIN"),
hometeam=c("NYR", "MTL", "ANA", "CHI"))
winners(round2_games, models, gamestats)
##     season awayteam hometeam glm lda nnet  rf svmLinear winner
## 1 20142015      WSH      NYR NYR NYR  WSH NYR       NYR    NYR
## 2 20142015      T.B      MTL MTL MTL  MTL MTL       MTL    MTL
## 3 20142015      CGY      ANA ANA ANA  CGY ANA       CGY    ANA
## 4 20142015      MIN      CHI CHI CHI  MIN MIN       CHI    CHI

Here one of the predictions was wrong. Instead of Montreal Canadians, it was Tampa Bay Lightning who made it to the Eastern Conference final.

round3_games <- data_frame(season="20142015",
awayteam=c("T.B", "CHI"),
hometeam=c("NYR", "ANA"))
winners(round3_games, models, gamestats)
##     season awayteam hometeam glm lda nnet  rf svmLinear winner
## 1 20142015      T.B      NYR NYR NYR  T.B T.B       NYR    NYR
## 2 20142015      CHI      ANA CHI CHI  CHI ANA       CHI    CHI

Again, one of the predictions was wrong. In the Stanley Cup final, Chicago Blackhawks faced Tampa Bay Lightning, not New York Rangers.

round4_games <- data_frame(season="20142015",
awayteam=c("CHI"),
hometeam=c("T.B"))
winners(round4_games, models, gamestats)
##     season awayteam hometeam glm lda nnet  rf svmLinear winner
## 1 20142015      CHI      T.B CHI CHI  CHI CHI       CHI    CHI

So overall, the prediction accuracy is:
round 1: 6 out of 8
round 2: 3 out of 4
round 3: 1 out of 2
round 4: 1 out of 1
total: 11 / 15 = 73.3 %

So, by taking the majority vote from five different types of statistical models (glm, lda, nnet, rf, svmLinear) I was able to get a correct prediction for the 2015 Stanley Cup winner, and a 73% overall accuracy for the individual palyoff series. An obvious next step could be to look at each one of the five models separately to see how they performed individually.