Pavel Andrienko
03 august 2016
Course project in LITS(Kharkiv), group - March 2016
Задача: На основании исторических данных предсказать результаты финального этапа ЕВРО 2016.
Способ решения: С помощью алгоритмов машинного обучения построить модель, которая будет предсказывать исход матча в категориях победа, ничья или поражение.
Данная работа направлена на изучение возможности предсказания результатов футбольных матчей на основании только исторических данных.
В рамках данной работы проведен анализ исходных данных, собрана статистика по результатам чемпионатов Европы за период 2008-2016 года и построенно несколько различных моделей, таких как SVM, Random Forest, Gradient Boosting и Neural Network.
По результатам работы сделан вывод о необходимости использования дополнительных данных, таких как статистика по игрокам, для более точного прогнозирования результатов матчей.
Лучшая точность которой удалось достичь находится на уровне 60%
Используемые источники данных:
Получение данных из первого источника
Получение данных из второго источника
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
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
В случае 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
# Делаем новый столбец 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 ...
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
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
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
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
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
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
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)
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
library(pROC)
svm_importance <- varImp(svm_model, scale=FALSE)
plot(svm_importance)
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
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
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.
library(pROC)
rf_importance <- varImp(rf_model, scale=FALSE)
plot(rf_importance)
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
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
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.
library(pROC)
gbm_importance <- varImp(gbm_model, scale=FALSE)
plot(gbm_importance)
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
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
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 ...
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
library(neuralnet)
plot(nnet_model, rep="best", intercept=FALSE)
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
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
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
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
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
Cortana Intelligence Suit, обрабатывает статистическую информацию о командах, играх, проведенных ранее, результативности каждого из членов команд — соперников, статистике перенесенных травм, а также массив информации, почерпнутой из новостных порталов, поисковых запросов, социальных сетей. Предсказал победу Германии.
Google IQ, учитывала исключительно внутриигровые моменты предыдущих матчей. Предсказал победу Германии.
Yahoo, cвой прогноз аналитический сервис компании строил на основе массива данных спортивного сервиса и блог-платформы Tumblr. Прогноз был составлен по результатам анализа более чем 20 млрд. сообщений, отобранных по хештегам #football, #soccer, #BongDa, # Euro2016 и #UEFA. Предсказал победу Германии.
NeuroBayes Майкла Файндта, для анализа NeuroBayes получила в свое распоряжение данные о результатах международных матчей, уже сыгранных командами в текущем основном составе. Оценивая шансы на победу каждой из команд в Евро-2016 нейросеть выдала 94 млрд. возможных результатов. Предсказала победу Франции.
Bisnode, в качестве материала для анализа в нейросеть Bisnode была загружена информация об исторических матчах, победах и поражениях команд, индивидуальных достижениях игроков. Предсказала победу Испании.
Слабые места текущей модели и способы их устранения:
для всех игр используется единая статистика, что не совсем корректно, так как состав игроков и качество игры команды меняется со временем. Нужно использовать статистику на момент каждой игры и учитывать состав команд.
В общем случае 3-х классовая классификация сложнее чем 2- классовая, нужно попробовать двумя выходами кодировать различные результаты. Например выигрыш первой комманды 1-0, проигрыш первой команды 0-1, ничья 0-0 и 1-1. Применимо для нейронной сети.
В данной работе используется нейронная сеть с одним скрытым слоем из 10 нейронов. Нужно попробовать различные варианты архитектуры нейронной сети.
Проанализировать те игры, на которых модель возвращает неверный результат. Есть ли там какая-то зависимость?
В данных присутствует симметричность, нужно научить модель также быть симметричной.