Pronóstico en partidos de fútbol: Rating System (3/3)

En la segunda parte hemos obtenido la tabla final en la que aparece cada rating con el consiguiente número de victorias del equipo de casa, victorias del visitante y empates, para la temporada 17-18. En este enlace pueden descargarse las tablas correspondientes a las siete temporadas anteriores.

En esta tercera parte se obtienen finalmente, en base a los datos de las ocho temporadas de la liga de fútbol española referidas, las probabilidades de victoria de casa, victoria de fuera y empate para cada valor del rating de los seis partidos anteriores. Ello podría servir para pronosticar los encuentros de la temporada 18-19 y siguientes. Por ejemplo, se obtiene que si el rating de los seis partidos anteriores es -8, la probabilidad de que gane el equipo de fuera es 0.394, etc.

NOTA: El siguiente script debe ejecutarse paso a paso.

#INICIO -------------------------
rm(list=ls(all=TRUE))

#Eliminamos la posibilidad de que aparezcan anteriores warnings
assign("last.warning", NULL, envir = baseenv())

#-----INTRODUCCIÓN DE DATOS-----
#Nos colocamos en el directorio D:/RR
getwd()

#Descargamos el paquete plyr para dividir, aplicar y combinar datos
library(plyr)

#Leemos las tablas obtenidas en la 2ª parte
x1<-read.table("D:/RR/TABLA.FINAL10.11.txt")
x2<-read.table("D:/RR/TABLA.FINAL11.12.txt")
x3<-read.table("D:/RR/TABLA.FINAL12.13.txt")
x4<-read.table("D:/RR/TABLA.FINAL13.14.txt")
x5<-read.table("D:/RR/TABLA.FINAL14.15.txt")
x6<-read.table("D:/RR/TABLA.FINAL15.16.txt")
x7<-read.table("D:/RR/TABLA.FINAL16.17.txt")
x8<-read.table("D:/RR/TABLA.FINAL17.18.txt")

#Eliminamos la primera fila de cada xi
y1<-x1[-1,];y2<-x2[-1,];y3<-x3[-1,];y4<-x4[-1,];y5<-x5[-1,];y6<-x6[-1,];y7<-x7[-1,];y8<-x8[-1,]

A<-rbind(y1,y2,y3,y4,y5,y6,y7,y8);attach(A)

#Transformamos los elementos de las columnas de A, que son factores, en valores numéricos
#¡¡¡IMPORTANTE!!!: Si no se hace esto no funciona
indx<-sapply(A,is.factor)
A[indx]<-lapply(A[indx],function(x) as.numeric(as.character(x)))

#Ordenamos las filas de A
AA<-ddply(A,"V1",numcolwise(sum));AA

#TOTALES
sum(AA$V2);sum(AA$V3);sum(AA$V4);sum(AA$V5)

#Obtenemos PORCENTAJES GLOBALES como información complementaria
Porcentaje.Casa<-round(100*sum(AA$V2)/sum(AA$V5),2)
Porcentaje.Fuera<-round(100*sum(AA$V3)/sum(AA$V5),2)
Porcentaje.Empates<-round(100*sum(AA$V4)/sum(AA$V5),2)
Porcentaje.Casa
Porcentaje.Fuera
Porcentaje.Empates

#Obtenemos porcentajes para cada valor de rating de partidos
RAT<-AA$V1 #Rating 6 partidos anteriores
CAS<-round(100*AA$V2/AA$V5,2) #Porcentaje de victorias en casa
FUE<-round(100*AA$V3/AA$V5,2) #Porcentaje de victorias fuera
EMP<-round(100*AA$V4/AA$V5,2) #Porcentaje de empates
TOT<-AA$V5
AAA<-data.frame(RAT,CAS,FUE,EMP,TOT)
AAA

#-----CONSTRUCCIÓN DE LOS MODELOS LINEALES-----

plot(RAT,TOT,type='h')
#Se observa que los ratings que tienen datos suficientes
#están, más o menos, entre -15 y 15

#Construimos los modelos lineales que relacionan victoria equipo de casa,
#victoria equipo de fuera o empate con el rating de los 6 partidos anteriores

modeloCAS<-lm(CAS~RAT);modeloFUE<-lm(FUE~RAT);modeloEMP<-lm(EMP~RAT)
summary(modeloCAS)
summary(modeloFUE)
summary(modeloEMP)

windows()
split.screen(c(1,3))
screen(1)
plot(RAT,CAS);abline(modeloCAS)
screen(2)
plot(RAT,FUE);abline(modeloFUE)
screen(3)
plot(RAT,EMP);abline(modeloEMP)

#-----CONSTRUCCIÓN DE LOS MODELOS LINEALES NUEVOS-----
#En los gráficos se observa el mal ajuste, sobre todo en los extremos,
#de los modelos, por lo que se plantean nuevos modelos.
#Modelos nuevos (n), válidos solo para valores de RAT entre -15 y 15.
#En el caso de empate se ajusta un modelo cuadrático

AAAn<-AAA[14:44,]
attach(AAAn)
RATn<-AAAn$RAT
CASn<-AAAn$CAS
FUEn<-AAAn$FUE
EMPn<-AAAn$EMP
TOTn<-AAAn$TOT

modeloCASn<-lm(CASn~RATn);modeloFUEn<-lm(FUEn~RATn);modeloEMPn<-lm(EMPn~RATn+I(RATn^2))

summary(modeloCASn)
summary(modeloFUEn)
summary(modeloEMPn)

windows()
split.screen(c(1,3))
screen(1)
plot(RATn,CASn);abline(modeloCASn)
screen(2)
plot(RATn,FUEn);abline(modeloFUEn)
screen(3)
plot(RATn,EMPn);points(RATn,predict(modeloEMPn),type='l')

#Ahora se observa un mejor ajuste

ac<-summary(modeloCASn)$coefficients[1]
bc<-summary(modeloCASn)$coefficients[2]
af<-summary(modeloFUEn)$coefficients[1]
bf<-summary(modeloFUEn)$coefficients[2]
ae<-summary(modeloEMPn)$coefficients[1]
be<-summary(modeloEMPn)$coefficients[2]
de<-summary(modeloEMPn)$coefficients[3]

#-----CONSTRUCCIÓN DE LA TABLA DEFINITIVA DE PROBABILIDADES-----

CASn = ac+bc*RATn
FUEn = af+bf*RATn
EMPn = ae+be*RATn+de*RATn^2
CASn;FUEn;EMPn;Total<-CASn+FUEn+EMPn

#Para que las sumas de las probabilidades sean 1 se normalizan; para ello se dividen por su suma
GanarCasa<-round(CASn/Total,3)
GanarFuera<-round(FUEn/Total,3)
Empatar<-round(EMPn/Total,3)

GanarCasa;GanarFuera;Empatar
GanarCasa+GanarFuera+Empatar

PROBABILIDADES<-data.frame(RATn,GanarCasa,GanarFuera,Empatar)
PROBABILIDADES
write.table(PROBABILIDADES,file="PROBABILIDADES.txt",row.names=F,sep=",")

#Se han obtenido, por fin, las probabilidades buscadas.
#Por ejemplo:
#Si el rating de los 6 partidos anteriores es 10,
#la probabilidad de que gane el equipo de casa es 0.687.
#Si el rating de los 6 partidos anteriores es -8,
#la probabilidad de que gane el equipo de fuera es 0.394, etc.

warnings()
#FIN -------------------------