Prediction the results of the European Championship football games

Pavel Andrienko
03 august 2016

Course project in LITS(Kharkiv), group - March 2016

1. Introduction

Задача: На основании исторических данных предсказать результаты финального этапа ЕВРО 2016.

Способ решения: С помощью алгоритмов машинного обучения построить модель, которая будет предсказывать исход матча в категориях победа, ничья или поражение.

Данная работа направлена на изучение возможности предсказания результатов футбольных матчей на основании только исторических данных.

В рамках данной работы проведен анализ исходных данных, собрана статистика по результатам чемпионатов Европы за период 2008-2016 года и построенно несколько различных моделей, таких как SVM, Random Forest, Gradient Boosting и Neural Network.

По результатам работы сделан вывод о необходимости использования дополнительных данных, таких как статистика по игрокам, для более точного прогнозирования результатов матчей.

Лучшая точность которой удалось достичь находится на уровне 60%

2. How to make dataset, where to get data

Используемые источники данных:

Итоговая статистика

Статистика по играм

3. Gathering data using script in python

Получение данных из первого источника Получение данных

Получение данных из второго источника Получение данных

4. View data in R, source1

data <- read.csv('../input_data1.csv', header = FALSE, sep=";")
names(data) <- c("year", "type1", "type2","team1","team2","score1","score2")
str(data)
'data.frame':   1003 obs. of  7 variables:
 $ year  : int  2008 2008 2008 2008 2008 2008 2008 2008 2008 2008 ...
 $ type1 : Factor w/ 2 levels "final","kvalificaion": 2 2 2 2 2 2 2 2 2 2 ...
 $ type2 : Factor w/ 2 levels "group","playoff": 1 1 1 1 1 1 1 1 1 1 ...
 $ team1 : Factor w/ 54 levels "Австрия","Азербайджан",..: 33 33 33 33 33 33 33 34 34 34 ...
 $ team2 : Factor w/ 54 levels "Австрия","Азербайджан",..: 34 39 46 8 22 6 2 33 39 46 ...
 $ score1: int  2 1 1 2 3 1 5 2 1 0 ...
 $ score2: int  1 1 3 0 1 0 0 2 1 0 ...
dim(data)
[1] 1003    7

5. View data in R, source2

data_summary <- read.csv('../summary.txt', header = FALSE, sep=";", stringsAsFactors = FALSE)
names(data_summary) <- c("team", "played", "won", "drawn", "lost", "for", "against", "diff", "points", "percent")
str(data_summary)
'data.frame':   55 obs. of  10 variables:
 $ team   : chr  "Германия" "Испания" "Хорватия" "Англия" ...
 $ played : int  141 151 76 127 145 144 140 149 134 135 ...
 $ won    : int  92 98 46 75 89 88 76 84 74 76 ...
 $ drawn  : int  30 27 18 33 26 23 45 35 34 29 ...
 $ lost   : int  19 26 12 19 30 33 19 30 26 30 ...
 $ for    : int  302 333 136 257 278 307 217 268 255 234 ...
 $ against: int  106 118 55 89 129 122 97 125 124 127 ...
 $ diff   : int  196 215 81 168 149 185 120 143 131 107 ...
 $ points : int  306 321 156 258 293 287 273 287 256 257 ...
 $ percent: num  72.3 70.9 68.4 67.7 67.4 ...
dim(data_summary)
[1] 55 10

6.1. Preprocessing, make data complete

В случае type1=final - данные продублированы, т.е. для каждой игры 2 записи В случае type1=kvalificaion - данные не продублированы, т.е. для каждой игры 1 запись и данные нужно развернуть и добавить

# Разбиваем данные на части и переворачиваем одну часть
sub_data0 <- data[data$type1 != 'kvalificaion', ]
sub_data1 <- data[data$type1 == 'kvalificaion', ]
sub_data2 <- sub_data1[, c("year","type1","type2","team2","team1", "score2", "score1")]
names(sub_data2) <- c("year","type1","type2","team1","team2", "score1", "score2")
# Склеиваем все данные вместе
data <- rbind(sub_data0, sub_data1, sub_data2)
dim(data)
[1] 1809    7

6.2. Preprocessing, make y variable

# Делаем новый столбец result (defeat, draw, win) и прибиваем score
# draw - ничья, win - выигрыш team1, defeat - выигрыш team2 
data$result <- ifelse(data$score1 == data$score2, "draw", ifelse(data$score1 > data$score2, "win", "defeat"))
data$result <- as.factor(data$result)
data$year <- as.factor(data$year)
data$score1 <- NULL
data$score2 <- NULL
str(data)
'data.frame':   1809 obs. of  6 variables:
 $ year  : Factor w/ 3 levels "2008","2012",..: 1 1 1 1 1 1 1 1 1 1 ...
 $ type1 : Factor w/ 2 levels "final","kvalificaion": 1 1 1 1 1 1 1 1 1 1 ...
 $ type2 : Factor w/ 2 levels "group","playoff": 1 1 1 1 1 1 1 1 1 1 ...
 $ team1 : Factor w/ 54 levels "Австрия","Азербайджан",..: 34 34 34 42 42 42 50 50 50 51 ...
 $ team2 : Factor w/ 54 levels "Австрия","Азербайджан",..: 42 50 51 34 50 51 34 42 51 34 ...
 $ result: Factor w/ 3 levels "defeat","draw",..: 3 3 1 1 3 3 1 1 3 3 ...

6.3. Preprocessing, add statistics to each team

data <- merge(x = data, y = data_summary, by.x = "team1", by.y = "team", all.x = TRUE)
data <- merge(x = data, y = data_summary, by.x = "team2", by.y = "team", all.x = TRUE, suffixes = c(".x",".y"))
dim(data)
[1] 1809   24

6.4. Balancing

table(data$result)

defeat   draw    win 
   741    329    739 
# Балансировка очень простая, просто удваиваем количество матчей с ничьей
data_balanced <- rbind(data, data[data$result == "draw", ])
table(data_balanced$result)

defeat   draw    win 
   741    658    739 

6.5. Normalization

library(dplyr)
vars <- names(data_balanced)
data_normalized <- data_balanced %>% mutate_each_(funs(scale), vars=vars[grepl(".x$", vars) | grepl(".y$", vars)])
data_normalized[1,]
    team2   team1 year        type1 type2 result  played.x     won.x
1 Австрия Бельгия 2012 kvalificaion group   draw 0.4973203 0.4342637
    drawn.x     lost.x     for.x  against.x    diff.x  points.x percent.x
1 0.6709285 -0.1340325 0.4809644 0.03961501 0.3751954 0.4691455 0.5149878
    played.y     won.y   drawn.y    lost.y     for.y against.y    diff.y
1 0.09116518 0.1528651 -0.369044 0.1795408 0.5013436 0.3590423 0.2335361
    points.y percent.y
1 0.09531335 0.3063808

6.6. Check for NA and outliers

sum(is.na(data_normalized))
[1] 0
summary(data_normalized[7:24])
     played.x.V1            won.x.V1            drawn.x.V1     
 Min.   :-2.5869855   Min.   :-1.4683833   Min.   :-1.9735583  
 1st Qu.:-1.1321243   1st Qu.:-0.9298983   1st Qu.:-0.9110413  
 Median : 0.1481536   Median : 0.1111727   Median : 0.1986987  
 Mean   : 0.0000000   Mean   : 0.0000000   Mean   : 0.0000000  
 3rd Qu.: 0.8173898   3rd Qu.: 0.6496578   3rd Qu.: 0.6709285  
 Max.   : 1.5157231   Max.   : 2.0497188   Max.   : 2.2765098  
      lost.x.V1            for.x.V1          against.x.V1    
 Min.   :-1.849970   Min.   :-1.5738003   Min.   :-2.079226  
 1st Qu.:-0.578905   1st Qu.:-0.8813105   1st Qu.:-0.754950  
 Median :-0.261139   Median :-0.0525933   Median :-0.092813  
 Mean   : 0.000000   Mean   : 0.0000000   Mean   : 0.000000  
 3rd Qu.: 0.501500   3rd Qu.: 0.7647717   3rd Qu.: 0.323388  
 Max.   : 3.488502   Max.   : 2.1838080   Max.   : 3.274631  
      diff.x.V1           points.x.V1          percent.x.V1    
 Min.   :-2.7271209   Min.   :-1.5525538   Min.   :-2.3177631  
 1st Qu.:-0.4539522   1st Qu.:-0.9471251   1st Qu.:-0.6889577  
 Median : 0.0677586   Median : 0.0907526   Median : 0.2008234  
 Mean   : 0.0000000   Mean   : 0.0000000   Mean   : 0.0000000  
 3rd Qu.: 0.5708369   3rd Qu.: 0.6637476   3rd Qu.: 0.6884108  
 Max.   : 1.9030628   Max.   : 1.9178499   Max.   : 1.4954338  
     played.y.V1            won.y.V1            drawn.y.V1     
 Min.   :-2.5884264   Min.   :-1.4700822   Min.   :-1.9652923  
 1st Qu.:-1.1321266   1st Qu.:-0.9290998   1st Qu.:-0.9324258  
 Median : 0.1494172   Median : 0.1167996   Median : 0.1943377  
 Mean   : 0.0000000   Mean   : 0.0000000   Mean   : 0.0000000  
 3rd Qu.: 0.8193151   3rd Qu.: 0.6577820   3rd Qu.: 0.6638225  
 Max.   : 1.5183390   Max.   : 2.0643363   Max.   : 2.2600708  
      lost.y.V1            for.y.V1          against.y.V1    
 Min.   :-1.856505   Min.   :-1.5763936   Min.   :-2.082934  
 1st Qu.:-0.583976   1st Qu.:-0.8800091   1st Qu.:-0.701041  
 Median :-0.202218   Median :-0.0466310   Median :-0.095279  
 Mean   : 0.000000   Mean   : 0.0000000   Mean   : 0.000000  
 3rd Qu.: 0.497673   3rd Qu.: 0.7753309   3rd Qu.: 0.321182  
 Max.   : 3.488115   Max.   : 2.2023482   Max.   : 3.274270  
      diff.y.V1           points.y.V1          percent.y.V1    
 Min.   :-2.7338087   Min.   :-1.5537603   Min.   :-2.3209559  
 1st Qu.:-0.4497956   1st Qu.:-0.9462069   1st Qu.:-0.6864743  
 Median : 0.0744041   Median : 0.0953133   Median : 0.2064076  
 Mean   : 0.0000000   Mean   : 0.0000000   Mean   : 0.0000000  
 3rd Qu.: 0.5798824   3rd Qu.: 0.6703193   3rd Qu.: 0.6956942  
 Max.   : 1.9184638   Max.   : 1.9288229   Max.   : 1.5055296  

7.1. Split data to train, test and validation datasets

library(caret)
data.validation <- data_normalized[data_normalized$year == "2016" & data_normalized$type1 == "final", ]
dim(data.validation)
[1] 109  24
data.notvalidation <- data_normalized[!(data_normalized$year == "2016" & data_normalized$type1 == "final"), ]
intrain<-createDataPartition(y=data.notvalidation$result,p=0.7,list=FALSE)
data.train<-data.notvalidation[intrain,]
dim(data.train)
[1] 1421   24
data.test<-data.notvalidation[-intrain,]
dim(data.test)
[1] 608  24

7.2. Check balancing for train, test, validation

table(data.train$result)

defeat   draw    win 
   497    430    494 
table(data.test$result)

defeat   draw    win 
   213    184    211 
table(data.validation$result)

defeat   draw    win 
    31     44     34 

7.3. Seeds and cross-validation

set.seed(123)
seeds <- vector(mode = "list", length = 51)
for(i in 1:50) seeds[[i]] <- sample.int(1000, 36)
seeds[[51]] <- sample.int(1000, 1)
ctrl <- trainControl(method = "repeatedcv",repeats = 5,seeds = seeds)

8.1. Support Vector Machines, model

set.seed(5)
svm_model <- train(result~.,data=data.train[6:24],method = "svmLinear",trControl = ctrl)
svm_model
Support Vector Machines with Linear Kernel 

1421 samples
  18 predictor
   3 classes: 'defeat', 'draw', 'win' 

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 5 times) 
Summary of sample sizes: 1278, 1278, 1279, 1279, 1280, 1279, ... 
Resampling results:

  Accuracy  Kappa   
  0.625708  0.435783

Tuning parameter 'C' was held constant at a value of 1

8.2. Support Vector Machines, features importance plot

library(pROC)
svm_importance <- varImp(svm_model, scale=FALSE)
plot(svm_importance)

plot of chunk unnamed-chunk-15

8.3. Support Vector Machines, prediction on test

set.seed(5)
svm_predicted_test = predict(svm_model,data.test[7:24])
svm_conf_test <- confusionMatrix(svm_predicted_test, data.test$result)
svm_conf_test
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat    143   52  30
    draw       43   88  41
    win        27   44 140

Overall Statistics

               Accuracy : 0.6102          
                 95% CI : (0.5701, 0.6492)
    No Information Rate : 0.3503          
    P-Value [Acc > NIR] : <2e-16          

                  Kappa : 0.4132          
 Mcnemar's Test P-Value : 0.7731          

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                 0.6714      0.4783     0.6635
Specificity                 0.7924      0.8019     0.8212
Pos Pred Value              0.6356      0.5116     0.6635
Neg Pred Value              0.8172      0.7798     0.8212
Prevalence                  0.3503      0.3026     0.3470
Detection Rate              0.2352      0.1447     0.2303
Detection Prevalence        0.3701      0.2829     0.3470
Balanced Accuracy           0.7319      0.6401     0.7423

8.4. Support Vector Machines, prediction on validation

set.seed(5)
svm_predicted_valid = predict(svm_model,data.validation[7:24])
svm_conf_valid <- confusionMatrix(svm_predicted_valid, data.validation$result)
svm_conf_valid
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat      8   14   7
    draw       15   18  16
    win         8   12  11

Overall Statistics

               Accuracy : 0.3394          
                 95% CI : (0.2515, 0.4364)
    No Information Rate : 0.4037          
    P-Value [Acc > NIR] : 0.9296          

                  Kappa : -0.0098         
 Mcnemar's Test P-Value : 0.8796          

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                0.25806      0.4091     0.3235
Specificity                0.73077      0.5231     0.7333
Pos Pred Value             0.27586      0.3673     0.3548
Neg Pred Value             0.71250      0.5667     0.7051
Prevalence                 0.28440      0.4037     0.3119
Detection Rate             0.07339      0.1651     0.1009
Detection Prevalence       0.26606      0.4495     0.2844
Balanced Accuracy          0.49442      0.4661     0.5284

9.1. RandomForest, model

rf_model <- train(result ~ .,data = data.train[6:24],method = "rf",importance = TRUE,ntree = 500,trControl = ctrl)

rf_model
Random Forest 

1421 samples
  18 predictor
   3 classes: 'defeat', 'draw', 'win' 

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 5 times) 
Summary of sample sizes: 1278, 1278, 1279, 1279, 1280, 1279, ... 
Resampling results across tuning parameters:

  mtry  Accuracy   Kappa    
   2    0.5998063  0.3979994
  10    0.5923316  0.3867575
  18    0.5899381  0.3832161

Accuracy was used to select the optimal model using  the largest value.
The final value used for the model was mtry = 2. 

9.2. RandomForest, features importance plot

library(pROC)
rf_importance <- varImp(rf_model, scale=FALSE)
plot(rf_importance)

plot of chunk unnamed-chunk-19

9.3. RandomForest, prediction on test

set.seed(5)
rf_predicted = predict(rf_model,data.test[7:24])
rf_conf_test <- confusionMatrix(rf_predicted, data.test$result)
rf_conf_test
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat    138   46  38
    draw       49   99  51
    win        26   39 122

Overall Statistics

               Accuracy : 0.5905          
                 95% CI : (0.5502, 0.6298)
    No Information Rate : 0.3503          
    P-Value [Acc > NIR] : <2e-16          

                  Kappa : 0.3853          
 Mcnemar's Test P-Value : 0.2675          

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                 0.6479      0.5380     0.5782
Specificity                 0.7873      0.7642     0.8363
Pos Pred Value              0.6216      0.4975     0.6524
Neg Pred Value              0.8057      0.7922     0.7886
Prevalence                  0.3503      0.3026     0.3470
Detection Rate              0.2270      0.1628     0.2007
Detection Prevalence        0.3651      0.3273     0.3076
Balanced Accuracy           0.7176      0.6511     0.7072

9.4. RandomForest, prediction on validation

set.seed(5)
rf_predicted2 = predict(rf_model,data.validation[7:24])
rf_conf_valid <- confusionMatrix(rf_predicted2, data.validation$result)
rf_conf_valid
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat     11   24   8
    draw       13    8  13
    win         7   12  13

Overall Statistics

               Accuracy : 0.2936          
                 95% CI : (0.2102, 0.3885)
    No Information Rate : 0.4037          
    P-Value [Acc > NIR] : 0.9935          

                  Kappa : -0.0539         
 Mcnemar's Test P-Value : 0.3371          

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                 0.3548     0.18182     0.3824
Specificity                 0.5897     0.60000     0.7467
Pos Pred Value              0.2558     0.23529     0.4063
Neg Pred Value              0.6970     0.52000     0.7273
Prevalence                  0.2844     0.40367     0.3119
Detection Rate              0.1009     0.07339     0.1193
Detection Prevalence        0.3945     0.31193     0.2936
Balanced Accuracy           0.4723     0.39091     0.5645

10.1. Gradient Boosting, model

gbm_model <- train(result ~ ., data = data.train[6:24], method = "gbm", trControl = ctrl,verbose = FALSE)

gbm_model
Stochastic Gradient Boosting 

1421 samples
  18 predictor
   3 classes: 'defeat', 'draw', 'win' 

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 5 times) 
Summary of sample sizes: 1278, 1278, 1279, 1279, 1280, 1279, ... 
Resampling results across tuning parameters:

  interaction.depth  n.trees  Accuracy   Kappa    
  1                   50      0.5999270  0.3970404
  1                  100      0.6005062  0.3981106
  1                  150      0.6003585  0.3979069
  2                   50      0.6081070  0.4100215
  2                  100      0.6010716  0.3992778
  2                  150      0.6034829  0.4030870
  3                   50      0.6051552  0.4056347
  3                  100      0.6013562  0.4000427
  3                  150      0.5981107  0.3954962

Tuning parameter 'shrinkage' was held constant at a value of 0.1

Tuning parameter 'n.minobsinnode' was held constant at a value of 10
Accuracy was used to select the optimal model using  the largest value.
The final values used for the model were n.trees = 50, interaction.depth
 = 2, shrinkage = 0.1 and n.minobsinnode = 10. 

10.2. Gradient Boosting, features importance plot

library(pROC)
gbm_importance <- varImp(gbm_model, scale=FALSE)
plot(gbm_importance)

plot of chunk unnamed-chunk-23

10.3. Gradient Boosting, prediction on test

set.seed(5)
gbm_predicted = predict(gbm_model,data.test[7:24])
gbm_conf_test <- confusionMatrix(gbm_predicted, data.test$result)
gbm_conf_test
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat    143   49  27
    draw       44   84  53
    win        26   51 131

Overall Statistics

               Accuracy : 0.5888          
                 95% CI : (0.5485, 0.6282)
    No Information Rate : 0.3503          
    P-Value [Acc > NIR] : <2e-16          

                  Kappa : 0.3817          
 Mcnemar's Test P-Value : 0.955           

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                 0.6714      0.4565     0.6209
Specificity                 0.8076      0.7712     0.8060
Pos Pred Value              0.6530      0.4641     0.6298
Neg Pred Value              0.8201      0.7658     0.8000
Prevalence                  0.3503      0.3026     0.3470
Detection Rate              0.2352      0.1382     0.2155
Detection Prevalence        0.3602      0.2977     0.3421
Balanced Accuracy           0.7395      0.6139     0.7134

10.4. Gradient Boosting, prediction on validation

set.seed(5)
gbm_predicted2 = predict(gbm_model,data.validation[7:24])
gbm_conf_valid <- confusionMatrix(gbm_predicted2, data.validation$result)
gbm_conf_valid
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat      7   12   4
    draw       16   16  19
    win         8   16  11

Overall Statistics

               Accuracy : 0.3119          
                 95% CI : (0.2266, 0.4078)
    No Information Rate : 0.4037          
    P-Value [Acc > NIR] : 0.9811          

                  Kappa : -0.057          
 Mcnemar's Test P-Value : 0.5395          

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity                0.22581      0.3636     0.3235
Specificity                0.79487      0.4615     0.6800
Pos Pred Value             0.30435      0.3137     0.3143
Neg Pred Value             0.72093      0.5172     0.6892
Prevalence                 0.28440      0.4037     0.3119
Detection Rate             0.06422      0.1468     0.1009
Detection Prevalence       0.21101      0.4679     0.3211
Balanced Accuracy          0.51034      0.4126     0.5018

11.1. Neural Network, data preparation

  • All values have to be numbers
  • All values have to be normalized
  • Result value has to be represented as one-hot-vector
data.train.nn <- data.train[6:24]
data.train.nn$win <- c(data.train.nn$result == "win")
data.train.nn$draw  <- c(data.train.nn$result == "draw")
data.train.nn$defeat  <- c(data.train.nn$result == "defeat")
data.train.nn$result <- NULL
str(data.train.nn)
'data.frame':   1421 obs. of  21 variables:
 $ played.x : num [1:1421, 1] 0.497 -1.19 0.206 -1.19 1.458 ...
 $ won.x    : num [1:1421, 1] 0.434 -1.289 0.111 -1.073 1.547 ...
 $ drawn.x  : num [1:1421, 1] 0.671 -1.312 0.86 -1.124 1.332 ...
 $ lost.x   : num [1:1421, 1] -0.134 0.5651 -0.3247 0.0566 -0.4518 ...
 $ for.x    : num [1:1421, 1] 0.481 -1.381 0.299 -1.018 1.446 ...
 $ against.x: num [1:1421, 1] 0.0396 0.872 -0.2442 -0.3009 -0.0928 ...
 $ diff.x   : num [1:1421, 1] 0.375 -1.563 0.366 -0.687 1.232 ...
 $ points.x : num [1:1421, 1] 0.469 -1.315 0.199 -1.098 1.55 ...
 $ percent.x: num [1:1421, 1] 0.515 -1.651 0.367 -1.045 1.067 ...
 $ played.y : num [1:1421, 1] 0.0912 0.0912 0.0912 0.0912 0.0912 ...
 $ won.y    : num [1:1421, 1] 0.153 0.153 0.153 0.153 0.153 ...
 $ drawn.y  : num [1:1421, 1] -0.369 -0.369 -0.369 -0.369 -0.369 ...
 $ lost.y   : num [1:1421, 1] 0.18 0.18 0.18 0.18 0.18 ...
 $ for.y    : num [1:1421, 1] 0.501 0.501 0.501 0.501 0.501 ...
 $ against.y: num [1:1421, 1] 0.359 0.359 0.359 0.359 0.359 ...
 $ diff.y   : num [1:1421, 1] 0.234 0.234 0.234 0.234 0.234 ...
 $ points.y : num [1:1421, 1] 0.0953 0.0953 0.0953 0.0953 0.0953 ...
 $ percent.y: num [1:1421, 1] 0.306 0.306 0.306 0.306 0.306 ...
 $ win      : logi  FALSE FALSE FALSE FALSE FALSE TRUE ...
 $ draw     : logi  TRUE FALSE TRUE FALSE FALSE FALSE ...
 $ defeat   : logi  FALSE TRUE FALSE TRUE TRUE FALSE ...

11.2. Neural Network, model

library(neuralnet)
nnet_model <- neuralnet(win + draw + defeat ~ played.x + won.x + drawn.x + lost.x + for.x + against.x + diff.x + points.x + percent.x + played.y + won.y + drawn.y + lost.y + for.y + against.y + diff.y + points.y + percent.y, data.train.nn, hidden=10, linear.output=F,  lifesign="full")
hidden: 10    thresh: 0.01    rep: 1/1    steps:    1000    min thresh: 0.1285736636
                                                    2000    min thresh: 0.06409621657
                                                    3000    min thresh: 0.03916821049
                                                    4000    min thresh: 0.02566706524
                                                    5000    min thresh: 0.02228667622
                                                    6000    min thresh: 0.02013206583
                                                    7000    min thresh: 0.01705612275
                                                    8000    min thresh: 0.01241390573
                                                    9000    min thresh: 0.01241390573
                                                   10000    min thresh: 0.0104765238
                                                   11000    min thresh: 0.0104765238
                                                   12000    min thresh: 0.01016024182
                                                   12683    error: 292.66193    time: 28.57 secs

11.3. Neural Network, visualization

library(neuralnet)
plot(nnet_model, rep="best", intercept=FALSE)

plot of chunk unnamed-chunk-28

11.4. Neural Network, prediction on test

set.seed(4)
nnet_predicted <- compute(nnet_model, data.test[7:24])
n <- dim(data.test)[1]
nn_result<-0
for (i in 1:n) { nn_result[i] <- which.max(nnet_predicted$net.result[i,]) }
for (i in 1:n) { if (nn_result[i]==1) {nn_result[i] = "win"} }
for (i in 1:n) { if (nn_result[i]==2) {nn_result[i] = "draw"} }
for (i in 1:n) { if (nn_result[i]==3) {nn_result[i] = "defeat"} }
nnet_conf_test <- confusionMatrix(nn_result, data.test$result)
nnet_conf_test
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat    147   45  29
    draw       42  105  55
    win        24   34 127

Overall Statistics

               Accuracy : 0.6233553             
                 95% CI : (0.5834935, 0.6620126)
    No Information Rate : 0.3503289             
    P-Value [Acc > NIR] : < 0.00000000000000022 

                  Kappa : 0.4349075             
 Mcnemar's Test P-Value : 0.1368433             

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity              0.6901408   0.5706522  0.6018957
Specificity              0.8126582   0.7712264  0.8539043
Pos Pred Value           0.6651584   0.5198020  0.6864865
Neg Pred Value           0.8294574   0.8054187  0.8014184
Prevalence               0.3503289   0.3026316  0.3470395
Detection Rate           0.2417763   0.1726974  0.2088816
Detection Prevalence     0.3634868   0.3322368  0.3042763
Balanced Accuracy        0.7513995   0.6709393  0.7279000

11.5. Neural Network, prediction on validation

set.seed(5)
nnet_predicted2 <- compute(nnet_model, data.validation[7:24])
n <- dim(data.validation)[1]
nn_result2<-0
for (i in 1:n) { nn_result2[i] <- which.max(nnet_predicted2$net.result[i,]) }
for (i in 1:n) { if (nn_result2[i]==1) {nn_result2[i] = "win"} }
for (i in 1:n) { if (nn_result2[i]==2) {nn_result2[i] = "draw"} }
for (i in 1:n) { if (nn_result2[i]==3) {nn_result2[i] = "defeat"} }
nnet_conf_valid <- confusionMatrix(nn_result2, data.validation$result)
nnet_conf_valid
Confusion Matrix and Statistics

          Reference
Prediction defeat draw win
    defeat      6   18   7
    draw       19   14  16
    win         6   12  11

Overall Statistics

               Accuracy : 0.2844037             
                 95% CI : (0.2021069, 0.3787806)
    No Information Rate : 0.4036697             
    P-Value [Acc > NIR] : 0.9964094             

                  Kappa : -0.0930831            
 Mcnemar's Test P-Value : 0.8789793             

Statistics by Class:

                     Class: defeat Class: draw Class: win
Sensitivity             0.19354839   0.3181818  0.3235294
Specificity             0.67948718   0.4615385  0.7600000
Pos Pred Value          0.19354839   0.2857143  0.3793103
Neg Pred Value          0.67948718   0.5000000  0.7125000
Prevalence              0.28440367   0.4036697  0.3119266
Detection Rate          0.05504587   0.1284404  0.1009174
Detection Prevalence    0.28440367   0.4495413  0.2660550
Balanced Accuracy       0.43651778   0.3898601  0.5417647

12. General results

plot of chunk unnamed-chunk-31

13. Simulation #1

       team1             team2 result sim_predict
394  Украина          Германия defeat      defeat
1074 Украина            Польша defeat         win
1253 Украина Северная Ирландия defeat        draw
                 team1   team2 result sim_predict
1432 Северная Ирландия Украина    win        draw
1438          Германия Украина    win         win
1445            Польша Украина    win      defeat

14. Simulation #2

sim_data <- data.validation[data.validation$team1 == 'Португалия',]
sim_predict <- predict(rf_model,sim_data[7:24])
cbind(sim_data[, c('team1', 'team2', 'result')], sim_predict)
          team1    team2 result sim_predict
18   Португалия  Австрия   draw      defeat
344  Португалия  Венгрия   draw         win
608  Португалия Исландия   draw         win
1475 Португалия    Уэльс    win         win
1561 Португалия  Франция    win        draw
1813 Португалия  Австрия   draw      defeat
1877 Португалия  Венгрия   draw         win
1927 Португалия Исландия   draw         win

15. Simulation #3

sim_data <- data.validation[data.validation$team1 == 'Германия',]
sim_predict <- predict(rf_model,sim_data[7:24])
cbind(sim_data[, c('team1', 'team2', 'result')], sim_predict)
        team1             team2 result sim_predict
701  Германия            Италия    win      defeat
1067 Германия            Польша   draw         win
1265 Германия Северная Ирландия    win         win
1342 Германия          Словакия    win         win
1438 Германия           Украина    win         win
1584 Германия           Франция defeat         win
1995 Германия            Польша   draw         win

16. Related Work

  • Cortana Intelligence Suit, обрабатывает статистическую информацию о командах, играх, проведенных ранее, результативности каждого из членов команд — соперников, статистике перенесенных травм, а также массив информации, почерпнутой из новостных порталов, поисковых запросов, социальных сетей. Предсказал победу Германии.

  • Google IQ, учитывала исключительно внутриигровые моменты предыдущих матчей. Предсказал победу Германии.

  • Yahoo, cвой прогноз аналитический сервис компании строил на основе массива данных спортивного сервиса и блог-платформы Tumblr. Прогноз был составлен по результатам анализа более чем 20 млрд. сообщений, отобранных по хештегам #football, #soccer, #BongDa, # Euro2016 и #UEFA. Предсказал победу Германии.

  • NeuroBayes Майкла Файндта, для анализа NeuroBayes получила в свое распоряжение данные о результатах международных матчей, уже сыгранных командами в текущем основном составе. Оценивая шансы на победу каждой из команд в Евро-2016 нейросеть выдала 94 млрд. возможных результатов. Предсказала победу Франции.

  • Bisnode, в качестве материала для анализа в нейросеть Bisnode была загружена информация об исторических матчах, победах и поражениях команд, индивидуальных достижениях игроков. Предсказала победу Испании.

17. Future Work

Слабые места текущей модели и способы их устранения:

  • для всех игр используется единая статистика, что не совсем корректно, так как состав игроков и качество игры команды меняется со временем. Нужно использовать статистику на момент каждой игры и учитывать состав команд.

  • В общем случае 3-х классовая классификация сложнее чем 2- классовая, нужно попробовать двумя выходами кодировать различные результаты. Например выигрыш первой комманды 1-0, проигрыш первой команды 0-1, ничья 0-0 и 1-1. Применимо для нейронной сети.

  • В данной работе используется нейронная сеть с одним скрытым слоем из 10 нейронов. Нужно попробовать различные варианты архитектуры нейронной сети.

  • Проанализировать те игры, на которых модель возвращает неверный результат. Есть ли там какая-то зависимость?

  • В данных присутствует симметричность, нужно научить модель также быть симметричной.