Realizar predicciones de peso de jugadores de futbol con los datos de FIFA de acuerdo a la variable estatura
Cargar libreias
Cargar datos
Seleccionar variables de estudio estatura y peso
Crear datos de entrenamiento y datos de validacion
Construir el modelo de regresion lineal simple
Evaluar el modelo
Realizar predicciones con datos nuevos
library(readr) # Para importar datos
library(dplyr) # Para filtrar
library(knitr) # Para datos tabulares
library(ggplot2) # Para visualizar
library(plotly)
library(caret) # Para particionar
library(Metrics) # Para determinar rmse
datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/datos.FIFA.limpios.csv", encoding = "UFT-8" )
summary(datos$Estatura)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 1.550 1.750 1.800 1.812 1.850 2.060 48
summary(datos$PesoKgs)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 49.90 69.85 74.84 75.28 79.83 110.22 48
print('Peso')
## [1] "Peso"
Se detectaron 48 registros con valores ‘NA’ por lo que se quitan del conjunto de datos ya que se representan solo el .26% o sea menos del 1%.
datos.limpios <- subset(datos, !is.na(Estatura))
Explorar datos
str(datos)
## 'data.frame': 17955 obs. of 50 variables:
## $ X : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Name : chr "L. Messi" "Cristiano Ronaldo" "Neymar Jr" "De Gea" ...
## $ Age : int 31 33 26 27 27 27 32 31 32 25 ...
## $ Nationality : chr "Argentina" "Portugal" "Brazil" "Spain" ...
## $ Overall : int 94 94 92 91 91 91 91 91 91 90 ...
## $ Potential : int 94 94 93 93 92 91 91 91 91 93 ...
## $ Club : chr "FC Barcelona" "Juventus" "Paris Saint-Germain" "Manchester United" ...
## $ Preferred.Foot : chr "Left" "Right" "Right" "Right" ...
## $ International.Reputation: int 5 5 5 4 4 4 4 5 4 3 ...
## $ Weak.Foot : int 4 4 5 3 5 4 4 4 3 3 ...
## $ Skill.Moves : int 4 5 5 1 4 4 4 3 3 1 ...
## $ Height : chr "5'7" "6'2" "5'9" "6'4" ...
## $ Weight : chr "159lbs" "183lbs" "150lbs" "168lbs" ...
## $ Crossing : int 84 84 79 17 93 81 86 77 66 13 ...
## $ Finishing : int 95 94 87 13 82 84 72 93 60 11 ...
## $ HeadingAccuracy : int 70 89 62 21 55 61 55 77 91 15 ...
## $ ShortPassing : int 90 81 84 50 92 89 93 82 78 29 ...
## $ Volleys : int 86 87 84 13 82 80 76 88 66 13 ...
## $ Dribbling : int 97 88 96 18 86 95 90 87 63 12 ...
## $ Curve : int 93 81 88 21 85 83 85 86 74 13 ...
## $ FKAccuracy : int 94 76 87 19 83 79 78 84 72 14 ...
## $ LongPassing : int 87 77 78 51 91 83 88 64 77 26 ...
## $ BallControl : int 96 94 95 42 91 94 93 90 84 16 ...
## $ Acceleration : int 91 89 94 57 78 94 80 86 76 43 ...
## $ SprintSpeed : int 86 91 90 58 76 88 72 75 75 60 ...
## $ Agility : int 91 87 96 60 79 95 93 82 78 67 ...
## $ Reactions : int 95 96 94 90 91 90 90 92 85 86 ...
## $ Balance : int 95 70 84 43 77 94 94 83 66 49 ...
## $ ShotPower : int 85 95 80 31 91 82 79 86 79 22 ...
## $ Jumping : int 68 95 61 67 63 56 68 69 93 76 ...
## $ Stamina : int 72 88 81 43 90 83 89 90 84 41 ...
## $ Strength : int 59 79 49 64 75 66 58 83 83 78 ...
## $ LongShots : int 94 93 82 12 91 80 82 85 59 12 ...
## $ Aggression : int 48 63 56 38 76 54 62 87 88 34 ...
## $ Interceptions : int 22 29 36 30 61 41 83 41 90 19 ...
## $ Positioning : int 94 95 89 12 87 87 79 92 60 11 ...
## $ Vision : int 94 82 87 68 94 89 92 84 63 70 ...
## $ Penalties : int 75 85 81 40 79 86 82 85 75 11 ...
## $ Composure : int 96 95 94 68 88 91 84 85 82 70 ...
## $ Marking : int 33 28 27 15 68 34 60 62 87 27 ...
## $ StandingTackle : int 28 31 24 21 58 27 76 45 92 12 ...
## $ SlidingTackle : int 26 23 33 13 51 22 73 38 91 18 ...
## $ GKDiving : int 6 7 9 90 15 11 13 27 11 86 ...
## $ GKHandling : int 11 11 9 85 13 12 9 25 8 92 ...
## $ GKKicking : int 15 15 15 87 5 6 7 31 9 78 ...
## $ GKPositioning : int 14 14 15 88 10 8 14 33 7 88 ...
## $ GKReflexes : int 8 11 11 94 13 8 9 37 11 89 ...
## $ Valor : int 110500000 77000000 118500000 72000000 102000000 93000000 67000000 80000000 51000000 68000000 ...
## $ Estatura : num 1.7 1.88 1.75 1.93 1.8 1.73 1.73 1.83 1.83 1.88 ...
## $ PesoKgs : num 72.1 83 68 76.2 69.8 ...
Se detectaron 48 registros con valores NA por lo cual se quitan del conjunto de datos ya que solo representan tan solo el 0.26% o sea menos del 1%.
datos.limpios <- subset(datos, !is.na(Estatura))
Se identifica el numero de observaciones n y se siembra la semilla a 2022 para construir los mismos valores aleatorios por la función createDataPartition().
n <- nrow(datos.limpios)
set.seed(0421)
De manera aleatoria se construyen los datos de entrenamiento y los datos de validación.
En la variable entrena se generan los registros que van a ser los datos de entrenamiento, de tal forma que los datos de validación serán los que no sena de entrenamiento [-entrena].
entrena <- createDataPartition(y = datos.limpios$PesoKgs, p = 0.70, list = FALSE, times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos.limpios[entrena,] # [renglones, columna]
# Datos validación
datos.validacion <- datos.limpios[-entrena, ]
kable(head(datos.entrenamiento[, c('X', 'Name', 'Estatura', 'PesoKgs')], 20), caption = "Datos de entrenamiento")
| X | Name | Estatura | PesoKgs | |
|---|---|---|---|---|
| 1 | 1 | L. Messi | 1.70 | 72.12 |
| 2 | 2 | Cristiano Ronaldo | 1.88 | 83.01 |
| 3 | 3 | Neymar Jr | 1.75 | 68.04 |
| 4 | 4 | De Gea | 1.93 | 76.20 |
| 5 | 5 | K. De Bruyne | 1.80 | 69.85 |
| 7 | 7 | L. Modric | 1.73 | 66.22 |
| 9 | 9 | Sergio Ramos | 1.83 | 82.10 |
| 11 | 11 | R. Lewandowski | 1.83 | 79.83 |
| 12 | 12 | T. Kroos | 1.83 | 76.20 |
| 13 | 13 | D. Godín | 1.88 | 78.02 |
| 15 | 15 | N. Kanté | 1.68 | 72.12 |
| 16 | 16 | P. Dybala | 1.78 | 74.84 |
| 17 | 17 | H. Kane | 1.88 | 88.90 |
| 18 | 18 | A. Griezmann | 1.75 | 73.03 |
| 20 | 20 | T. Courtois | 1.98 | 96.16 |
| 22 | 22 | E. Cavani | 1.85 | 77.11 |
| 23 | 23 | M. Neuer | 1.93 | 92.08 |
| 24 | 24 | S. Agüero | 1.73 | 69.85 |
| 25 | 25 | G. Chiellini | 1.88 | 84.82 |
| 29 | 29 | J. Rodríguez | 1.80 | 78.02 |
Mostrar los primeros 20 y últimos 20 registros de los datos de validación.
kable(head(datos.validacion[, c('X', 'Name', 'Estatura', 'PesoKgs')], 20), caption = "Datos de validación")
| X | Name | Estatura | PesoKgs | |
|---|---|---|---|---|
| 6 | 6 | E. Hazard | 1.73 | 73.94 |
| 8 | 8 | L. Suárez | 1.83 | 86.18 |
| 10 | 10 | J. Oblak | 1.88 | 87.09 |
| 14 | 14 | David Silva | 1.73 | 67.13 |
| 19 | 19 | M. ter Stegen | 1.88 | 84.82 |
| 21 | 21 | Sergio Busquets | 1.88 | 76.20 |
| 26 | 26 | K. Mbappé | 1.78 | 73.03 |
| 27 | 27 | M. Salah | 1.75 | 71.21 |
| 28 | 28 | Casemiro | 1.85 | 83.91 |
| 30 | 30 | L. Insigne | 1.63 | 58.97 |
| 32 | 32 | C. Eriksen | 1.80 | 76.20 |
| 33 | 33 | Coutinho | 1.73 | 68.04 |
| 41 | 41 | S. Handanovic | 1.93 | 92.08 |
| 47 | 47 | K. Navas | 1.85 | 79.83 |
| 48 | 48 | R. Lukaku | 1.91 | 93.89 |
| 55 | 55 | Piqué | 1.93 | 84.82 |
| 56 | 56 | L. Sané | 1.83 | 74.84 |
| 60 | 60 | V. van Dijk | 1.93 | 92.08 |
| 62 | 62 | Roberto Firmino | 1.80 | 76.20 |
| 64 | 64 | M. Verratti | 1.65 | 59.87 |
Visualizar dispersión de los datos de entrenamiento con las variables de interés Estatura y PesoKgs.
g <- plot_ly(data = datos.entrenamiento,
x = ~Estatura,
y = ~PesoKgs) %>%
layout(title = 'Jugadores FIFA. Dispersión de estatura en metros y peso en kilogramos.')
g
## No trace type specified:
## Based on info supplied, a 'scatter' trace seems appropriate.
## Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No scatter mode specifed:
## Setting the mode to markers
## Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
Con los datos de entrenamiento construir el modelo de regresión lineal simple.
\[ Y = a+bx \]
\[ Y = β0+β1⋅x \]
De las dos variables de interés, Estatura y PesoKgs se determina que la variable predictora es Estatura y el PesoKgs es la variable de respuesta o también:
Estatura es variable independiente y
PesoKgs es variable dependiente
Es decir, la variable PesoKgs depende de la Estatura
modelo <- lm(data = datos.entrenamiento, formula = PesoKgs ~ Estatura)
modelo
##
## Call:
## lm(formula = PesoKgs ~ Estatura, data = datos.entrenamiento)
##
## Coefficients:
## (Intercept) Estatura
## -68.33 79.24
Se determinan los valores de a y b de la fórmula \(Y=a+bx\)
a <- modelo$coefficients[1]
b <- modelo$coefficients[2]
paste("Valor de la abcisa a es : ", round(a, 6))
## [1] "Valor de la abcisa a es : -68.326329"
paste("Valor de la pendiente b es: ", round(b, 6))
## [1] "Valor de la pendiente b es: 79.24438"
Con la el valor de los valores de tendencia o valores ajustados del modelo se visualiza la recta de tendencia del modelo.
La gráfica g se construye por partes, primero la dispersión, segundo la linea de tendencia, tercero se agrega el título, para luego solo mostrar la gráfica g.
g <- plot_ly(data = datos.entrenamiento,
x = ~Estatura,
y = ~PesoKgs,
name = 'Dispersión',
type = 'scatter',
mode = 'markers',
color = I('blue'))
g <- g %>% add_trace(x = ~Estatura,
y = ~modelo$fitted.values, name = 'Tendencia', mode = 'lines+markers', color = I('red'))
g <- g %>%
layout(title = 'Jugadores FIFA. Dispersión y Tendencia de estatura en metros y peso en kilogramos.')
g
Con los datos de validación, se hacen predicciones con la función predict(), luego se presentan algunas de las mismas prediccciones que pueden ser los mismos valores de Estatura o con nuevos valores calculadas manualmente usando la fórmula \(Y=a+bx\).
Se hace un data.frame de comparaciones con lo cual se presentan los valores reales y los valores de las predicciones. Se presenta solo las primeras 20 y últimas 20 predicciones.
predicciones <- predict(object = modelo, newdata = datos.validacion)
comparaciones <- data.frame(Estatura = datos.validacion$Estatura, PesoKgs = datos.validacion$PesoKgs, predicccion = predicciones)
kable(x = head(comparaciones, 20), caption = "Predicciones")
| Estatura | PesoKgs | predicccion | |
|---|---|---|---|
| 6 | 1.73 | 73.94 | 68.76645 |
| 8 | 1.83 | 86.18 | 76.69089 |
| 10 | 1.88 | 87.09 | 80.65311 |
| 14 | 1.73 | 67.13 | 68.76645 |
| 19 | 1.88 | 84.82 | 80.65311 |
| 21 | 1.88 | 76.20 | 80.65311 |
| 26 | 1.78 | 73.03 | 72.72867 |
| 27 | 1.75 | 71.21 | 70.35134 |
| 28 | 1.85 | 83.91 | 78.27578 |
| 30 | 1.63 | 58.97 | 60.84201 |
| 32 | 1.80 | 76.20 | 74.31356 |
| 33 | 1.73 | 68.04 | 68.76645 |
| 41 | 1.93 | 92.08 | 84.61533 |
| 47 | 1.85 | 79.83 | 78.27578 |
| 48 | 1.91 | 93.89 | 83.03044 |
| 55 | 1.93 | 84.82 | 84.61533 |
| 56 | 1.83 | 74.84 | 76.69089 |
| 60 | 1.93 | 92.08 | 84.61533 |
| 62 | 1.80 | 76.20 | 74.31356 |
| 64 | 1.65 | 59.87 | 62.42690 |
kable(x = tail(comparaciones, 20), caption = "Predicciones")
| Estatura | PesoKgs | predicccion | |
|---|---|---|---|
| 17870 | 1.78 | 74.84 | 72.72867 |
| 17871 | 1.83 | 73.03 | 76.69089 |
| 17873 | 1.70 | 68.95 | 66.38912 |
| 17874 | 1.78 | 66.22 | 72.72867 |
| 17879 | 1.83 | 63.96 | 76.69089 |
| 17887 | 1.83 | 69.85 | 76.69089 |
| 17890 | 1.78 | 69.85 | 72.72867 |
| 17892 | 1.75 | 63.05 | 70.35134 |
| 17894 | 1.70 | 62.14 | 66.38912 |
| 17907 | 1.78 | 69.85 | 72.72867 |
| 17910 | 1.93 | 79.83 | 84.61533 |
| 17914 | 1.85 | 74.84 | 78.27578 |
| 17924 | 1.85 | 73.03 | 78.27578 |
| 17925 | 1.73 | 69.85 | 68.76645 |
| 17930 | 1.85 | 78.02 | 78.27578 |
| 17932 | 1.78 | 74.84 | 72.72867 |
| 17939 | 1.75 | 79.83 | 70.35134 |
| 17941 | 1.85 | 74.84 | 78.27578 |
| 17945 | 1.70 | 66.22 | 66.38912 |
| 17950 | 1.85 | 76.20 | 78.27578 |
x <- c(1.70, 1.80, 1.90)
Y = a + b * x
Y
## [1] 66.38912 74.31356 82.23799
¿Que tan bien predice el modelo?
¿Es bueno el modelo de regresión lineal simple ?
¿Cuáles estadísticos hay que calcular e identificar para evaluar el modelo?
summary(modelo)
##
## Call:
## lm(formula = PesoKgs ~ Estatura, data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.133 -2.879 -0.169 2.914 37.491
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -68.3263 1.0959 -62.34 <2e-16 ***
## Estatura 79.2444 0.6043 131.13 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.609 on 12535 degrees of freedom
## Multiple R-squared: 0.5784, Adjusted R-squared: 0.5784
## F-statistic: 1.72e+04 on 1 and 12535 DF, p-value: < 2.2e-16
De acuerdo al estadístico Multiple R-squared con valor 0.5784, significa que la variable Estatura representa tan solo el 57.84% del valor del PesoKgs.
El coeficiente de determinación identificado por expresión R^2 e identificado como Multiple R-squared determina la calidad del modelo para replicar los resultados y la proporción de variación de los resultados que puede explicarse por el modelo.
Este valor Multiple R-squared es relativo al compararlo con un criterio inicial. Por ejemplo, si al principio se hubiera establecido que el modelo se acepta si hay un 70% o mas el modelo se acepta, entonces bajo esta premisa tal vez el modelo no se acepta ya que Multiple R-squared es 0.5784 que está por debajo del 70%.
Sin embargo, si se hubiera establecido que se acepta con un valor por encima del 50%, entonces este modelo si se acepta ya que Multiple R-squared es 0.5784 o 57.84%.
Se observan que las variables estadísticas tanto el coeficiente de intersección como la variable predictiva Estatura si son altamente y estadísticamente significativas por debajo del 0.001 o con un nivel de confianza mayor al 99.9%. Se observa con los ‘***’ en las variables.
La raiz del Error Cuadrático Medio (RMSE) es una métrica que dice qué tan lejos están los valores predichos de los valores observados o reales en un análisis de regresión, en promedio. Se calcula como:
\[ RMSE = \sqrt{\frac{\sum(predicho_i - real_i)^{2}}{n}} \]
RMSE es una forma útil de ver qué tan bien un modelo de regresión puede ajustarse a un conjunto de datos.
Cuanto mayor sea el RMSE, mayor será la diferencia entre los valores predichos y reales, lo que significa que peor se ajusta un modelo de regresión a los datos. Por el contrario, cuanto más pequeño sea el RMSE, mejor podrá un modelo ajustar los datos.
Usando el data.frame comparaciones previamente construído se determina el RMSE manualmente.
n <- nrow(comparaciones)
rmse1 <- sqrt(sum((comparaciones$PesoKgs - comparaciones$predicccion)^2) / n)
rmse1
## [1] 4.736876
Se puede usar la función rmse() de la librería Metrics
rmse2 <- rmse(actual = comparaciones$PesoKgs, predicted = comparaciones$predicccio)
rmse2
## [1] 4.736876
Usando la función RMSE() de la librería caret
rmse3 <- RMSE(obs = comparaciones$PesoKgs, pred = comparaciones$predicccion)
rmse3
## [1] 4.736876
En todos los cálculos el valor de rmse es de 4.736876, ¿que significa el valor de 4.736876?
Con base en RMSE, se puede comparar dos modelos diferentes entre sí y poder identificar qué modelo se ajusta mejor a la predicción de los datos.
El análisis de datos que hicimos fue con el conjunto de datos de FIFA. Los datos se encuentran en la dirección “https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/datos.FIFA.limpios.csv%22 y contiene 17955 observaciones y 50 variables. Nuestro propósito era hacer regresión lineal simple con esos datos.La variable independiente en este análisis es estatura de un jugador y la variable dependiente es Peso que será Valor en formato numérico que significa el valor de un jugador. Hicimos una correlación entre estas 2 variables y nos dio el resultado de 4.736876 que es una correlacion positiva considerable. El valor Multiple R-squared es 0.5784. Para este caso significa que se hubiera establecido el modelo se acepta si hay un 70% o mas . El valor de la variable Estatura representa tan solo el 57.84% del valor del PesoKgs. La variable predictiva Estatura si son altamente y estadísticamente significativas por debajo del 0.001 o con un nivel de confianza mayor al 99.9%El modelo predice positivamente considerable como se ve en la correlacion, hay probabilidad que otra variable tenga más relación con el Peso para tener un índice mayor de correlación. La diferencia es que hay mayor indice de correlacion.