Regresión lineal simple Estatura PesoKgs de jugadores FIFA en R

Librerías y csv

library(readr) # Para importar datos
library(dplyr) # Para filtrar   

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(knitr) # Para datos tabulares
library(ggplot2) # Para visualizar
library(plotly)

## 
## Attaching package: 'plotly'

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

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(caret)  # Para particionar

## Loading required package: lattice

library(Metrics) # Para determinar rmse 

## 
## Attaching package: 'Metrics'

## The following objects are masked from 'package:caret':
## 
##     precision, recall

datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/datos.FIFA.limpios.csv", stringsAsFactors = TRUE)
# datos

Limpiar datos

datos.limpios <- subset(datos, !is.na(Estatura))
# datos.limpios %>% select(c("Name","Estatura","PesoKgs"))

Partir datos

n <- nrow(datos.limpios)

# Modificar la semilla estableciendo como par´metro los útimos cuatro dígitos de su no de control. 
# Ej. set.seed(0732), o set.seed(1023)
# set.seed(2022) 
set.seed(2022)

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, primeros 20 registros")

Datos de entrenamiento, primeros 20 registros

	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
8	8	L. Surez	1.83	86.18
9	9	Sergio Ramos	1.83	82.10
10	10	J. Oblak	1.88	87.09
12	12	T. Kroos	1.83	76.20
14	14	David Silva	1.73	67.13
16	16	P. Dybala	1.78	74.84
17	17	H. Kane	1.88	88.90
18	18	A. Griezmann	1.75	73.03
19	19	M. ter Stegen	1.88	84.82
20	20	T. Courtois	1.98	96.16
21	21	Sergio Busquets	1.88	76.20
22	22	E. Cavani	1.85	77.11
23	23	M. Neuer	1.93	92.08
25	25	G. Chiellini	1.88	84.82
27	27	M. Salah	1.75	71.21

Modelo

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

modelo <- lm(data = datos.entrenamiento, formula = PesoKgs ~ Estatura)
modelo

## 
## Call:
## lm(formula = PesoKgs ~ Estatura, data = datos.entrenamiento)
## 
## Coefficients:
## (Intercept)     Estatura  
##      -67.70        78.89

Coeficientes del modelo

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   :  -67.703376"

paste("Valor de la pendiente b es: ", round(b, 6))

## [1] "Valor de la pendiente b es:  78.891316"

Línea de tendencia del modelo

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

Predicciones

predicciones <- predict(object = modelo, newdata = datos.validacion)

comparaciones <- data.frame(Estatura = datos.validacion$Estatura, PesoKgs = datos.validacion$PesoKgs, predicccion = predicciones)
# comparaciones

 kable(x = head(comparaciones, 20), caption = "Predicciones")

Predicciones

	Estatura	PesoKgs	predicccion
6	1.73	73.94	68.77860
7	1.73	66.22	68.77860
11	1.83	79.83	76.66773
13	1.88	78.02	80.61230
15	1.68	72.12	64.83403
24	1.73	69.85	68.77860
26	1.78	73.03	72.72317
31	1.75	78.93	70.35643
33	1.73	68.04	68.77860
34	1.88	79.83	80.61230
35	1.91	92.08	82.97904
40	1.83	82.10	76.66773
45	1.88	88.90	80.61230
48	1.91	93.89	82.97904
53	1.83	78.93	76.66773
55	1.93	84.82	84.55686
58	1.88	86.18	80.61230
59	1.75	68.95	70.35643
60	1.93	92.08	84.55686
66	1.73	69.85	68.77860

x <- c(1.70, 1.80, 1.90)

Y = a + b * x
Y

## [1] 66.41186 74.30099 82.19012

Evaluación del modelo

summary(modelo)

## 
## Call:
## lm(formula = PesoKgs ~ Estatura, data = datos.entrenamiento)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.064  -2.873  -0.192   2.944  37.497 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -67.7034     1.1143  -60.76   <2e-16 ***
## Estatura     78.8913     0.6144  128.40   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.654 on 12535 degrees of freedom
## Multiple R-squared:  0.5681, Adjusted R-squared:  0.568 
## F-statistic: 1.649e+04 on 1 and 12535 DF,  p-value: < 2.2e-16

# Valores residuales
# Fórmula general con el modelo
n <- nrow(datos.entrenamiento)
rmse <- sqrt(sum(modelo$residuals ^ 2) / n) 
rmse

## [1] 4.653904

# Fórmula general con el dataframe comparaciones
n <- nrow(comparaciones)
rmse1 <- sqrt(sum((comparaciones$PesoKgs - comparaciones$predicccion)^2) / n)
rmse1

## [1] 4.631735

# RMSE de librería Metrics
rmse2 <- rmse(actual = comparaciones$PesoKgs, predicted = comparaciones$predicccion)
rmse2

## [1] 4.631735

# RMSE de librería Caret
rmse3 <- RMSE(obs = comparaciones$PesoKgs, pred = comparaciones$predicccion)
rmse3

## [1] 4.631735

Apreciación personal e Interpretación

Descripción

En esta apreciación se está comparando los campos de Valor, el cual indica el valor del jugador en el mercado de 2020, y el campo de Overall, el cual indica la media de la carta de jugador que este tenía en el juego en el momento, en este caso, en el Fifa 2020

Partir datos

set.seed(2002)
entrena <- createDataPartition(y = datos.limpios$Overall, p = 0.70, list = FALSE, times = 1)
datos.entr <- datos.limpios[entrena,]
datos.val <- datos.limpios[-entrena,]

paste("Primeros 20 valores del dataframe a entrenar")

## [1] "Primeros 20 valores del dataframe a entrenar"

head(datos.entr[order(datos.entr$Valor, decreasing = TRUE),], 20) %>% select(c("Name","Overall","Valor"))

##               Name Overall     Valor
## 3        Neymar Jr      92 118500000
## 5     K. De Bruyne      91 102000000
## 6        E. Hazard      91  93000000
## 17         H. Kane      89  83500000
## 26    K. Mbapp\xe9      88  81000000
## 18    A. Griezmann      89  78000000
## 11  R. Lewandowski      90  77000000
## 12        T. Kroos      90  76500000
## 31            Isco      88  73500000
## 4           De Gea      91  72000000
## 27        M. Salah      88  69500000
## 29 J. Rodr\xedguez      88  69500000
## 33        Coutinho      88  69500000
## 7        L. Modric      91  67000000
## 44       M. Icardi      87  64500000
## 46        P. Pogba      87  64000000
## 48       R. Lukaku      87  62500000
## 30      L. Insigne      88  62000000
## 56      L. San\xe9      86  61000000
## 14     David Silva      90  60000000

paste("Primeros 20 valores del dataframe para validar")

## [1] "Primeros 20 valores del dataframe para validar"

head(datos.val[order(datos.val$Valor, decreasing = TRUE),], 20) %>% select(c("Name","Overall","Valor"))

##                   Name Overall     Valor
## 1             L. Messi      94 110500000
## 16           P. Dybala      89  89000000
## 8         L. Su\xe1rez      91  80000000
## 2    Cristiano Ronaldo      94  77000000
## 32          C. Eriksen      88  73500000
## 10            J. Oblak      90  68000000
## 24        S. Ag\xfcero      89  64500000
## 15         N. Kant\xe9      89  63000000
## 19       M. ter Stegen      89  58000000
## 43           S. Umtiti      87  57000000
## 80       Marco Asensio      85  54000000
## 20         T. Courtois      89  53500000
## 49         C. Immobile      87  52000000
## 21     Sergio Busquets      89  51500000
## 9         Sergio Ramos      91  51000000
## 45        K. Koulibaly      87  51000000
## 79 S. Milinkovic-Savic      85  50500000
## 63           R. Varane      86  50000000
## 53     M. Ham\x9a\xedk      87  46500000
## 13         D. God\xedn      90  44000000

Modelo

g <- plot_ly(data = datos.entr,
             x = ~Valor,
             y = ~Overall) %>%
  layout(title = 'Jugadores FIFA. Dispersión de valor en miles de millones y su media en el juego.')
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

Podemos apreciar como la gran mayoría de jugadores están entre los 0 y los 40 millones de dólares, teniendo alrededor de menos de 10 casos, de un total de un poco más de 17,000, un valor de más de los 100 millones de dólares.

modelo <- lm(data = datos.entr, formula = Overall ~ Valor)
modelo

## 
## Call:
## lm(formula = Overall ~ Valor, data = datos.entr)
## 
## Coefficients:
## (Intercept)        Valor  
##   6.432e+01    7.865e-07

Coeficientes del modelo

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   :  64.321748"

paste("Valor de la abcisa b es   : ", round(b, 6))

## [1] "Valor de la abcisa b es   :  1e-06"

Línea de tendencia del modelo

g <- plot_ly(data = datos.entr,
             x = ~Valor,
             y = ~Overall,
             name = "Dispersión",
             type = "scatter",
             mode = "markers",
             color = I("Blue"))
g <- g %>% add_trace(x = ~Valor,
                     y = ~modelo$fitted.values, name = "Tendencia", mode = "lines+markers", color = I("red"))
g <- g %>% layout(title = "Jugadores FIFA. Dispersión y Tendencia de Valor y Media según el juego.")
g

Como se puede apreciar en la gráfica, debido a que la gran mayoría de jugadores se concentran entre los 0 y los ~30 millones, la línea de tendencia se altera, ya que deduce que los jugadores que llegan a valer un mínimo de 45 millones en adelante, deberían de tener una media de 100, teniendo casos excepcionales donde un jugador que tenga el valor de 100 millones, debería tener una media de 144 puntos. Estas medias según el sistema del juego serían imposibles, ya que el máximo de media de una carta en el juego es de 99 puntos.

Predicciones

predicciones <- predict(object = modelo, newdata = datos.val)
comparaciones <- data.frame(Nombre = datos.val$Name, Valor = datos.val$Valor, Overall = datos.val$Overall, prediccion = predicciones)

kable(x = head(comparaciones, 20), caption = "Predicciones")

Predicciones

	Nombre	Valor	Overall	prediccion
1	L. Messi	110500000	94	151.2344
2	Cristiano Ronaldo	77000000	94	124.8853
8	L. Surez	80000000	91	127.2449
9	Sergio Ramos	51000000	91	104.4353
10	J. Oblak	68000000	90	117.8065
13	D. Godn	44000000	90	98.9295
15	N. Kant	63000000	89	113.8738
16	P. Dybala	89000000	89	134.3238
19	M. ter Stegen	58000000	89	109.9411
20	T. Courtois	53500000	89	106.4016
21	Sergio Busquets	51500000	89	104.8286
24	S. Agero	64500000	89	115.0536
32	C. Eriksen	73500000	88	122.1324
43	S. Umtiti	57000000	87	109.1545
45	K. Koulibaly	51000000	87	104.4353
49	C. Immobile	52000000	87	105.2218
53	M. Ham<9a>k	46500000	87	100.8959
55	Piqu	34000000	87	91.0641
63	R. Varane	50000000	86	103.6487
73	M. Pjanic	44000000	86	98.9295

Aquí se puede apreciar los primeros 20 resultados del dataframe, donde podemos observar que a Leonel Messi, posee un valor de poco más 110 millones y una media de 94, cuando, según el modelo, debería tener una media de 151.

x <- c(50000000, 80000000, 110000000)

Y = a + b * x
Y

## [1] 103.6487 127.2449 150.8411

Aquí se muestran predicciones para cuando el valor es 50, 80 y 110 millones de dólares, respectivamente.

Evaluación del modelo

summary(modelo)

## 
## Call:
## lm(formula = Overall ~ Valor, data = datos.entr)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -65.527  -2.794   1.108   4.060  20.532 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 6.432e+01  5.246e-02    1226   <2e-16 ***
## Valor       7.865e-07  8.643e-09      91   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.378 on 12534 degrees of freedom
## Multiple R-squared:  0.3979, Adjusted R-squared:  0.3978 
## F-statistic:  8282 on 1 and 12534 DF,  p-value: < 2.2e-16

Finalmente, el R squared ajustado resultó en un índice de 0.3975, de entre 0 y 1. Osea, el modelo es 39.75% exitoso. Me sorprendió que el modelo resultara con un índice de más del 20%, ya que según observé la gráfica con la línea de tendencia, iba a ser menor a lo obtenido. Esto puede ser debido a que, por donde corta la recta se concentra una gran cantidad de jugadores que aumentan la probabilidad de éxito.

Valores residuales

Fórmula general con el modelo

n <- nrow(datos.entr)
rmse <- sqrt(sum(modelo$residuals ^ 2) / n) 
rmse

## [1] 5.377494

Fórmula general con el dataframe comparaciones

n <- nrow(comparaciones)
rmse1 <- sqrt(sum((comparaciones$Overall - comparaciones$prediccion)^2) / n)
rmse1

## [1] 5.352654

RMSE de librería Metrics

rmse2 <- rmse(actual = comparaciones$Overall, predicted = comparaciones$prediccion)
rmse2

## [1] 5.352654

RMSE de librería Caret

rmse3 <- RMSE(obs = comparaciones$Overall, pred = comparaciones$prediccion)
rmse3

## [1] 5.352654

Preguntas y respuestas

¿Qué significado tiene el estadístico R Square para ambos modelos?

Se usa para determinar qué tan cerca están los datos de la línea de regresión.

¿Qué significado tiene la fórmula de mínimos cuadrados en el modelo de regresión lineal simple?

Sirve para calcular la recta que estima los resultados según los valores estimados.

¿Cuáles son los valores de los coeficientes a y b para el modelo de regresión lineal simple?

El de a = -67.70 y el de b = 78.891316, para el ejemplo del profe, y para mi aprecaición, a = 64.321748 y b = 1e-06.

¿Para qué sirven los datos de entrenamiento y los datos de validación?

Los datos de entrenamiento, como su nombre lo indica, sirven para entrenar el modelo, mientras que los de validación son para comprobar la certeza del modelo.

¿Cómo se puede predecir valores en ambos modelos?

Se predice según el resultado de la fórmula de mínimos cuadrados.

¿Qué diferencias y similitudes encuentran en la programación Python y R en ambos modelos?

En sí, la forma de trabajar el análisis de datos es muy parecida en ambos lenguajes, estuve trabajando los archivos de Python en Jupyter en el IDE de VSCode, y es muy parecido a la programación que usa R Studio con sus archivos Markdown. Una diferencia que noté es que las gráficas que proporciona Python, no están tan bien proporcionadas, en comparación con las que ofrece R Studio.

Para este conjunto de datos cual es el mejor modelo para realizar predicciones y por qué?

Según cada dato redondeado a las 6 décimas, los resultados que dan el del cálculo normal de la fórmula y los 2 de la librería Metrics y Caret me parecen mejor resultado.