NHL Stanley Cup Playoff Predictions
Ilari Scheinin
Previous: 3. Train models
Next: README
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.
Start by loading packages:
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
## 4which.max(sapply(models, metric_for_final_parameters, metric="Kappa"))## rf
## 4We 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 0bwplot(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,
newdata=add_stats(games, gamestats)))
})})
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 CGYNow 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 CHISimilarly 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 CHIAnd 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 CHIMy 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 CHIHere 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 CHIAgain, 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 CHISo 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.
Next: README
Previous: 3. Train models