¿Quién ganará el mundial? Machine Learning para dar una respuesta.

El post de hoy es de un autor invitado que nos hablará de algo de lo que nunca he escrito, ¡Aprendizaje automático!

Si bien es algo de lo que no tengo ni la menor idea, mi interés por esta disciplina crece día a día con todos los avances y novedades que surgen en torno al tema. Eso, junto a la programación en android está dentro de mis metas de aprendizaje.

Pero antes que eso soy consciente de que debo aprender a programar, y es lo que estoy haciendo. ¿Sabías que saber programar será tan necesario a nivel profesional como el dominio de un segundo idioma? Bueno, hay quienes dicen que es más importante: Tim Cook: Aprender a programar es más importante que aprender inglés.

Y no por nada se evidencia un deficit en muchos países en profesiones asociadas a la programación.

De ahí que, profesiones como ingeniería de sistemas sean muy bien pagadas hoy día.

Dicho esto, el autor invitado de hoy nos muestra su predicción del ganador del mundial, con base en los resultados de los partidos desde 1872 al 2017. Para lograrlo utilizaremos machine learning, en R.

¿Qué es R?

R es un lenguaje de programación basado en análisis estadístico. Nos permite hacer uso de una gran cantidad de herramientas estadísticas, desde modelos lineales y no lineales, hasta algoritmos de clasificación y agrupamiento.

El autor invitado de hoy es Juan Diego Bernate, Ingeniero Industrial apasionado por la inteligencia de negocios y este es su primer proyecto de machine learning. Nos contará paso a paso cómo ha obtenido los datos, los ha preparado, elegido la técnica de aprendizaje automático y corrido el modelo.

Table of Contents
Toggle

De dónde se obtienen los datos
Alistando los datos
Obteniendo las librerías
Eligiendo la técnica de aprendizaje automático
Corriendo el modelo
¿Mejorable? Por supuesto que sí.

De dónde se obtienen los datos

Primero que todo, debemos obtener los datos con los que haremos el modelo.

Para hacerlo, será subir el dataset de partidos históricos, el cual esta disponible en Kaggle en el siguiente vinculo: https://www.kaggle.com/martj42/international-football-results-from-1872-to-2017/data

Con dataset nos referimos a un conjunto de datos tabulados donde cada columna indica una variable, y cada fila es un dato como tal.

ds<-read.csv("results.csv",header = T)

##         date home_team away_team home_score away_score tournament  city
## 1 1872-11-30  Scotland   England          0          0   Friendly Glasgow
## 2 1873-03-08   England  Scotland          4          2   Friendly  London
## 3 1874-03-07  Scotland   England          2          1   Friendly Glasgow
## 4 1875-03-06   England  Scotland          2          2   Friendly  London
## 5 1876-03-04  Scotland   England          3          0   Friendly Glasgow
## 6 1876-03-25  Scotland     Wales          4          0   Friendly Glasgow
##    country neutral
## 1 Scotland   FALSE
## 2  England   FALSE
## 3 Scotland   FALSE
## 4  England   FALSE
## 5 Scotland   FALSE
## 6 Scotland   FALSE

Alistando los datos

Eliminamos los empates para evitar las desviaciones que podrian tener por ser partidos de prueba, de igual modo vamos a tomar solo los encuentros de 1980 en adelanto para agilizar el dataset y evitar el cambio de nombre de algunos equipos. Hacemos una columna que identifique si el ganador fue el equipo local o el visitante.

Para lograr lo mencionado, se crea una columna llamada empate, a la cual se le asigna un 1 si el score es igual y 0 si es diferente, luego filtramos las filas de todo el dataset que tienen 0 en la columna empate. Se hace lo mismo con las filas que tienen valor “Friendly” en la columna tournament. Se añade la columna ganador en la cual si home score es mayor, asigna home team, si no away team. Para la fecha se utiliza la misma lógica de filtrado, todas las filas que tengan fecha superior a la indicada.

ds$empate<-ifelse(ds$home_score==ds$away_score,1,0)
ds<-ds[ds$empate==0,]
ds<-ds[!ds$tournament=="Friendly",]
ds$ganador<-ifelse(ds$home_score>ds$away_score,as.character(ds$home_team),as.character(ds$away_team))

ds$date<-format(as.Date(ds$date),"%Y/%m/%d")
ds<-ds[ds$date>1980/01/01,]

A continuación vamos a cargar el dataset de los equipos que han participado en mundiales, de los cuales podemos obtener alguna data en FIFA acerca de su performance en pasados mundiales. Les comparto el csv: https://drive.google.com/file/d/1PR0d2ziw8_sSJUHA7vovmX3fij0bnjpQ/view?usp=sharing

Filtramos los equipos que están incluidos en el csv creando un nuevo dataset ds1.

equipos<-read.csv("equipos.csv",header=T,sep=";")

ds1<-ds[ds$home_team%in%equipos$dataset,]
ds1<-ds1[ds1$away_team%in%equipos$dataset,]

Vamos a crear una columna con el porcentaje de victorias por equipo. Aclaro, seguramente hay métodos más ágiles que el utilizado.

z<-table(ds1$ganador)
z<-data.frame(z)
x<-table(ds1$home_team)
y<-table(ds1$away_team)
x<-data.frame(x)
y<-data.frame(y) 
xy<-merge(y,x,by ="Var1",all.x = T)

xy$totalpartidos<-as.integer(xy$Freq.x+xy$Freq.y)

xy<-merge(xy,z,by="Var1",all.x = T)
xy<-xy[complete.cases(xy),]
xy$porcenVict<-xy$Freq/xy$totalpartidos

Otra de las columnas para el dataset final será la cantidad de goles a favor y en contra. A continuación creamos las variables mencionadas y unificamos con la tabla de equipos para consolidar el performance por equipo. Eliminamos objetos y columnas intermedias para evitar confusiones.

a<-data.frame(aggregate(home_score~home_team, data=ds1, FUN = "sum"))
b<-data.frame(aggregate(away_score~away_team, data=ds1, FUN = "sum"))
colnames(a)<-c("team","goles")
colnames(b)<-c("team","goles")
ab<-merge(a,b,by ="team",all.x = T)
ab$golesfavor<-as.integer(ab$goles.x+ab$goles.y)

c<-data.frame(aggregate(away_score~home_team, data=ds1, FUN = "sum"))
d<-data.frame(aggregate(home_score~away_team, data=ds1, FUN = "sum"))
colnames(c)<-c("team","golesC")
colnames(d)<-c("team","golesC")
cd<-merge(c,d,by ="team",all.x = T)
cd$golescontra<-as.integer(cd$golesC.x+cd$golesC.y)

golesfavor<-ab
porcenVict<-xy
golescontra<-cd
rm(x,y,z,ab,xy,a,b,c,d,cd)

golescontra$golesC.x<-NULL
golescontra$golesC.y<-NULL
golesfavor$goles.x<-NULL
golesfavor$goles.y<-NULL
porcenVict$Freq.x<-NULL
porcenVict$Freq.y<-NULL
colnames(porcenVict)<-c("team","totalpartidos","victorias","%victo")

est<-merge(golescontra,golesfavor,by ="team",all.x = T)
est<-merge(est,porcenVict,by="team",all.x = T)

colnames(equipos)[1]<-"team"
equipos<-merge(equipos,est,by="team",all.x=T)

equipos$GF_partido<-equipos$golesfavor/equipos$totalpartidos
equipos$GC_partido<-equipos$golescontra/equipos$totalpartidos

rm(golescontra,golesfavor,porcenVict)
rm(est)

La tabla de performance quedó de las siguiente manera:

head(equipos)

##        team Participaciones Rendimiento.Mundiales Campeón Subcampeón
## 1   Algeria               4                  0,31       0          0
## 2    Angola               1                  0,22       0          0
## 3 Argentina              16                  0,61       2          3
## 4 Australia               4                  0,23       0          0
## 5   Austria               7                  0,46       0          0
## 6   Belgium              12                  0,41       0          0
##   Tercer.Lugar Cuarto.Lugar Cuartos.de.final Octavos.de.final X1.ª.Ronda
## 1            0            0                0                1          3
## 2            0            0                0                0          1
## 3            0            0                5                2          4
## 4            0            0                0                1          3
## 5            1            1                1                1          3
## 6            0            1                1                4          6
##   rankingFifa golescontra golesfavor totalpartidos victorias    %victo
## 1          64         124        115            84        39 0.4642857
## 2         138          54         34            35        11 0.3142857
## 3           5         156        313           165       121 0.7333333
## 4          40          99        112            83        45 0.5421687
## 5          26         169         94            87        28 0.3218391
## 6           3         164        149           113        56 0.4955752
##   GF_partido GC_partido
## 1  1.3690476  1.4761905
## 2  0.9714286  1.5428571
## 3  1.8969697  0.9454545
## 4  1.3493976  1.1927711
## 5  1.0804598  1.9425287
## 6  1.3185841  1.4513274

Añadimos la tabla de equipos al histórico de partidos, ordenamos el dataset por fecha, eliminamos algunas variables que no vamos a usar y organizamos las columnas que se movieron por el merge.

colnames(ds1)[2]<-"team"
ds2<-merge(ds1,equipos,by="team",all.x = T)
colnames(equipos)[1]<-"team2"
colnames(ds2)[3]<-"team2"
ds2<-merge(ds2,equipos,by="team2",all.x = T)

ds2$ganador<-NULL
ds2<-ds2[order(ds2$date),]
ds2$tournament<-NULL
ds2$city<-NULL
ds2$country<-NULL
ds2$neutral<-NULL
ds2$empate<-NULL
ds2$idmatch<-seq.int(nrow(ds2))

ds2<-ds2[,c(3,2,1,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40)]

colnames(ds2)<-c("fecha","team","team2","home_score","away_score","partic","rend.mundiales","campeonatos",
                 "subcampeonatos","tercer.lugar","cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa",
                 "golescontra","golesfavor","totalpartido","victorias","porc.victo","gf.part","gc.part","partic2",
                 "rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2","cuarto.lugar2","cuartos.final2",
                 "oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2","totalpartido2","victorias2",
                 "porc.victo2","gf.part2","gc.part2","idmatch")

El dataset ya esta casi listo para empezar a entrenar y predecir. Vamos a añadir la clase, la cual sera la variable a predecir:

1 si gana el equipo local, desde ahora a,
0 si gana el equipo visitante, desde ahora b.

También vamos revisar que las variables estén en el formato correcto. Importante que la case sea un Factor.

ds2$clase<-ifelse(ds2$home_score>ds2$away_score,1,0)

ds2$clase<-as.factor(ds2$clase)
ds2$rend.mundiales<-as.numeric(ds2$rend.mundiales)
ds2$rend.mundiales2<-as.numeric(ds2$rend.mundiales2)

sapply(ds2,function(x) class(x))

##           fecha            team           team2      home_score 
##     "character"        "factor"        "factor"       "integer" 
##      away_score          partic  rend.mundiales     campeonatos 
##       "integer"       "integer"       "numeric"       "integer" 
##  subcampeonatos    tercer.lugar    cuarto.lugar   cuartos.final 
##       "integer"       "integer"       "integer"       "integer" 
##       oct.final      prim.ronda        RankFifa     golescontra 
##       "integer"       "integer"       "integer"       "integer" 
##      golesfavor    totalpartido       victorias      porc.victo 
##       "integer"       "integer"       "integer"       "numeric" 
##         gf.part         gc.part         partic2 rend.mundiales2 
##       "numeric"       "numeric"       "integer"       "numeric" 
##    campeonatos2 subcampeonatos2   tercer.lugar2   cuarto.lugar2 
##       "integer"       "integer"       "integer"       "integer" 
##  cuartos.final2      oct.final2     prim.ronda2       RankFifa2 
##       "integer"       "integer"       "integer"       "integer" 
##    golescontra2     golesfavor2   totalpartido2      victorias2 
##       "integer"       "integer"       "integer"       "integer" 
##     porc.victo2        gf.part2        gc.part2         idmatch 
##       "numeric"       "numeric"       "numeric"       "integer" 
##           clase 
##        "factor"

Ahora, el dataset ya esta listo. Vamos a separarlo en 2: (80-20). La porción más grande esta destinada para entrenar el modelo y el restante sera donde probaremos los resultados.

train<-ds2[ds2$idmatch<3100,] test<-ds2[ds2$idmatch>3099,]

Obteniendo las librerías

Llamamos las librerías que contienen los modelos que vamos a utilizar.

#install.packages("rpart")
library(rpart)
#install.packages("rpart.plot")
library(rpart.plot)
#install.packages("caret")
library(caret)

## Loading required package: lattice

## Loading required package: ggplot2

#install.packages("randomForest")
library(randomForest)

## randomForest 4.6-14

## Type rfNews() to see new features/changes/bug fixes.

## 
## Attaching package: 'randomForest'

## The following object is masked from 'package:ggplot2':
## 
##     margin

#install.packages("e1071")
library(e1071)

rm(ds,ds1)

Eligiendo la técnica de aprendizaje automático

Iniciemos con un árbol de decisión sencillo, predecimos y medimos la precisión de la predicción.

modAD<-rpart(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final+oct.final
             +prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+subcampeonatos2+
               tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+porc.victo2+gf.part2+gc.part2,
             data=train)

predAD<-predict(modAD,test, type="class")
modAD

## n= 3099 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 3099 1078 1 (0.3478541 0.6521459)  
##    2) porc.victo2>=0.4977876 1442  702 1 (0.4868239 0.5131761)  
##      4) gc.part>=1.498299 414  137 0 (0.6690821 0.3309179) *
##      5) gc.part< 1.498299 1028  425 1 (0.4134241 0.5865759)  
##       10) porc.victo< 0.6626016 744  348 1 (0.4677419 0.5322581)  
##         20) porc.victo2>=0.7122561 146   48 0 (0.6712329 0.3287671) *
##         21) porc.victo2< 0.7122561 598  250 1 (0.4180602 0.5819398) *
##       11) porc.victo>=0.6626016 284   77 1 (0.2711268 0.7288732) *
##    3) porc.victo2< 0.4977876 1657  376 1 (0.2269161 0.7730839) *

rpart.plot(modAD)

resulAD<-data.frame(test$clase,predAD)
table(resulAD)

##           predAD
## test.clase   0   1
##          0 109 224
##          1  46 513

(513+109)/892

## [1] 0.6973094

El árbol de decisión tuvo una precisión del 69,7%. Procedemos a probar con algunos cambios para verificar si mejora:

modAD2<-rpart(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final+oct.final
             +prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+subcampeonatos2+
               tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+porc.victo2+gf.part2+gc.part2,
             data=train,control= rpart.control(minsplit = 5))

predAD2<-predict(modAD2,test, type="class")
modAD

## n= 3099 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 3099 1078 1 (0.3478541 0.6521459)  
##    2) porc.victo2>=0.4977876 1442  702 1 (0.4868239 0.5131761)  
##      4) gc.part>=1.498299 414  137 0 (0.6690821 0.3309179) *
##      5) gc.part< 1.498299 1028  425 1 (0.4134241 0.5865759)  
##       10) porc.victo< 0.6626016 744  348 1 (0.4677419 0.5322581)  
##         20) porc.victo2>=0.7122561 146   48 0 (0.6712329 0.3287671) *
##         21) porc.victo2< 0.7122561 598  250 1 (0.4180602 0.5819398) *
##       11) porc.victo>=0.6626016 284   77 1 (0.2711268 0.7288732) *
##    3) porc.victo2< 0.4977876 1657  376 1 (0.2269161 0.7730839) *

rpart.plot(modAD2)

resulAD2<-data.frame(test$clase,predAD2)
table(resulAD)

##           predAD
## test.clase   0   1
##          0 109 224
##          1  46 513

(513+109)/892

## [1] 0.6973094

No hubo mejoria. Vamos a probar random forest.

modRF<-randomForest(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final
                    +oct.final+prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+
                      subcampeonatos2+tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+
                      porc.victo2+gf.part2+gc.part2,data=train,ntree=10000,sampsize=200,importance=TRUE)

predRF<-predict(modRF,test, type="class")

resulRF<-data.frame(test$clase,predRF)
table(resulRF)

##           predRF
## test.clase   0   1
##          0 143 190
##          1  77 482

(145+477)/892

## [1] 0.6973094

El random forest tuvo una precisión del 69,7%. Procedemos a probar con algunos cambios para verificar si mejora:

modRFA<-randomForest(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final
                    +oct.final+prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+
                      subcampeonatos2+tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+
                      porc.victo2+gf.part2+gc.part2,data=train,ntree=10000,sampsize=100,importance=TRUE)

predRFA<-predict(modRFA,test, type="class")

resulRFA<-data.frame(test$clase,predRFA)
table(resulRFA)

##           predRFA
## test.clase   0   1
##          0 144 189
##          1  71 488

(142+490)/892

## [1] 0.7085202

Mejoro un poco el modelo, con 70,8%. Otro intento para ver si mejora más.

modRF2<-randomForest(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final
                    +oct.final+prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+
                      subcampeonatos2+tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+
                      porc.victo2+gf.part2+gc.part2,data=train,ntree=10000,sampsize=50,importance=TRUE)

predRF2<-predict(modRF2,test, type="class")

resulRF2<-data.frame(test$clase,predRF2)
table(resulRF2)

##           predRF2
## test.clase   0   1
##          0 143 190
##          1  66 493

(143+495)/892

## [1] 0.7152466

Mejoró, 71,5%. Otra prueba.

modRF3<-randomForest(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final
                    +oct.final+prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+
                      subcampeonatos2+tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+
                      porc.victo2+gf.part2+gc.part2,data=train,ntree=50000,sampsize=20,importance=TRUE)

predRF3<-predict(modRF3,test, type="class")

resulRF3<-data.frame(test$clase,predRF3)
table(resulRF3)

##           predRF3
## test.clase   0   1
##          0 125 208
##          1  45 514

(129+509)/892

## [1] 0.7152466

No mejoro. Vamos a probar con caret. Usamos grid para mejorar.

gbmGrid <-  expand.grid(interaction.depth = c(1,5,9),
                        n.trees = (1:10)*5,
                        shrinkage = c(0.1,0.2),
                        n.minobsinnode = c(30,40))

modcaret <- train(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final+oct.final
                  +prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+subcampeonatos2+
                    tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+porc.victo2+gf.part2+
                    gc.part2,data=train,method = "gbm",verbose = FALSE,tuneGrid = gbmGrid)

predcaret<-predict(modcaret,test, type="raw")
resulcaret<-data.frame(test$clase,predcaret)
table(resulcaret)

##           predcaret
## test.clase   0   1
##          0 142 191
##          1  65 494

(149+484)/892

## [1] 0.7096413

70,9%. Vamos a añadir el fit control:

gbmGrid2 <-  expand.grid(interaction.depth = c(1,5,9),
                        n.trees = (1:100)*5,
                        shrinkage = c(0.1,0.2),
                        n.minobsinnode = c(30,40,50))

fitControl <- trainControl(## 10-fold CV
  method = "repeatedcv",
  number = 10, # genera un dataset dividido en 10 k
  repeats = 1) # genera 3 divisiones de k = 10


modcaret2 <- train(clase ~ partic+rend.mundiales+campeonatos+subcampeonatos+tercer.lugar+cuarto.lugar+cuartos.final+
                     oct.final+prim.ronda+RankFifa+porc.victo+gf.part+gc.part+partic2+rend.mundiales2+campeonatos2+
                     subcampeonatos2+tercer.lugar2+cuarto.lugar2+cuartos.final2+oct.final2+prim.ronda2+RankFifa2+
                     porc.victo2+gf.part2+gc.part2,data=train,
                  method = "gbm",
                  verbose = FALSE,
                  trControl = fitControl,
                  tuneGrid = gbmGrid)
predcaret2<-predict(modcaret2,test, type="raw")
resulcaret2<-data.frame(test$clase,predcaret2)
table(resulcaret2)

##           predcaret2
## test.clase   0   1
##          0 146 187
##          1  76 483

(142+491)/892

## [1] 0.7096413

70,96% el gbm con grid y fit. El ganador fue el random Forest.

Seguimos con la predicción, subimos el dataset con la fase de grupos.

Despues de cargar el csv, lo que se hace es separar las columnas team y team2 a las cuales les asignamos el respectivo vector de performance por equipo:

Fase.Grupos<-read.csv("Ds predecir2.csv",header = T,sep=",")
Fase.Grupos$idmatch<-seq.int(nrow(Fase.Grupos))
colnames(Fase.Grupos)[1]<-"team"
colnames(equipos)[1]<-"team"
colnames(Fase.Grupos)[2]<-"team2"

team<-data.frame(Fase.Grupos$team,Fase.Grupos$idmatch,Fase.Grupos$Grupo)
colnames(team)<-c("team","idmatch","Grupo")
team<-merge(team,equipos,by="team",all.x = T)
team<-team[order(team$idmatch),]

colnames(team)

##  [1] "team"                  "idmatch"              
##  [3] "Grupo"                 "Participaciones"      
##  [5] "Rendimiento.Mundiales" "Campeón"              
##  [7] "Subcampeón"            "Tercer.Lugar"         
##  [9] "Cuarto.Lugar"          "Cuartos.de.final"     
## [11] "Octavos.de.final"      "X1.ª.Ronda"           
## [13] "rankingFifa"           "golescontra"          
## [15] "golesfavor"            "totalpartidos"        
## [17] "victorias"             "%victo"               
## [19] "GF_partido"            "GC_partido"

colnames(team)<-c("team","idmatch","Grupo","partic","rend.mundiales","campeonatos","subcampeonatos","tercer.lugar",
                  "cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa","golescontra","golesfavor",
                  "totalpartido","victorias","porc.victo","gf.part","gc.part")

team2<-data.frame(Fase.Grupos$team2,Fase.Grupos$idmatch,Fase.Grupos$Grupo)
colnames(team2)<-c("team2","idmatch","Grupo")
colnames(equipos)[1]<-"team2"
team2<-merge(team2,equipos,by="team2",all.x = T)
team2<-team2[order(team2$idmatch),]

colnames(team2)<-c("team2","idmatch","Grupo","partic2","rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2",
                  "cuarto.lugar2","cuartos.final2","oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2",
                  "totalpartido2","victorias2","porc.victo2","gf.part2","gc.part2")

Fase.Grupos<-cbind(team,team2)

colnames(Fase.Grupos)[3]<-"Grupos"
Fase.Grupos$Grupo<-NULL
colnames(Fase.Grupos)

##  [1] "team"            "idmatch"         "Grupos"         
##  [4] "partic"          "rend.mundiales"  "campeonatos"    
##  [7] "subcampeonatos"  "tercer.lugar"    "cuarto.lugar"   
## [10] "cuartos.final"   "oct.final"       "prim.ronda"     
## [13] "RankFifa"        "golescontra"     "golesfavor"     
## [16] "totalpartido"    "victorias"       "porc.victo"     
## [19] "gf.part"         "gc.part"         "team2"          
## [22] "idmatch"         "partic2"         "rend.mundiales2"
## [25] "campeonatos2"    "subcampeonatos2" "tercer.lugar2"  
## [28] "cuarto.lugar2"   "cuartos.final2"  "oct.final2"     
## [31] "prim.ronda2"     "RankFifa2"       "golescontra2"   
## [34] "golesfavor2"     "totalpartido2"   "victorias2"     
## [37] "porc.victo2"     "gf.part2"        "gc.part2"

Fase.Grupos<-Fase.Grupos[,c(1,21,22,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39)]
Fase.Grupos$idmatch.1<-NULL

sapply(Fase.Grupos,function(x) class(x))

##            team           team2         idmatch          Grupos 
##        "factor"        "factor"       "integer"        "factor" 
##          partic  rend.mundiales     campeonatos  subcampeonatos 
##       "integer"        "factor"       "integer"       "integer" 
##    tercer.lugar    cuarto.lugar   cuartos.final       oct.final 
##       "integer"       "integer"       "integer"       "integer" 
##      prim.ronda        RankFifa     golescontra      golesfavor 
##       "integer"       "integer"       "integer"       "integer" 
##    totalpartido       victorias      porc.victo         gf.part 
##       "integer"       "integer"       "numeric"       "numeric" 
##         gc.part         partic2 rend.mundiales2    campeonatos2 
##       "numeric"       "integer"        "factor"       "integer" 
## subcampeonatos2   tercer.lugar2   cuarto.lugar2  cuartos.final2 
##       "integer"       "integer"       "integer"       "integer" 
##      oct.final2     prim.ronda2       RankFifa2    golescontra2 
##       "integer"       "integer"       "integer"       "integer" 
##     golesfavor2   totalpartido2      victorias2     porc.victo2 
##       "integer"       "integer"       "integer"       "numeric" 
##        gf.part2        gc.part2 
##       "numeric"       "numeric"

Fase.Grupos$rend.mundiales<-as.numeric(Fase.Grupos$rend.mundiales)
Fase.Grupos$rend.mundiales2<-as.numeric(Fase.Grupos$rend.mundiales2)

Corriendo el modelo

El dataset para predecir ya queda listo. Corremos la predicción de la fase de grupos:

predFG2<-predict(modRF2,Fase.Grupos, type="prob")
resultFG2<-data.frame(Fase.Grupos$idmatch,predFG2)

resultFG2$team<-Fase.Grupos$team
resultFG2$team2<-Fase.Grupos$team2
resultFG2$team2<-Fase.Grupos$team2
colnames(resultFG2)[1]<-"idmatch"

resultFG2$ganador<-ifelse(resultFG2$X1>resultFG2$X0,as.character(resultFG2$team),as.character(resultFG2$team2))

resultFG2$grupo<-Fase.Grupos$Grupos
resultFG2$puntos<-3

resultFG2$ganador<-ifelse(resultFG2$X1>resultFG2$X0,as.character(resultFG2$team),as.character(resultFG2$team2))

puntos2<-data.frame(aggregate(resultFG2$puntos~resultFG2$grupo+resultFG2$ganador,FUN = "sum"))



puntos2[order(puntos2$resultFG2.grupo,puntos2$resultFG2.puntos,decreasing = TRUE),]

##    resultFG2.grupo resultFG2.ganador resultFG2.puntos
## 5                H          Colombia                6
## 13               H             Japan                6
## 18               H            Poland                6
## 9                G           England                9
## 3                G           Belgium                6
## 26               G           Tunisia                3
## 11               F           Germany                9
## 14               F    Korea Republic                3
## 15               F            Mexico                3
## 24               F            Sweden                3
## 4                E            Brazil                9
## 6                E        Costa Rica                3
## 22               E            Serbia                3
## 25               E       Switzerland                3
## 1                D         Argentina                9
## 7                D           Croatia                6
## 17               D           Nigeria                3
## 10               C            France                9
## 8                C           Denmark                6
## 2                C         Australia                3
## 23               B             Spain                9
## 12               B              Iran                3
## 16               B           Morocco                3
## 19               B          Portugal                3
## 27               A           Uruguay                9
## 20               A            Russia                6
## 21               A      Saudi Arabia                3

write.csv(puntos2,"puntosgrupos.csv")

Con el write csv descargamos el dataset con los puntos por grupo. Organizamos y volvemos a cargar para predecir la siguiente fase. Cuando empatan en puntos, se define el clasificado por la suma de probabilidades. En este link se encuentra el csv con los encuentros de segunda fase. Cargamos la segunda ronda y ejecutamos el mismo proceso de la fase de grupos:

segundaron<-read.csv("segundaronda.csv",header = T,sep=";")

segundaron$idmatch<-seq.int(nrow(segundaron))

colnames(equipos)[1]<-"team"
team<-data.frame(segundaron$Team,segundaron$idmatch)
colnames(team)<-c("team","idmatch")
team<-merge(team,equipos,by="team",all.x = T)
team<-team[order(team$idmatch),]

colnames(team)<-c("team","idmatch","partic","rend.mundiales","campeonatos","subcampeonatos","tercer.lugar",
                  "cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa","golescontra","golesfavor",
                  "totalpartido","victorias","porc.victo","gf.part","gc.part")

team2<-data.frame(segundaron$Team2,segundaron$idmatch)
colnames(team2)<-c("team2","idmatch")
colnames(equipos)[1]<-"team2"
team2<-merge(team2,equipos,by="team2",all.x = T)
team2<-team2[order(team2$idmatch),]

colnames(team2)<-c("team2","idmatch","partic2","rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2",
                   "cuarto.lugar2","cuartos.final2","oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2",
                   "totalpartido2","victorias2","porc.victo2","gf.part2","gc.part2")

segundaron<-cbind(team,team2)

segundaron<-segundaron[,c(1,20,2,21,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38)]
segundaron$idmatch.1<-NULL

#prediccion segunda ronda
sapply(segundaron,function(x) class(x))

##            team           team2         idmatch          partic 
##        "factor"        "factor"       "integer"       "integer" 
##  rend.mundiales     campeonatos  subcampeonatos    tercer.lugar 
##        "factor"       "integer"       "integer"       "integer" 
##    cuarto.lugar   cuartos.final       oct.final      prim.ronda 
##       "integer"       "integer"       "integer"       "integer" 
##        RankFifa     golescontra      golesfavor    totalpartido 
##       "integer"       "integer"       "integer"       "integer" 
##       victorias      porc.victo         gf.part         gc.part 
##       "integer"       "numeric"       "numeric"       "numeric" 
##         partic2 rend.mundiales2    campeonatos2 subcampeonatos2 
##       "integer"        "factor"       "integer"       "integer" 
##   tercer.lugar2   cuarto.lugar2  cuartos.final2      oct.final2 
##       "integer"       "integer"       "integer"       "integer" 
##     prim.ronda2       RankFifa2    golescontra2     golesfavor2 
##       "integer"       "integer"       "integer"       "integer" 
##   totalpartido2      victorias2     porc.victo2        gf.part2 
##       "integer"       "integer"       "numeric"       "numeric" 
##        gc.part2 
##       "numeric"

segundaron$rend.mundiales<-as.numeric(segundaron$rend.mundiales)/100
segundaron$rend.mundiales2<-as.numeric(segundaron$rend.mundiales2)/100

pred2rd<-predict(modRF2,segundaron, type="prob")
result2rd<-data.frame(segundaron$idmatch,pred2rd)

result2rd$team<-segundaron$team
result2rd$team2<-segundaron$team2
colnames(result2rd)[1]<-"idmatch"


result2rd<-result2rd[,c(1,4,5,2,3)]
result2rd$ganador<-ifelse(result2rd$X1>result2rd$X0,as.character(result2rd$team),as.character(result2rd$team2))
result2rd

##   idmatch      team    team2     X0     X1   ganador
## 7       1    Russia Portugal 0.4027 0.5973    Russia
## 4       2    France  Croatia 0.3373 0.6627    France
## 8       3     Spain  Uruguay 0.3144 0.6856     Spain
## 1       4 Argentina  Denmark 0.3030 0.6970 Argentina
## 2       5    Brazil   Mexico 0.3700 0.6300    Brazil
## 3       6   England Colombia 0.2906 0.7094   England
## 5       7   Germany   Serbia 0.3321 0.6679   Germany
## 6       8    Poland  Belgium 0.4077 0.5923    Poland

En el ultimo vector se pueden ver los clasificados a las siguiente ronda. Hacemos lo mismo, creamos el csv, organizamos los cruces y volvemos a cargar.

write.csv(result2rd,"Octavo.csv")

octavos<-read.csv("octavos.csv",header = T,sep=";")

octavos$idmatch<-seq.int(nrow(octavos))

colnames(equipos)[1]<-"team"
team<-data.frame(octavos$team,octavos$idmatch)
colnames(team)<-c("team","idmatch")
team<-merge(team,equipos,by="team",all.x = T)
team<-team[order(team$idmatch),]

colnames(team)<-c("team","idmatch","partic","rend.mundiales","campeonatos","subcampeonatos","tercer.lugar",
                  "cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa","golescontra","golesfavor",
                  "totalpartido","victorias","porc.victo","gf.part","gc.part")

team2<-data.frame(octavos$team2,octavos$idmatch)
colnames(team2)<-c("team2","idmatch")
colnames(equipos)[1]<-"team2"
team2<-merge(team2,equipos,by="team2",all.x = T)
team2<-team2[order(team2$idmatch),]

colnames(team2)<-c("team2","idmatch","partic2","rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2",
                   "cuarto.lugar2","cuartos.final2","oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2",
                   "totalpartido2","victorias2","porc.victo2","gf.part2","gc.part2")
octavos<-cbind(team,team2)

octavos<-octavos[,c(1,20,2,21,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38)]
octavos$idmatch.1<-NULL

octavos$rend.mundiales<-as.numeric(octavos$rend.mundiales)/100
octavos$rend.mundiales2<-as.numeric(octavos$rend.mundiales2)/100

pred8vo<-predict(modRF2,octavos, type="prob")
result8vo<-data.frame(octavos$idmatch,pred8vo)
colnames(result8vo)[1]<-"idmatch"

result8vo$team<-octavos$team
result8vo$team2<-octavos$team2
colnames(result8vo)[1]<-"idmatch"
result8vo<-result8vo[,c(1,4,5,2,3)]
result8vo$ganador<-ifelse(result8vo$X1>result8vo$X0,as.character(result8vo$team),as.character(result8vo$team2))


result8vo

##   idmatch    team     team2     X0     X1 ganador
## 3       1  Russia    France 0.5094 0.4906  France
## 1       2  Brazil   England 0.4007 0.5993  Brazil
## 4       3   Spain Argentina 0.4443 0.5557   Spain
## 2       4 Germany    Poland 0.2530 0.7470 Germany

Repetimos el procedimiento para la siguiente ronda

semifinales<-read.csv("semifinales.csv",header = T,sep=";")
semifinales$idmatch<-seq.int(nrow(semifinales))

colnames(equipos)[1]<-"team"
team<-data.frame(semifinales$team,semifinales$idmatch)
colnames(team)<-c("team","idmatch")
team<-merge(team,equipos,by="team",all.x = T)
team<-team[order(team$idmatch),]

colnames(team)<-c("team","idmatch","partic","rend.mundiales","campeonatos","subcampeonatos","tercer.lugar",
                  "cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa","golescontra","golesfavor",
                  "totalpartido","victorias","porc.victo","gf.part","gc.part")

team2<-data.frame(semifinales$team2,semifinales$idmatch)
colnames(team2)<-c("team2","idmatch")
colnames(equipos)[1]<-"team2"
team2<-merge(team2,equipos,by="team2",all.x = T)
team2<-team2[order(team2$idmatch),]

colnames(team2)<-c("team2","idmatch","partic2","rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2",
                   "cuarto.lugar2","cuartos.final2","oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2",
                   "totalpartido2","victorias2","porc.victo2","gf.part2","gc.part2")
semifinales<-cbind(team,team2)

semifinales<-semifinales[,c(1,20,2,21,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38)]
semifinales$idmatch.1<-NULL

semifinales$rend.mundiales<-as.numeric(semifinales$rend.mundiales)/100
semifinales$rend.mundiales2<-as.numeric(semifinales$rend.mundiales2)/100

predsemi<-predict(modRF2,semifinales, type="prob")
resultsemi<-data.frame(semifinales$idmatch,predsemi)
colnames(resultsemi)[1]<-"idmatch"

resultsemi$team<-semifinales$team
resultsemi$team2<-semifinales$team2
colnames(resultsemi)[1]<-"idmatch"
resultsemi<-resultsemi[,c(1,4,5,2,3)]
resultsemi$ganador<-ifelse(resultsemi$X1>resultsemi$X0,as.character(resultsemi$team),as.character(resultsemi$team2))

resultsemi

##   idmatch   team   team2     X0     X1 ganador
## 1       1 France  Brazil 0.4921 0.5079  France
## 2       2  Spain Germany 0.4807 0.5193   Spain

Con base en esto, tenemos como finalistas a Francia y España. Repetimos el mismo procedimiento que hemos venido usando.

final<-read.csv("FINAL.csv",header = T,sep=";")
final$idmatch<-seq.int(nrow(final))

colnames(equipos)[1]<-"team"
team<-data.frame(final$team,final$idmatch)
colnames(team)<-c("team","idmatch")
team<-merge(team,equipos,by="team",all.x = T)
team<-team[order(team$idmatch),]

colnames(team)<-c("team","idmatch","partic","rend.mundiales","campeonatos","subcampeonatos","tercer.lugar",
                  "cuarto.lugar","cuartos.final","oct.final","prim.ronda","RankFifa","golescontra","golesfavor",
                  "totalpartido","victorias","porc.victo","gf.part","gc.part")

team2<-data.frame(final$team2,final$idmatch)
colnames(team2)<-c("team2","idmatch")
colnames(equipos)[1]<-"team2"
team2<-merge(team2,equipos,by="team2",all.x = T)
team2<-team2[order(team2$idmatch),]

colnames(team2)<-c("team2","idmatch","partic2","rend.mundiales2","campeonatos2","subcampeonatos2","tercer.lugar2",
                   "cuarto.lugar2","cuartos.final2","oct.final2","prim.ronda2","RankFifa2","golescontra2","golesfavor2",
                   "totalpartido2","victorias2","porc.victo2","gf.part2","gc.part2")
final<-cbind(team,team2)

final<-final[,c(1,20,2,21,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38)]
final$idmatch.1<-NULL

final$rend.mundiales<-as.numeric(final$rend.mundiales)/100
final$rend.mundiales2<-as.numeric(final$rend.mundiales2)/100

predFI<-predict(modRF2,final, type="prob")
resultFI<-data.frame(final$idmatch,predFI)
colnames(resultFI)[1]<-"idmatch"

resultFI$team<-final$team
resultFI$team2<-final$team2
colnames(resultFI)[1]<-"idmatch"
resultFI<-resultFI[,c(1,2,3,5,4)]
resultFI$ganador<-ifelse(resultFI$X1>resultFI$X0,as.character(resultFI$team),as.character(resultFI$team2))

resultFI

##   idmatch     X0     X1 team2   team ganador
## 1       1 0.4468 0.5532 Spain France  France

¿Resultado?

Francia Campeón.

¿Mejorable? Por supuesto que sí.

Este es mi primer proyecto de machine learning, así que es susceptible de muchas mejoras, entre ellas:

Hay algunas desviaciones por considerar la data desde el 1980, habría que incluir alguna variable que ajuste los resultados a periodos más recientes.
La no inclusión de los empates hace que los partidos de las fases finales tengan probabilidades muy parejas.
Se podrían añadir más variables descriptivas de los equipos como por ejemplo la info de FIFA (el juego) de los equipos y jugadores.

Fuente de imagen: La imagen de encabezado del post es de Freepik

4 comentarios en «¿Quién ganará el mundial? Ejercicio de predicción con aprendizaje automático»

Santos Melogno, Andrés

03 de junio de 2020 a las 5:11 pm

buenas, en la parte que dice;»Seguimos con la predicción, subimos el dataset con la fase de grupos.

Despues de cargar el csv, lo que se hace es separar las columnas team y team2 a las cuales les asignamos el respectivo vector de performance por equipo:»

En donde obtengo la base de datos? para reproducir el modelo
Gracias
Responder
Luis Calderón

01 de agosto de 2018 a las 1:44 pm

Dejando de lado a España, este programa es increíble ya que dio el campeón que básicamente es lo que se quería, imagínate el alcance que tendría en cualquier área de aplicación donde se necesita de un aproximado en los resultados que se pretenden, te felicito y si quiero aprender….y sobre todo gracias a Ingenio Empresa por todos estos artículos interesantes, sigan como van.

Luis Calderón
Responder
- Juan Diego Bernate V.
  
  01 de agosto de 2018 a las 2:26 pm
  
  Hola Luis,
  De hecho, este campo y todo lo relacionado con intelegencia artificial, esta teniendo un desarrollo vertiginoso. El aprendizaje supervisado, que es el utilizado en este ejemplo, es uno de los usos más sencillos de todos! después surgen un monton de enfoques muy variados e interesantes, además del deep learning! que te vuela el cerebro.
  Si estás interesado en aprender sobre el tema te invito a que hagas una revisión de los terminos machine learning y ciencia de datos en la web. Además en coursera hay un par de cursos muy buenos para introducirse en el tema, personalmente te recomiendo “Machine learning” de la universidad de Stanford.
  
  Muchas gracias
  
  Juan Diego Bernate
  Responder
Luis fernando urrea

23 de julio de 2018 a las 4:11 pm

Cuando enviaste el correo sobre este articulo decias que Francia había pasado a cuartos, cuando en realidad habia pasado era a octavos. No crei mucho de la prediccion porque no mehabía gustado como habian jugado pues su futbol no era fino, pero como suele pasar en campeonastos del mundo, fue un campeon que fue de menos a mas.

no entendi mucho del articulo pero dan ganas de aprender ese conocimiento, se pueden hacer muchas cosas en otras esferas. Felicidades al autor invitado por la prediccion, aunque fallo muy pronto en españa, y aun con la salida de su tecnico, no tenia mucho para dar esa seleccion.
Responder