Euro 2020 Predictive Model based on FIFA Ranking System

[This article was first published on R – Predictive Hacks, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

In a previous post, we built a Predictive Model based on FIFA Ranking and making the assumption that the points follow a normal distribution. If we look closer at FIFA’s Ranking Model we will see that it is based on the ELO System where the expected result of the game can be extracted from the following formula:

Euro 2020 Predictive Model based on FIFA Ranking System 6

Simulate the Final-16 Phase Based on the Expected Result

Euro 2020 Predictive Model based on FIFA Ranking System 7

Let’s run 10000 simulations to estimate the probability of the Euro 2020 Winner.

# get the UEFA Ranking


ranking<-list(bel=1783,
fra=1757,
eng=1687,
por=1666,
esp=1648,
ita=1642,
den=1632,
ger=1609,
sui=1606,
cro=1606,
net=1598,
wal=1570,
swe=1570,
aus=1523,
ukr=1515,
cze=1459)

win_prob<-function(a,b) {
  
  w_prob<-1/(1+10^(-(a-b)/600))
  outcome<-sample(c(TRUE,FALSE), 1, prob=c(w_prob, 1-w_prob))
  return(outcome)
}

sim_champion<-c()

for (i in 1:10000) {

#######################
#### Final 16
#######################

# game bel vs por
teams_game1<-c("bel","por")
game1<-win_prob(ranking[[teams_game1[1]]], ranking[[teams_game1[2]]])
if (game1) {
  qualified_game1<-teams_game1[1] 
  } else {
  qualified_game1<-teams_game1[2]}

qualified_game1


# game ita vs aus
teams_game2<-c("ita","aus")
game2<-win_prob(ranking[[teams_game2[1]]], ranking[[teams_game2[2]]])
if (game2) {
  qualified_game2<-teams_game2[1] 
} else {
  qualified_game2<-teams_game2[2]}

qualified_game2


# game fra vs sui
teams_game3<-c("fra","sui")
game3<-win_prob(ranking[[teams_game3[1]]], ranking[[teams_game3[2]]])
if (game3) {
  qualified_game3<-teams_game3[1] 
} else {
  qualified_game3<-teams_game3[2]}

qualified_game3


# game cro vs esp
teams_game4<-c("cro","esp")
game4<-win_prob(ranking[[teams_game4[1]]], ranking[[teams_game4[2]]])
if (game4) {
  qualified_game4<-teams_game4[1] 
} else {
  qualified_game4<-teams_game4[2]}

qualified_game4



# game swe vs ukr
teams_game5<-c("swe","ukr")
game5<-win_prob(ranking[[teams_game5[1]]], ranking[[teams_game5[2]]])
if (game5) {
  qualified_game5<-teams_game5[1] 
} else {
  qualified_game5<-teams_game5[2]}

qualified_game5


# game eng vs ger
teams_game6<-c("eng","ger")
game6<-win_prob(ranking[[teams_game6[1]]], ranking[[teams_game6[2]]])
if (game6) {
  qualified_game6<-teams_game6[1] 
} else {
  qualified_game6<-teams_game6[2]}

qualified_game6


# game net vs cze
teams_game7<-c("net","cze")
game7<-win_prob(ranking[[teams_game7[1]]], ranking[[teams_game7[2]]])
if (game7) {
  qualified_game7<-teams_game7[1] 
} else {
  qualified_game7<-teams_game7[2]}

qualified_game7


# game wal vs den
teams_game8<-c("wal","den")
game8<-win_prob(ranking[[teams_game8[1]]], ranking[[teams_game8[2]]])
if (game8) {
  qualified_game8<-teams_game8[1] 
} else {
  qualified_game8<-teams_game8[2]}

qualified_game8



#######################
#### Final 8
#######################

teams_f8_1<-c(qualified_game1,qualified_game2)
game_f8_1<-win_prob(ranking[[teams_f8_1[1]]], ranking[[teams_f8_1[2]]])


if (game_f8_1) {
  qualified_f8_1<-teams_f8_1[1] 
} else {
  qualified_f8_1<-teams_f8_1[2]}

qualified_f8_1


teams_f8_2<-c(qualified_game3,qualified_game4)
game_f8_2<-win_prob(ranking[[teams_f8_2[1]]], ranking[[teams_f8_2[2]]])

if (game_f8_2) {
  qualified_f8_2<-teams_f8_2[1] 
} else {
  qualified_f8_2<-teams_f8_2[2]}

qualified_f8_2


teams_f8_3<-c(qualified_game5,qualified_game6)
game_f8_3<-win_prob(ranking[[teams_f8_3[1]]], ranking[[teams_f8_3[2]]])

if (game_f8_3) {
  qualified_f8_3<-teams_f8_3[1] 
} else {
  qualified_f8_3<-teams_f8_3[2]}

qualified_f8_3


teams_f8_4<-c(qualified_game7,qualified_game8)
game_f8_4<-win_prob(ranking[[teams_f8_4[1]]], ranking[[teams_f8_4[2]]])

if (game_f8_4) {
  qualified_f8_4<-teams_f8_4[1] 
} else {
  qualified_f8_4<-teams_f8_4[2]}

qualified_f8_4


#######################
#### Final 4
#######################

teams_f4_1<-c(qualified_f8_1,qualified_f8_2)
game_f4_1<-win_prob(ranking[[teams_f4_1[1]]], ranking[[teams_f4_1[2]]])

if (game_f4_1) {
  qualified_f4_1<-teams_f4_1[1] 
} else {
  qualified_f4_1<-teams_f4_1[2]}

qualified_f4_1


teams_f4_2<-c(qualified_f8_3,qualified_f8_4)
game_f4_2<-win_prob(ranking[[teams_f4_2[1]]], ranking[[teams_f4_2[2]]])


if (game_f4_2) {
  qualified_f4_2<-teams_f4_2[1] 
} else {
  qualified_f4_2<-teams_f4_2[2]}

qualified_f4_2


#######################
#### Final 
#######################

teams_f<-c(qualified_f4_1,qualified_f4_2)
game_f<-win_prob(ranking[[teams_f[1]]], ranking[[teams_f[2]]])

if (game_f) {
  champion<-teams_f[1] 
} else {
  champion<-teams_f[2]}

sim_champion<-c(sim_champion,champion)
}


prop.table(table(sim_champion))*100

Outcome:

sim_champion
  aus   bel   cro   cze   den   eng   esp   fra   ger   ita   net   por   sui   swe   ukr   wal 
 1.68 16.22  3.74  1.33  7.64 10.17  6.53 14.70  4.75  6.83  5.99  6.21  3.38  4.37  2.28  4.18 

As we can see, Belgium has 16.22% to win the Euro 2020 and it is the favorite according to this approach.

To leave a comment for the author, please follow the link and comment on their blog: R – Predictive Hacks.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.