この前の投稿『サッカー試合の結果『勝・分・負』で、それぞれの出る確率が1/3になる？』で
http://qiita.com/xuyun19840618/items/087f55ba5c4bb2b90b9d
全ての要素が同じである両チームの対戦で、引分の結果が出る確率が $1/3$ ではないと分かりました。
要素が違う両チームの対戦で、勝分敗が出る確率の理論値も計算できます。さらに、実際の各リーグのデータを使い、検証してみます。
いくつかの国の1次リーグ過去10年のデータ
シーズン2015:ヨーロッパ各国のリーグは2015~2016と、アジア各国は2015となります。
勝率、分率、敗率：ホームチームの勝率、分率、敗率となります。
攻撃力：ここで公開しません。
England,Italy,Spain,France：チーム数 20、 節数 38
Germany,Japan：チーム数 18、 節数 34
China(過去8年)：チーム数 16、 節数 30
| 10年間平均 | 勝率 | 分率 | 敗率 | 攻撃力home | 攻撃力away |
|---|---|---|---|---|---|
| England | 0.4600 | 0.2582 | 0.2818 | 1.5389 | 1.1382 |
| Italy | 0.4640 | 0.2716 | 0.2645 | 1.4974 | 1.1041 |
| Spain | 0.4839 | 0.2340 | 0.2821 | 1.5965 | 1.1341 |
| Germany | 0.4523 | 0.2464 | 0.3013 | 1.6149 | 1.2610 |
| France | 0.4490 | 0.2874 | 0.2637 | 1.3886 | 1.0195 |
| Japan | 0.4310 | 0.2372 | 0.3317 | 1.4932 | 1.2606 |
| China | 0.4552 | 0.3010 | 0.2437 | 1.4763 | 1.0673 |
> England
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4132 0.2816 0.3053 1.4918 1.2078
2014 0.4526 0.2447 0.3026 1.4738 1.0928
2013 0.4711 0.2053 0.3237 1.5730 1.1948
2012 0.4368 0.2842 0.2789 1.5578 1.2398
2011 0.4500 0.2447 0.3053 1.5893 1.2150
2010 0.4711 0.2921 0.2368 1.6240 1.1740
2009 0.5079 0.2526 0.2395 1.6975 1.0735
2008 0.4553 0.2553 0.2895 1.4003 1.0790
2007 0.4632 0.2632 0.2737 1.5288 1.1073
2006 0.4789 0.2579 0.2632 1.4525 0.9975
> Italy
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4605 0.2500 0.2895 1.4718 1.1055
2014 0.4000 0.3158 0.2842 1.5003 1.1948
2013 0.4763 0.2368 0.2868 1.5365 1.1868
2012 0.4658 0.2526 0.2816 1.4948 1.1443
2011 0.4553 0.2921 0.2526 1.4968 1.0605
2010 0.4711 0.2553 0.2737 1.4310 1.0815
2009 0.4895 0.2684 0.2421 1.5420 1.0683
2008 0.5053 0.2500 0.2447 1.5205 1.0785
2007 0.4605 0.2947 0.2447 1.4910 1.0608
2006 0.4553 0.3000 0.2447 1.4898 1.0598
> Spain
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4816 0.2421 0.2763 1.6190 1.1263
2014 0.4500 0.2395 0.3105 1.5365 1.1183
2013 0.4711 0.2263 0.3026 1.6318 1.1180
2012 0.4974 0.2211 0.2816 1.6878 1.1853
2011 0.4947 0.2474 0.2579 1.6783 1.0835
2010 0.5184 0.2079 0.2737 1.6373 1.1053
2009 0.5105 0.2500 0.2395 1.6003 1.1133
2008 0.4842 0.2184 0.2974 1.6600 1.2378
2007 0.4789 0.2289 0.2921 1.5503 1.1378
2006 0.4526 0.2579 0.2895 1.3640 1.1155
> Germany
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4412 0.2320 0.3268 1.5644 1.2642
2014 0.4739 0.2680 0.2582 1.5886 1.1664
2013 0.4739 0.2092 0.3170 1.7492 1.4119
2012 0.4248 0.2549 0.3203 1.5917 1.3431
2011 0.4542 0.2582 0.2876 1.6606 1.2006
2010 0.4608 0.2059 0.3333 1.6469 1.2739
2009 0.4085 0.2810 0.3105 1.5136 1.3164
2008 0.4804 0.2418 0.2778 1.6992 1.2222
2007 0.4673 0.2549 0.2778 1.6703 1.1406
2006 0.4379 0.2582 0.3039 1.4644 1.2706
> France
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4211 0.2842 0.2947 1.4370 1.0890
2014 0.4763 0.2316 0.2921 1.4110 1.0813
2013 0.4395 0.2842 0.2763 1.4100 1.0480
2012 0.4474 0.2842 0.2684 1.4683 1.0763
2011 0.4711 0.2842 0.2447 1.4748 1.0418
2010 0.4132 0.3421 0.2447 1.3425 0.9988
2009 0.4711 0.2553 0.2737 1.3893 1.0210
2008 0.4342 0.2947 0.2711 1.2870 0.9703
2007 0.4395 0.3053 0.2553 1.3480 0.9363
2006 0.4763 0.3079 0.2158 1.3180 0.9318
> Japan
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.3856 0.2451 0.3693 1.4111 1.2675
2014 0.4085 0.2516 0.3399 1.3497 1.1803
2013 0.4641 0.2222 0.3137 1.5656 1.3072
2012 0.4052 0.2484 0.3464 1.5025 1.2914
2011 0.4346 0.2451 0.3203 1.5489 1.2911
2010 0.4281 0.2614 0.3105 1.4247 1.2322
2009 0.4314 0.2614 0.3072 1.4281 1.1569
2008 0.4477 0.2288 0.3235 1.4153 1.1439
2007 0.4346 0.2092 0.3562 1.5486 1.2839
2006 0.4706 0.1993 0.3301 1.7378 1.4511
> China
勝率 分率 敗率 攻撃力home 攻撃力away
2015 0.4292 0.2875 0.2833 1.5831 1.2175
2014 0.4042 0.2792 0.3167 1.5041 1.2453
2013 0.4708 0.2792 0.2500 1.5491 1.0828
2012 0.4750 0.3042 0.2208 1.5625 1.0625
2011 0.4750 0.2958 0.2292 1.4044 0.9466
2010 0.4250 0.3292 0.2458 1.3453 1.0750
2009 0.5042 0.3250 0.1708 1.3953 0.8372
2008 0.4583 0.3083 0.2333 1.4666 1.0713
##勝分敗率の理論値を計算する
W,D,L：勝、分、敗の理論値
勝率、分率、敗率：実際データで、勝分敗の割合
W D L 勝率 分率 敗率 攻撃力home 攻撃力away
England 0.4658 0.2540 0.2802 0.4600 0.2582 0.2818 1.5389 1.1382
Italy 0.4631 0.2584 0.2786 0.4640 0.2716 0.2645 1.4974 1.1041
Spain 0.4813 0.2493 0.2694 0.4839 0.2340 0.2821 1.5965 1.1341
Germany 0.4569 0.2454 0.2977 0.4523 0.2464 0.3013 1.6149 1.2610
France 0.4542 0.2707 0.2751 0.4490 0.2874 0.2637 1.3886 1.0195
Japan 0.4264 0.2541 0.3195 0.4310 0.2372 0.3317 1.4932 1.2606
China 0.4662 0.2611 0.2726 0.4552 0.3010 0.2437 1.4763 1.0673
##Total
7か国のリーグ過去10年間でTotal 23240試合を見てみましょう。
加重平均を取ります。
W D L 勝率 分率 敗率 攻撃力home 攻撃力away
0.4597 0.2559 0.2844 0.4575 0.2604 0.2821 1.5158 1.1390
##結論
サッカー試合の勝分敗率の予想が出来ます。
##コード
soccer.R
setwd("C:/R")
Data <- read.table( "soccer_data.csv", header = FALSE, sep="," )
rownames(Data) <- c(2015:2006)
colnames(Data) <- rep( c("勝率","分率","敗率","攻撃力home","攻撃力away"), length.out = 35 )
England <- Data[,1:5]
England.mean <- round( apply(England, 2, mean), 4 )
Italy <- Data[,6:10]
Italy.mean <- round( apply(Italy, 2, mean), 4 )
Germany <- Data[,11:15]
Germany.mean <- round( apply(Germany, 2, mean), 4 )
Spain <- Data[,16:20]
Spain.mean <- round( apply(Spain, 2, mean), 4 )
France <- Data[,21:25]
France.mean <- round( apply(France, 2, mean), 4 )
Japan <- Data[,26:30]
Japan.mean <- round( apply(Japan, 2, mean), 4 )
China <- Data[1:8,31:35]
China.mean <- round( apply(China, 2, mean), 4 )
Data.mean <- rbind(England.mean, Italy.mean, Spain.mean, Germany.mean, France.mean, Japan.mean, China.mean)
t <- 90
prob <- Data.mean[,4:5]/t
# ========================================================
k <- 10
prob_matrix <- matrix(0,k,4)
colnames(prob_matrix) <- c("goals","W","D","L")
prob_matrix[,1] <- c(1:10)-1
Fun <- function(x){
fun <- function(y){
c(dbinom(y[1],t,x[1]),dbinom(y[1],t,x[2]))
}
kv <- apply(prob_matrix,1,fun)
for (i in 2:(k-1)){
prob_matrix[i,"D"] <- kv[1,i]*kv[2,i]
prob_matrix[i,"W"] <- kv[1,i]*sum(kv[2,(1:(i-1))])
prob_matrix[i,"L"] <- kv[1,i]*sum(kv[2,((i+1):k)])
}
prob_matrix[1,"D"] <- kv[1,1]*kv[2,1]
prob_matrix[1,"L"] <- kv[1,1]*sum(kv[2,2:k])
prob_matrix[k,"D"] <- kv[1,k]*kv[2,k]
prob_matrix[k,"W"] <- kv[1,k]*sum(kv[2,1:(k-1)])
apply(prob_matrix[,c("W","D","L")],2,sum)
} # 関数を定義する
# ====================================================
pred <- t(round(apply(prob,1,Fun),4))
cbind(pred,Data.mean)
# ====================================================
Data.total <- round(
( (England.mean + Italy.mean + Spain.mean + France.mean) * 20 * 38 * 10 *0.5
+ (Germany.mean + Japan.mean) * 18 * 34 * 10 *0.5 + China.mean * 16 * 30 * 8 *0.5 ) /
(20 * 38 * 10 * 0.5 * 4 + 18 * 34 * 10 * 0.5 * 2 + 16 * 30 * 8 * 0.5)
, 4 ) # 加重平均
prob.total <- Data.total[4:5] / t
pred.total <- round( Fun(prob.total),4 )
c(pred.total, Data.total)