ESTUDIO DE LOS DATOS DEL FIFA 19
Aitor Perez Ezkurra
1.-Presentación del proyecto
En este proyecto voy a tratar la información presente en Kaggle “data.csv” incluye la información sobre los jugadores de la versión FIFA 19 (videojuego de futbol). Aparecen todo tipo de variables como: Nombre, edad, dorsal, posición en el terreno de juego, equipo al que pertenece, país en el que está nacionalizado y muchas más variables.
En primer lugar vamos a cargar los datos que tenemos en un data frame que llamaremos datos, vemos cuantas observaciones y cuantas variables hay en este data frame y si hay datos ausentes.
2.-Ingesta y limpieza de datos
library(tidyverse)
datos=read.csv("data.csv")
(observaciones=nrow(datos))
(variables=ncol(datos))
all(complete.cases(datos))En total son 89 variables y 18207 jugadores, pero con la función complete.cases vemos que hay valores nulos, por lo tanto voy a eliminar estos datos para hacer de una forma mas exacta las estadisticas y el analisis ya que solo interesan los jugadores que tengan los datos completos, llamaré al data.frame sin variables vacias datos como en el caso anterior y observamos cuantas observaciones han quedado.
datos=datos[complete.cases(datos), ]
(observaciones=nrow(datos))
(variables=ncol(datos))
all(complete.cases(datos))Hay ahora 18147 observaciones y 89 variables, comprobamos con la misma función complete.cases que no haya valores nulos y en efecto no hay valores nulos.
3.-Análisis de datos
3.1-Mejor equipo
Entre las variables que hay, la variable más importante es Overall, esta variable corresponde a la nota que los creadores del juego le han puesto a cada jugador, esta nota es sobre 99.
Con ese criterio, sabiendo que en la variable “Club” sabemos a que club pertenece cada jugador, voy a calcular el top 5 de mejores equipos, teniendo en cuenta la media de sus jugadores.
mediaclubs=datos%>%
group_by(Club)%>%
summarize(mean(Overall))
mediaclubls=arrange(mediaclubs, - `mean(Overall)`)
(top5=head(mediaclubls, 5))barplot(top5$`mean(Overall)`, names.arg = c(top5$Club), col = "red", border = "blue", ylab ="Nota del equipo", main = "Top 5 mejores equipos" , ylim = c(76, 83))
3.2-Valores atipicos
La edad es una de las variables más importantes en un jugador ya que a un jugador demasiado joven no tiene la suficiente experiencia y un jugador demasiado mayor tiene una capacidad fisica inferior. Vamos a estudiar los valores atipicos de las edades de los jugdores.
ggplot(datos)+
geom_boxplot(aes(Age))
Como podemos observar en el boxplot, hay jugadores atipicamente mayores, pero por no hay jugadores atipicamente jovenes. Podemos ver quienes son esos jugadores:
bxp=boxplot(datos$Age, col="red", plot = FALSE)
atipicos=bxp$out
pos=which(datos$Age %in% atipicos)
(jugadoresmayores=datos$Name[pos])## [1] "G. Buffon" "S. Sorrentino" "Hilton"
## [4] "J. Villar" "A. Bizzarri" "P. Guiñazú"
## [7] "C. Pizarro" "Cifuentes" "S. Bertoli"
## [10] "D. Dainelli" "S. Pellissier" "S. Nakamura"
## [13] "T. Howard" "N. Fernández" "C. Lucchetti"
## [16] "B. Nivet" "N. Rimando" "F. Cubero"
## [19] "O. Pérez" "R. Braña" "J. Gillet"
## [22] "A. BastÃa" "R. Zapata" "J. Speroni"
## [25] "Lee Dong Gook" "C. Muñoz" "José Juan"
## [28] "B. Castillo" "F. Kippe" "M. Caranta"
## [31] "M. Ogasawara" "S. Narazaki" "D. Konstantopoulos"
## [34] "H. Sulaimani" "W. DÃaz" "Y. Nakazawa"
## [37] "D. Bulman" "M. Gurski" "M. Tyler"
## [40] "P. van der Vlag" "K. Ellison" "A. Al Basisi"
## [43] "R. Kawai" "T. Warner" "S. Phillips"
## [46] "Zhou Ting" "K. Pilkington"4.-Relación entre variables
4.1-Relación entre pierna dominante y calidad
Teniendo en cuenta que hay jugadores zurdos y diestros, vamos a comprobar si existe alguna relación entre la calidad de los jugadores y su pierna dominante por lo que nos preguntamos:
¿Existe alguna relación entre la pierna dominante (variable Preferred.Foot) del jugador y su calidad (Overall)?
Al ser la variable pierna dominante una variable factor y la variable calidad una variable continua, podemos observar los boxplots.
boxplot(Overall ~ Preferred.Foot, data = datos, col= heat.colors(7),
las=2, cex.axis=0.75, xlab = "")
stripchart(Overall ~ Preferred.Foot, data = datos, method = "jitter",
vertical = TRUE, pch = 19, col = "red", cex=0.3, add = TRUE) 
Observamos en esta grafica que los jugadores zurdos tienen una mediana de calidad ligeramente superior a los que son diestros. Con esta representación no podemos concluir que la pierna dominante influya en la calidad del jugador.
4.2-Relación entre edad y calidad
Ya que hemos comprobado que la pierna dominante del jugador no es una variable determinante en la calidad del mismo, vamos a ver si la variable edad influye algo en la calidad de los jugadores.
¿Existe relación entre la edad y la calidad del jugador?
siendo las dos variables continuas podemos observar un diagrama de dispersión.
plt = ggplot(datos) +
geom_point(aes(Age,Overall), col = "darkgreen")
plt
De esta dispersión es dificil interpretar algo ya que la nube está muy distribuida, hay que ver si representando la regresión lineal, podemos ver alguna correlación.
##Representación de la regresión lineal
plot( datos$Age,datos$Overall, pch=19, xlab="", ylab = "")
abline(lm(datos$Overall~datos$Age), lwd=10, col="red")
#coeficiente de correlación
cor(datos$Overall,datos$Age)^2## [1] 0.2055302No podemos tomar como valida la regresión lineal ya que solo hay un 20% de correlación.
Representamos por ultimo como evoluciona la media de la calidad de los jugadores en funcion de la edad.
mediasedades=datos%>%
group_by(Age)%>%
summarise(mean(Overall))plot(mediasedades)
No podemos decir que la edad y la calidad tienen relación tampoco, aunque interpretando las medias podemos ver que los jugadores son cada vez mejores hasta que llegan a 30 años donde se estanca la evolución. Esto puede ser por lo que hemos comentado antes, cuando los funtoblistas son jovenes son muy inexpertos y tienen un periodo de aprendizaje donde van mejorando hasta llegar a los 30 años donde los que no pueden aguantar el ritmo de las competiciones se retiran.
5.-Calculo de probabilidades
5.1- Probabilidad condicionada
En la variable Position tenemos las posición que ocupa cada jugador en el campo.
Representamos por lo tanto cuantos jugadores hay en cada posición con la siguiente función.
(tablapos=table(datos$Position))##
## CAM CB CDM CF CM GK LAM LB LCB LCM LDM LF LM LS LW LWB
## 958 1778 948 74 1394 2025 21 1322 648 395 243 15 1095 207 381 78
## RAM RB RCB RCM RDM RF RM RS RW RWB ST
## 21 1291 662 391 248 16 1124 203 370 87 2152Cual es la probabilidad que un portero (GK) tenga un dorsal (variable Jersey.Number) 1, es decir: P(Jersey.Number=1|Position=GK). Para eso tenemos que representar la siguinte tabla donde vemos la cantidad de jugadores tienen cada dorsal por posición.
tabla=(table(datos$Jersey.Number, datos$Position))
head(tabla)##
## CAM CB CDM CF CM GK LAM LB LCB LCM LDM LF LM LS LW LWB RAM RB RCB
## 1 0 0 0 0 0 566 0 0 0 0 0 0 0 0 0 0 0 0 0
## 2 2 78 10 0 5 0 0 49 32 1 1 0 4 0 0 6 0 246 51
## 3 2 136 10 0 6 0 0 198 48 2 0 0 11 0 1 16 0 35 70
## 4 3 178 34 0 31 0 0 25 81 13 10 0 5 0 0 0 0 47 101
## 5 5 145 54 0 30 0 0 63 104 11 16 0 2 0 0 5 0 34 82
## 6 8 72 98 1 75 0 0 34 65 26 25 0 6 0 0 1 1 28 52
##
## RCM RDM RF RM RS RW RWB ST
## 1 0 0 0 0 0 0 0 0
## 2 0 2 0 9 0 2 16 5
## 3 5 0 0 2 0 0 0 5
## 4 18 13 0 6 0 1 3 4
## 5 7 15 0 5 0 0 0 1
## 6 40 39 0 7 0 0 3 5Nos quedamos con la primera linea que corresponde al dorsal 1 y con la columna 6 que corresponde a la posición del portero.
unname(tabla[1,6]/tablapos[6])## [1] 0.2795062P(Jersey.Number=1|Position=GK)=0.2795062
5.2- Estudio de la normalidad
5.2.1- Normalidad de la variable dorsal del jugador
Voy a estudiar la normalidad de dos variables que hay en los datos de los jugadores, en primer lugar la del dorsal de los jugadores:
qqnorm(datos$Jersey.Number)
qqline(datos$Jersey.Number)
ggplot(datos) +
geom_density(aes(x=Jersey.Number))
Como podemos ver en estas graficas, no se puede decir que el numero del dorsal de los jugadores tiene alguna normalidad.
5.1.2- Estudio de la normalidad de la variable OVERALL
Ahora estudiaré la normalidad de la variable Overall.
qqnorm(datos$Overall)
qqline(datos$Overall)
ggplot(datos) +
geom_density(aes(x=Overall))
En este caso si que podemos decir que hay una normalidad en esta variable. Por lo tanto si que podemos aplicar las probabilidades asociadas a la ley normal.
¿cual es la probabilidad que un jugador elegido al azar tenga un Overall comprendido entre 70 y 80?
m=mean(datos$Overall)
s=sd(datos$Overall)
pnorm(q =80, mean = m, sd = s )-pnorm(q =70, mean = m, sd = s )## [1] 0.2705697P(70<overall<80)=0.2705697
6.- Mejor alineación posible
Voy a encontrar ahora el mejor equipo posible que se puede hacer con estos jugdores, para ello hay que tener en cuenta no solo quienes son los mejores jugadores según la media sino cual es la posición que ocupan en el campo.
Voy a escoger: 1 GK, 2 CB (uno zurdo y otro diestro), 1 LB , 1 RB, 1 CM, 1 CDM, 1CAM, 1 RW, 1 LW y 1 ST.
##Portero
porteros=datos%>%
filter(Position=="GK")
porteros=arrange(porteros,- Overall)
(portero=porteros[1, 3])## [1] "De Gea"##Centrales
centrales=datos%>%
filter(Position=="CB")
centrales =arrange(centrales, -Overall)
centraleszurdos=centrales%>%
filter(centrales$Preferred.Foot=="Left")
centraleszurdos=arrange(centraleszurdos, -Overall)
(central1=centraleszurdos[1,3])## [1] "S. Umtiti"centralesdiestros=centrales%>%
filter(centrales$Preferred.Foot=="Right")
centralesdiestros=arrange(centralesdiestros, -Overall)
(central2=centralesdiestros[1,3])## [1] "D. GodÃn"##Lateral zurdo
lateralesizq=datos%>%
filter(Position=="LB")
lateralesizq =arrange(lateralesizq, -Overall)
(lateralizq=lateralesizq[1,3])## [1] "Marcelo"##Lateral diestro
lateralesder=datos%>%
filter(Position=="RB")
lateralesder =arrange(lateralesder, -Overall)
(lateralder=lateralesder[1,3])## [1] "Azpilicueta"##Medio centro
mediocentros=datos%>%
filter(Position=="CM")
mediocentros =arrange(mediocentros, -Overall)
(mediocentro1=mediocentros[1,3])## [1] "Thiago"##Medio centro defensivo
mediocentrosdef=datos%>%
filter(Position=="CDM")
mediocentrosdef =arrange(mediocentrosdef, -Overall)
(mediocentrodef=mediocentrosdef[1,3])## [1] "Sergio Busquets"##Medio centro ofensivo
mediocentrosof=datos%>%
filter(Position=="CAM")
mediocentrosof =arrange(mediocentrosof, -Overall)
(mediocentroof=mediocentrosof[1,3])## [1] "A. Griezmann"##Extremo derecho
extremder=datos%>%
filter(Position=="RF")
extremder =arrange(extremder, -Overall)
(extremder=extremder[1,3])## [1] "L. Messi"##Extremo izquierdo
extremizq=datos%>%
filter(Position=="LW")
extremizq =arrange(extremizq, -Overall)
(extremizq=extremizq[1,3])## [1] "Neymar Jr"##Delantero
delanteros=datos%>%
filter(Position=="ST")
delanteros=arrange(delanteros, -Overall)
(delantero=delanteros[1,3])## [1] "Cristiano Ronaldo"Esta es la mejor alineación que se puede utilizar.
7.- Alineación de la selección española
Para que un jugador sea convocado en la selección española, las condiciones que hay son las siguientes:
- Que sea mayor de 21 años ya que sino deberia jugar en las categorias inferiores de la selección española
- Que tenga un Overal superior a 83
- Que el jugador tenga la nacionalidad española
Creamos la variable seleccionable para mostrar si un jugador puede pertenecer a la seleccion o no.
seleccion=datos%>%
filter(Nationality=="Spain" & Age>21)
seleccion$seleccionable=cut(seleccion$Overall, breaks = c(0,83,99), labels = c("No seleccionable", "Seleccionable"))Veamos ahora cuantos de los jugadores españoles mayores de 21 años pueden pertenercer a la seleccion.
table(seleccion$seleccionable)##
## No seleccionable Seleccionable
## 780 21Hay 21 jugadores que cumplen las condiciones para jugar en la selección española.
seleccionados=seleccion%>%
filter(seleccion$seleccionable=="Seleccionable")
seleccionados$Name## [1] "De Gea" "Sergio Ramos" "David Silva" "Sergio Busquets"
## [5] "Isco" "Jordi Alba" "Piqué" "Thiago"
## [9] "Azpilicueta" "Iniesta" "Marco Asensio" "Saúl"
## [13] "Koke" "Parejo" "Diego Costa" "Carvajal"
## [17] "Iago Aspas" "Illarramendi" "José Callejón" "Sergio Asenjo"
## [21] "Raúl Albiol"8.-Modelos predictivos
Para este ultimo apartado voy a intentar escoger un modelo de Machin Learning para poder predecir el Overall de los porteros. Los porteros tienen unas caracteristicas muy especificas: GKDiving, GKKIcking, GKHandling, GKKicking, GKPositioning en cada una de estas variables cada portero tiene una media sobre 99. Por lo tanto voy a estudiar si con esas variables puedo predecir el Overall de los porteros.
8.3 -Preparación del dataset
Para limpiar el dataset en primer lugar me voy a quedar solo con los porteros que tengan la información completa y con las variables que nos interesan Overall como variable de salida y GKDiving, GKKIcking, GKHandling, GKKicking, GKPositioning en cada una de estas variables cada portero como variable de entrada.
library(readxl)
library(ggplot2)
library(caret)
library(GGally)
library(splines)
library(NeuralNetTools)
library(gridExtra)
library(MLTools)
library(dplyr)
#Create sinthetic dataset-------------------------------------------------------
fdata <- read.csv("data.csv")
#quitamos los NAN y nos quedamos con los porteros y sus variables---------------
fdata=fdata[complete.cases(fdata), ]
fdata=fdata%>%
filter(Position=='GK')
fdata=select(fdata,Overall ,GKDiving:GKReflexes)
## Dividir el dataset en conjunto de entrenamiento y conjunto de validacion-----
set.seed(150)
ratioTR = 0.8
trainIndex <- createDataPartition(fdata$Overall,
p = ratioTR,
list = FALSE,
times = 1)
#obtain training and Test sets--------------------------------------------------
fTR = fdata[trainIndex,]
fTS = fdata[-trainIndex,]
#Create sets for storing predictions--------------------------------------------
fTR_eval = fTR
fTS_eval = fTS
## Initialize trainControl -----------------------------------------------------
ctrl_tune <- trainControl(method = "cv",
number = 10,
summaryFunction = defaultSummary,
returnResamp = "final",
savePredictions = TRUE) ## Exploratory analysis --------------------------------------------------------
PlotDataframe(fdata,output.name = "Overall")
Observamos que parece que existe una fuerte relación entre las variables de entrada y la ariable de salida.
8.2 -Modelo de arbol
En primer lugar voy a escoger un modelo de arbol para predecir el overall con todas las variables.
## Regression Tree -------------------------------------------------------------------------------------------
library(rpart)
library(rpart.plot)
library(partykit)
set.seed(150)
tree.fit = train(form = Overall~.,
data = fTR,
method = "rpart",
preProcess = c("center","scale"),
tuneGrid = data.frame(cp = seq(0,0.01,0.0005)),
trControl = ctrl_tune,
metric = "RMSE")
tree.fit
summary(tree.fit)
tree.fit$finalModel
# plot
rpart.plot(tree.fit$finalModel, type = 2, fallen.leaves = FALSE, box.palette = "Oranges")
#Measure for variable importance
varImp(tree.fit,scale = FALSE)
plot(varImp(tree.fit,scale = FALSE))
Como podemos ver en la grafica donde aparece la importancia de las variables, vemos que todas influyen pero la variable GKKicking influye menos que el resto, por lo tanto la vamos a quitar para el siguiente modelo.
#Evaluate the model with training sets and diagnosis
fTR_eval$tree_pred = predict(tree.fit, newdata = fTR)
fTS_eval$tree_pred = predict(tree.fit, newdata = fTS) PlotModelDiagnosis(fTR, fTR$Overall,
fTR_eval$tree_pred, together = TRUE)
Se ajusta bastante bien al modelo por lo tanto con este modelo podemos predecir el Overall.
8.3 -Modelo SVM
Vamos a probar este otro modelo ya que aunque el modelo del arbol funcione bastante bien hay que probar con otros modelos.
## svm -------------------------------------------------------------------------------------------
library(kernlab)
set.seed(150)
svm.fit = train(form = Overall~GKDiving+GKHandling+GKKicking+GKPositioning,
data = fTR,
method = "svmRadial",
tuneGrid = expand.grid(C = 10^seq(-1,2,length.out = 6), sigma=10^seq(-3,1,length.out=5)),
preProcess = c("center","scale"),
trControl = ctrl_tune,
metric = "RMSE")
svm.fit
#Evaluate the model with training sets and diagnosis
fTR_eval$svm_pred = predict(svm.fit, newdata = fTR)
fTS_eval$svm_pred = predict(svm.fit, newdata = fTS) PlotModelDiagnosis(fTR, fTR$Overall,
fTR_eval$tree_pred, together = TRUE)
Este modelo tambien parece ajustarse muy bien a este caso de estudio por lo tanto tenemos que comparar los dos y quedarnos con el que mas nos interese.
8.4 -Comparación
Para compararlos simplemente nos fijamos en sus valores de MAE, RMSE (medidas de los errores que cuanto mas pequeños son, mejor es el modelo) y Rsquared (un valor entre 0 y 1 que permite ver la exactitud del modelo)
# Evaluate performances -------------------------------------------------------------------------
transformResults <- resamples(list(tree=tree.fit, svm = svm.fit))
dotplot(transformResults)
Por lo tanto nos quedamos con el modelo SVM que mejora al modelo de arbol en todas las variables.