Construir modelos de regresión lineal simple y polinómico importando datos FIFA con variable Overall y Valor para realizar predicciones y evaluar y comparar su rendimiento.
Cargar librerías
Cargar datos de FIFA
Métricas a evaluar
Explorar datos
Variables independiente y dependiente
Visualizar dispersión de los datos
Construir datos de entrenamiento y datos de validación.
Regresión Lineal Simple
Construir el modelo
Predicciones
Metricas del modelo
Regresión Polinómica de segundo
Construir el modelo
Predicciones
Métricas del modelo
Regresión Polinómica de quinto nivel
Construir el modelo
Predicciones
Métricas del modelo
Interpretación
Se van a realizar y evaluar métricas de las predicciones con los modelos de regresión lineal simple y regresión polinómica con los mismos datos.
Los modelos se aceptan si las métricas cumplen estos requisitos:
El valor de R Square y R Square ajustado sobrepasa el 50%,
Que sus variables sea estadísticamente significativas al 95%. Al menos un ‘*’
Que el valor de RMSE (Raiz del Error Estándar Medio) sea menor que : 2 000 000 (dos millones).
Al final se deben comparar los modelos.
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.limpios.csv", stringsAsFactors = TRUE)
str(datos)
## 'data.frame': 17907 obs. of 51 variables:
## $ X.1 : int 1 2 3 4 5 6 7 8 9 10 ...
## $ X : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Name : Factor w/ 16912 levels "A. Ábalos","A. Abang",..: 9504 3128 12343 4091 8510 4377 9512 9716 15209 7686 ...
## $ Age : int 31 33 26 27 27 27 32 31 32 25 ...
## $ Nationality : Factor w/ 163 levels "Afghanistan",..: 7 123 21 140 14 14 36 158 140 137 ...
## $ 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 : Factor w/ 651 levels " SSV Jahn Regensburg",..: 214 329 436 376 375 137 473 214 473 61 ...
## $ Preferred.Foot : Factor w/ 2 levels "Left","Right": 1 2 2 2 2 2 2 2 2 2 ...
## $ 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 : Factor w/ 21 levels "5'1","5'10","5'11",..: 9 14 11 16 3 10 10 12 12 14 ...
## $ Weight : Factor w/ 57 levels "110lbs","115lbs",..: 22 33 18 26 20 24 16 36 32 37 ...
## $ 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 identifican dos variables numéricas de interés:
Overall: Reputación y jerarquía internacional numérica del jugador
Valor: Sería el valor económico internacional de los jugadores
Se define a la variable independiente como Overall y la variable dependiente Valor, es decir, Overall impacta sobre Value o los valores de la variable Valor dependen de Overall.
print ("Variable Overall")
## [1] "Variable Overall"
summary(datos$Overall)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 46.00 62.00 66.00 66.24 71.00 94.00
print ("Variable Valor que significa el valor económico del jugador en moneda Euros ")
## [1] "Variable Valor que significa el valor económico del jugador en moneda Euros "
summary(datos$Valor)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10000 325000 700000 2450133 2100000 118500000
kable(head(datos[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos. Primeros 20 registros")
| X | Name | Overall | Valor |
|---|---|---|---|
| 1 | L. Messi | 94 | 110500000 |
| 2 | Cristiano Ronaldo | 94 | 77000000 |
| 3 | Neymar Jr | 92 | 118500000 |
| 4 | De Gea | 91 | 72000000 |
| 5 | K. De Bruyne | 91 | 102000000 |
| 6 | E. Hazard | 91 | 93000000 |
| 7 | L. Modric | 91 | 67000000 |
| 8 | L. Suárez | 91 | 80000000 |
| 9 | Sergio Ramos | 91 | 51000000 |
| 10 | J. Oblak | 90 | 68000000 |
| 11 | R. Lewandowski | 90 | 77000000 |
| 12 | T. Kroos | 90 | 76500000 |
| 13 | D. Godín | 90 | 44000000 |
| 14 | David Silva | 90 | 60000000 |
| 15 | N. Kanté | 89 | 63000000 |
| 16 | P. Dybala | 89 | 89000000 |
| 17 | H. Kane | 89 | 83500000 |
| 18 | A. Griezmann | 89 | 78000000 |
| 19 | M. ter Stegen | 89 | 58000000 |
| 20 | T. Courtois | 89 | 53500000 |
tail(datos)
kable(head(datos[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos. Primeros 20 registros")
| X | Name | Overall | Valor |
|---|---|---|---|
| 1 | L. Messi | 94 | 110500000 |
| 2 | Cristiano Ronaldo | 94 | 77000000 |
| 3 | Neymar Jr | 92 | 118500000 |
| 4 | De Gea | 91 | 72000000 |
| 5 | K. De Bruyne | 91 | 102000000 |
| 6 | E. Hazard | 91 | 93000000 |
| 7 | L. Modric | 91 | 67000000 |
| 8 | L. Suárez | 91 | 80000000 |
| 9 | Sergio Ramos | 91 | 51000000 |
| 10 | J. Oblak | 90 | 68000000 |
| 11 | R. Lewandowski | 90 | 77000000 |
| 12 | T. Kroos | 90 | 76500000 |
| 13 | D. Godín | 90 | 44000000 |
| 14 | David Silva | 90 | 60000000 |
| 15 | N. Kanté | 89 | 63000000 |
| 16 | P. Dybala | 89 | 89000000 |
| 17 | H. Kane | 89 | 83500000 |
| 18 | A. Griezmann | 89 | 78000000 |
| 19 | M. ter Stegen | 89 | 58000000 |
| 20 | T. Courtois | 89 | 53500000 |
g <- plot_ly(data = datos,
x = ~Overall,
y = ~Valor) %>%
layout(title = 'Jugadores FIFA. Dispersión de Overall y Valor')
g
Se observa que la relación de los datos no es del todo lineal, pero se construirán los modelos de regresión lineal simple y polinómico con las mismas variables.
Sembrar semilla para la aleatoriedad de los datos
n <- nrow(datos)
# 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)
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$Valor, p = 0.70, list = FALSE, times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ] # [renglones, columna]
# Datos validación
datos.validacion <- datos[-entrena, ]
kable(head(datos.entrenamiento[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos de Entrenamiento. Primeros 20 registros")
| X | Name | Overall | Valor | |
|---|---|---|---|---|
| 1 | 1 | L. Messi | 94 | 110500000 |
| 2 | 2 | Cristiano Ronaldo | 94 | 77000000 |
| 3 | 3 | Neymar Jr | 92 | 118500000 |
| 4 | 4 | De Gea | 91 | 72000000 |
| 5 | 5 | K. De Bruyne | 91 | 102000000 |
| 6 | 6 | E. Hazard | 91 | 93000000 |
| 7 | 7 | L. Modric | 91 | 67000000 |
| 8 | 8 | L. Suárez | 91 | 80000000 |
| 9 | 9 | Sergio Ramos | 91 | 51000000 |
| 10 | 10 | J. Oblak | 90 | 68000000 |
| 12 | 12 | T. Kroos | 90 | 76500000 |
| 13 | 13 | D. Godín | 90 | 44000000 |
| 14 | 14 | David Silva | 90 | 60000000 |
| 16 | 16 | P. Dybala | 89 | 89000000 |
| 17 | 17 | H. Kane | 89 | 83500000 |
| 19 | 19 | M. ter Stegen | 89 | 58000000 |
| 21 | 21 | Sergio Busquets | 89 | 51500000 |
| 22 | 22 | E. Cavani | 89 | 60000000 |
| 26 | 26 | K. Mbappé | 88 | 81000000 |
| 27 | 27 | M. Salah | 88 | 69500000 |
kable(tail(datos.validacion[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos de Entrenamiento. Primeros 20 registros")
| X | Name | Overall | Valor | |
|---|---|---|---|---|
| 17853 | 17901 | R. Hughes | 49 | 60000 |
| 17854 | 17902 | J. Yabur | 49 | 50000 |
| 17857 | 17905 | Liu Guobo | 48 | 60000 |
| 17860 | 17908 | T. Lawal | 48 | 60000 |
| 17862 | 17910 | D. Szczepaniak | 48 | 50000 |
| 17863 | 17911 | P. Wieliczko | 48 | 40000 |
| 17864 | 17912 | T. Gundelund | 48 | 50000 |
| 17865 | 17913 | Wang Xin | 48 | 40000 |
| 17869 | 17917 | Wu Lei | 48 | 40000 |
| 17874 | 17922 | C. Hawkins | 48 | 50000 |
| 17878 | 17926 | T. Hillman | 48 | 40000 |
| 17880 | 17928 | L. Wahlstedt | 48 | 50000 |
| 17882 | 17930 | M. Hurst | 48 | 40000 |
| 17888 | 17936 | C. Ehlich | 47 | 40000 |
| 17890 | 17938 | A. Kaltner | 47 | 60000 |
| 17895 | 17943 | J. Milli | 47 | 50000 |
| 17896 | 17944 | S. Griffin | 47 | 60000 |
| 17903 | 17951 | J. Lundstram | 47 | 60000 |
| 17904 | 17952 | N. Christoffersson | 47 | 60000 |
| 17905 | 17953 | B. Worman | 47 | 60000 |
kable(head(datos.validacion[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos de Entrenamiento. Primeros 20 registros")
| X | Name | Overall | Valor | |
|---|---|---|---|---|
| 11 | 11 | R. Lewandowski | 90 | 77000000 |
| 15 | 15 | N. Kanté | 89 | 63000000 |
| 18 | 18 | A. Griezmann | 89 | 78000000 |
| 20 | 20 | T. Courtois | 89 | 53500000 |
| 23 | 23 | M. Neuer | 89 | 38000000 |
| 24 | 24 | S. Agüero | 89 | 64500000 |
| 25 | 25 | G. Chiellini | 89 | 27000000 |
| 41 | 41 | S. Handanovic | 88 | 30000000 |
| 42 | 42 | G. Buffon | 88 | 4000000 |
| 43 | 43 | S. Umtiti | 87 | 57000000 |
| 45 | 45 | K. Koulibaly | 87 | 51000000 |
| 51 | 51 | D. Mertens | 87 | 45000000 |
| 53 | 53 | M. Hamšík | 87 | 46500000 |
| 55 | 55 | Piqué | 87 | 34000000 |
| 58 | 58 | Ederson | 86 | 41500000 |
| 59 | 59 | S. Mané | 86 | 52000000 |
| 67 | 67 | T. Müller | 86 | 45000000 |
| 68 | 68 | Thiago | 86 | 45500000 |
| 72 | 72 | T. Alderweireld | 86 | 39000000 |
| 74 | 74 | M. Benatia | 86 | 30000000 |
kable(tail(datos.entrenamiento[, c('X', 'Name', 'Overall', 'Valor')], 20), caption = "Datos de Entrenamiento. Primeros 20 registros")
| X | Name | Overall | Valor | |
|---|---|---|---|---|
| 17879 | 17927 | R. Roache | 48 | 70000 |
| 17881 | 17929 | J. Williams | 48 | 50000 |
| 17883 | 17931 | C. Maher | 48 | 50000 |
| 17884 | 17932 | Y. Góez | 48 | 50000 |
| 17885 | 17933 | D. Horton | 48 | 40000 |
| 17886 | 17934 | E. Tweed | 48 | 50000 |
| 17887 | 17935 | Zhang Yufeng | 47 | 60000 |
| 17889 | 17937 | L. Collins | 47 | 60000 |
| 17891 | 17939 | L. Watkins | 47 | 60000 |
| 17892 | 17940 | J. Norville-Williams | 47 | 50000 |
| 17893 | 17941 | S. Squire | 47 | 50000 |
| 17894 | 17942 | N. Fuentes | 47 | 50000 |
| 17897 | 17945 | K. Fujikawa | 47 | 60000 |
| 17898 | 17946 | D. Holland | 47 | 60000 |
| 17899 | 17947 | J. Livesey | 47 | 60000 |
| 17900 | 17948 | M. Baldisimo | 47 | 70000 |
| 17901 | 17949 | J. Young | 47 | 60000 |
| 17902 | 17950 | D. Walsh | 47 | 60000 |
| 17906 | 17954 | D. Walker-Rice | 47 | 60000 |
| 17907 | 17955 | G. Nugent | 46 | 60000 |
modelo.ls <- lm(formula = Valor ~ Overall, data = datos.entrenamiento)
modelo.ls
##
## Call:
## lm(formula = Valor ~ Overall, data = datos.entrenamiento)
##
## Coefficients:
## (Intercept) Overall
## -32561108 529109
Se determinan los valores de a y b de la fórmula \(Y = a+bx\)
a <- modelo.ls$coefficients[1]
b <- modelo.ls$coefficients[2]
paste("Valor de la abcisa a es : ", round(a, 6))
## [1] "Valor de la abcisa a es : -32561107.927016"
paste("Valor de la pendiente b es: ", round(b, 6))
## [1] "Valor de la pendiente b es: 529109.218444"
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 = ~Overall,
y = ~Valor,
name = 'Dispersión',
type = 'scatter',
mode = 'markers',
color = I('blue'))
g <- g %>% add_trace(x = ~Overall,
y = ~modelo.ls$fitted.values, name = 'Tendencia', mode = 'lines+markers', color = I('red'))
g <- g %>%
layout(title = 'Jugadores FIFA. Dispersión y Tendencia de Overall y Valor económico.')
g
Con los datos de validación, se hacen predicciones con la función predict().
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.ls, newdata = datos.validacion)
comparaciones <- data.frame(Overall = datos.validacion$Overall, Valor = datos.validacion$Valor, predicccion = predicciones)
kable(x = head(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 11 | 90 | 77000000 | 15058722 |
| 15 | 89 | 63000000 | 14529613 |
| 18 | 89 | 78000000 | 14529613 |
| 20 | 89 | 53500000 | 14529613 |
| 23 | 89 | 38000000 | 14529613 |
| 24 | 89 | 64500000 | 14529613 |
| 25 | 89 | 27000000 | 14529613 |
| 41 | 88 | 30000000 | 14000503 |
| 42 | 88 | 4000000 | 14000503 |
| 43 | 87 | 57000000 | 13471394 |
| 45 | 87 | 51000000 | 13471394 |
| 51 | 87 | 45000000 | 13471394 |
| 53 | 87 | 46500000 | 13471394 |
| 55 | 87 | 34000000 | 13471394 |
| 58 | 86 | 41500000 | 12942285 |
| 59 | 86 | 52000000 | 12942285 |
| 67 | 86 | 45000000 | 12942285 |
| 68 | 86 | 45500000 | 12942285 |
| 72 | 86 | 39000000 | 12942285 |
| 74 | 86 | 30000000 | 12942285 |
kable(x = tail(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 17853 | 49 | 60000 | -6634756 |
| 17854 | 49 | 50000 | -6634756 |
| 17857 | 48 | 60000 | -7163865 |
| 17860 | 48 | 60000 | -7163865 |
| 17862 | 48 | 50000 | -7163865 |
| 17863 | 48 | 40000 | -7163865 |
| 17864 | 48 | 50000 | -7163865 |
| 17865 | 48 | 40000 | -7163865 |
| 17869 | 48 | 40000 | -7163865 |
| 17874 | 48 | 50000 | -7163865 |
| 17878 | 48 | 40000 | -7163865 |
| 17880 | 48 | 50000 | -7163865 |
| 17882 | 48 | 40000 | -7163865 |
| 17888 | 47 | 40000 | -7692975 |
| 17890 | 47 | 60000 | -7692975 |
| 17895 | 47 | 50000 | -7692975 |
| 17896 | 47 | 60000 | -7692975 |
| 17903 | 47 | 60000 | -7692975 |
| 17904 | 47 | 60000 | -7692975 |
| 17905 | 47 | 60000 | -7692975 |
¡Salen predicciones negativas!, ¿que significa? , no debiera haber predicciones negativas, sin embargo, esto sucede porque el modelo así lo calcula por lo estricto de la linea de tendencia.
res.modelo.ls <- summary(modelo.ls)
res.modelo.ls
##
## Call:
## lm(formula = Valor ~ Overall, data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9325848 -2192974 -926882 1064555 102383060
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -32561108 393188 -82.81 <2e-16 ***
## Overall 529109 5904 89.62 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4594000 on 12535 degrees of freedom
## Multiple R-squared: 0.3905, Adjusted R-squared: 0.3905
## F-statistic: 8031 on 1 and 12535 DF, p-value: < 2.2e-16
El coeficiente de interseción ‘a’ y la pendiente ‘b’ si son estadísticamente significativas por encima del 99.9%
El valor de R Square no sobrepasa el 50% por lo que NO SE ACEPTA el modelo
El valor de rmse se interpreta en que tanto se desvía una predicción media sobre los valore reales.
rmse.ls <- rmse(actual =comparaciones$Valor, predicted = comparaciones$predicccion)
rmse.ls
## [1] 3790297
El valor de rmse en el modelo de regresión lineal simple no está por debajo de los 2,000,000 (dos millones) que se establecieron como métrica aceptable, por lo que este modelo NO SE ACEPTA.
Se usa el argumento poly “poly(Overall, 2)” en la construcción del modelo para indicar que es polinomial de segunda potencia.
\[ y = β0 + β1{x_i} +β2{x_i}^2+β3{x_i}^3...+βd{x_i}^n+ϵi \]
ó
\[ y = a + bx + cx^2 + dx^3 ...zx^n \]
modelo.poly2 <- lm(formula = Valor ~ poly(Overall, 2), data = datos.entrenamiento, )
modelo.poly2
##
## Call:
## lm(formula = Valor ~ poly(Overall, 2), data = datos.entrenamiento)
##
## Coefficients:
## (Intercept) poly(Overall, 2)1 poly(Overall, 2)2
## 2483040 411719109 401465284
Se determinan los valores de a y b de la fórmula \(Y = a+bx\)
a <- modelo.poly2$coefficients[1]
b <- modelo.poly2$coefficients[2]
paste("Valor de la abcisa a es : ", round(a, 6))
## [1] "Valor de la abcisa a es : 2483040.201005"
paste("Valor de la pendiente b es: ", round(b, 6))
## [1] "Valor de la pendiente b es: 411719108.763639"
Con la el valor de los valores de tendencia o valores ajustados del modelo se visualiza la curva de tendencia del modelo.
La gráfica g se construye por partes, primero la dispersión, segundo la curva de tendencia, tercero se agrega el título, para luego solo mostrar la gráfica g.
g <- plot_ly(data = datos.entrenamiento,
x = ~Overall,
y = ~Valor,
name = 'Dispersión',
type = 'scatter',
mode = 'markers',
color = I('blue'))
g <- g %>% add_trace(x = ~Overall,
y = ~modelo.poly2$fitted.values, name = 'Tendencia', mode = 'lines+markers', color = I('red'))
g <- g %>%
layout(title = 'Jugadores FIFA. Dispersión y Tendencia de Overall y Valor económico.')
g
Con los datos de validación, se hacen predicciones con la función predict().
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.poly2, newdata = datos.validacion)
comparaciones <- data.frame(Overall = datos.validacion$Overall, Valor = datos.validacion$Valor, predicccion = predicciones)
kable(x = head(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 11 | 90 | 77000000 | 40693279 |
| 15 | 89 | 63000000 | 37820662 |
| 18 | 89 | 78000000 | 37820662 |
| 20 | 89 | 53500000 | 37820662 |
| 23 | 89 | 38000000 | 37820662 |
| 24 | 89 | 64500000 | 37820662 |
| 25 | 89 | 27000000 | 37820662 |
| 41 | 88 | 30000000 | 35050059 |
| 42 | 88 | 4000000 | 35050059 |
| 43 | 87 | 57000000 | 32381470 |
| 45 | 87 | 51000000 | 32381470 |
| 51 | 87 | 45000000 | 32381470 |
| 53 | 87 | 46500000 | 32381470 |
| 55 | 87 | 34000000 | 32381470 |
| 58 | 86 | 41500000 | 29814896 |
| 59 | 86 | 52000000 | 29814896 |
| 67 | 86 | 45000000 | 29814896 |
| 68 | 86 | 45500000 | 29814896 |
| 72 | 86 | 39000000 | 29814896 |
| 74 | 86 | 30000000 | 29814896 |
kable(x = tail(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 17853 | 49 | 60000 | 6567594 |
| 17854 | 49 | 50000 | 6567594 |
| 17857 | 48 | 60000 | 7877558 |
| 17860 | 48 | 60000 | 7877558 |
| 17862 | 48 | 50000 | 7877558 |
| 17863 | 48 | 40000 | 7877558 |
| 17864 | 48 | 50000 | 7877558 |
| 17865 | 48 | 40000 | 7877558 |
| 17869 | 48 | 40000 | 7877558 |
| 17874 | 48 | 50000 | 7877558 |
| 17878 | 48 | 40000 | 7877558 |
| 17880 | 48 | 50000 | 7877558 |
| 17882 | 48 | 40000 | 7877558 |
| 17888 | 47 | 40000 | 9289535 |
| 17890 | 47 | 60000 | 9289535 |
| 17895 | 47 | 50000 | 9289535 |
| 17896 | 47 | 60000 | 9289535 |
| 17903 | 47 | 60000 | 9289535 |
| 17904 | 47 | 60000 | 9289535 |
| 17905 | 47 | 60000 | 9289535 |
res.modelo.poly2 <- summary(modelo.poly2)
res.modelo.poly2
##
## Call:
## lm(formula = Valor ~ poly(Overall, 2), data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20787789 -957976 379606 1274866 71755444
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2483040 25651 96.8 <2e-16 ***
## poly(Overall, 2)1 411719109 2872143 143.3 <2e-16 ***
## poly(Overall, 2)2 401465284 2872143 139.8 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2872000 on 12534 degrees of freedom
## Multiple R-squared: 0.7618, Adjusted R-squared: 0.7618
## F-statistic: 2.004e+04 on 2 and 12534 DF, p-value: < 2.2e-16
El coeficiente de interseción ‘a’ y la pendiente ‘b’ si son estadísticamente significativas por encima del 99.9%
El valor de R Square SI sobrepasa el 50% por lo que SI SE ACEPTA el modelo
El valor de rmse se interpreta en que tanto se desvía una predicción media sobre los valore reales.
rmse.poly2 <- rmse(actual =comparaciones$Valor, predicted = comparaciones$predicccion)
rmse.poly2
## [1] 2399261
El valor de rmse en el modelo de regresión lineal simple no está por debajo de los 2,000,000 (dos millones) que se establecieron como métrica aceptable, por lo que este modelo NO SE ACEPTA por esta métrica.
Se usa el argumento poly “poly(Overall, 5)” en la construcción del modelo para indicar que es polinomial de segunda potencia.
\[ y = β0 + β1{x_i} +β2{x_i}^2+β3{x_i}^3…+βd{x_i}^n+ϵi \]
y = β0 + β1{x_i} +β2{x_i}2+β3{x_i}3…+βd{x_i}^n+ϵi
ó
\[ y = a + bx + cx^2 + dx^3 …zx^n \]
modelo.poly5 <- lm(formula = Valor ~ poly(Overall, 5), data = datos.entrenamiento, )
modelo.poly5
##
## Call:
## lm(formula = Valor ~ poly(Overall, 5), data = datos.entrenamiento)
##
## Coefficients:
## (Intercept) poly(Overall, 5)1 poly(Overall, 5)2 poly(Overall, 5)3
## 2483040 411719109 401465284 240065754
## poly(Overall, 5)4 poly(Overall, 5)5
## 73300131 4422343
Se determinan los valores de a y b de la fórmula \(Y = a+bx\)
a <- modelo.poly5$coefficients[1]
b <- modelo.poly5$coefficients[2]
paste("Valor de la abcisa a es : ", round(a, 6))
## [1] "Valor de la abcisa a es : 2483040.201005"
paste("Valor de la pendiente b es: ", round(b, 6))
## [1] "Valor de la pendiente b es: 411719108.763635"
Con la el valor de los valores de tendencia o valores ajustados del modelo se visualiza la curva de tendencia del modelo.
La gráfica g se construye por partes, primero la dispersión, segundo la curva de tendencia, tercero se agrega el título, para luego solo mostrar la gráfica g.
g <- plot_ly(data = datos.entrenamiento,
x = ~Overall,
y = ~Valor,
name = 'Dispersión',
type = 'scatter',
mode = 'markers',
color = I('blue'))
g <- g %>% add_trace(x = ~Overall,
y = ~modelo.poly5$fitted.values, name = 'Tendencia', mode = 'lines+markers', color = I('red'))
g <- g %>%
layout(title = 'Jugadores FIFA. Dispersión y Tendencia de Overall y Valor económico.')
g
Con los datos de validación, se hacen predicciones con la función predict().
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.poly5, newdata = datos.validacion)
comparaciones <- data.frame(Overall = datos.validacion$Overall, Valor = datos.validacion$Valor, predicccion = predicciones)
kable(x = head(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 11 | 90 | 77000000 | 69316050 |
| 15 | 89 | 63000000 | 60933762 |
| 18 | 89 | 78000000 | 60933762 |
| 20 | 89 | 53500000 | 60933762 |
| 23 | 89 | 38000000 | 60933762 |
| 24 | 89 | 64500000 | 60933762 |
| 25 | 89 | 27000000 | 60933762 |
| 41 | 88 | 30000000 | 53359828 |
| 42 | 88 | 4000000 | 53359828 |
| 43 | 87 | 57000000 | 46537655 |
| 45 | 87 | 51000000 | 46537655 |
| 51 | 87 | 45000000 | 46537655 |
| 53 | 87 | 46500000 | 46537655 |
| 55 | 87 | 34000000 | 46537655 |
| 58 | 86 | 41500000 | 40413068 |
| 59 | 86 | 52000000 | 40413068 |
| 67 | 86 | 45000000 | 40413068 |
| 68 | 86 | 45500000 | 40413068 |
| 72 | 86 | 39000000 | 40413068 |
| 74 | 86 | 30000000 | 40413068 |
kable(x = tail(comparaciones, 20), caption = "Predicciones")
| Overall | Valor | predicccion | |
|---|---|---|---|
| 17853 | 49 | 60000 | 90553.05 |
| 17854 | 49 | 50000 | 90553.05 |
| 17857 | 48 | 60000 | 166366.43 |
| 17860 | 48 | 60000 | 166366.43 |
| 17862 | 48 | 50000 | 166366.43 |
| 17863 | 48 | 40000 | 166366.43 |
| 17864 | 48 | 50000 | 166366.43 |
| 17865 | 48 | 40000 | 166366.43 |
| 17869 | 48 | 40000 | 166366.43 |
| 17874 | 48 | 50000 | 166366.43 |
| 17878 | 48 | 40000 | 166366.43 |
| 17880 | 48 | 50000 | 166366.43 |
| 17882 | 48 | 40000 | 166366.43 |
| 17888 | 47 | 40000 | 286125.28 |
| 17890 | 47 | 60000 | 286125.28 |
| 17895 | 47 | 50000 | 286125.28 |
| 17896 | 47 | 60000 | 286125.28 |
| 17903 | 47 | 60000 | 286125.28 |
| 17904 | 47 | 60000 | 286125.28 |
| 17905 | 47 | 60000 | 286125.28 |
res.modelo.poly5 <- summary(modelo.poly5)
res.modelo.poly5
##
## Call:
## lm(formula = Valor ~ poly(Overall, 5), data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -35147491 -168569 531 156431 29755608
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2483040 16030 154.894 <2e-16 ***
## poly(Overall, 5)1 411719109 1794919 229.380 <2e-16 ***
## poly(Overall, 5)2 401465284 1794919 223.668 <2e-16 ***
## poly(Overall, 5)3 240065754 1794919 133.747 <2e-16 ***
## poly(Overall, 5)4 73300131 1794919 40.838 <2e-16 ***
## poly(Overall, 5)5 4422343 1794919 2.464 0.0138 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1795000 on 12531 degrees of freedom
## Multiple R-squared: 0.907, Adjusted R-squared: 0.907
## F-statistic: 2.444e+04 on 5 and 12531 DF, p-value: < 2.2e-16
El coeficiente de interseción ‘a’ y la pendiente ‘b’ si son estadísticamente significativas por encima del 95%
El valor de R Square SI sobrepasa el 50% por lo que SI SE ACEPTA el modelo
El valor de rmse se interpreta en que tanto se desvía una predicción media sobre los valore reales.
rmse.poly5 <- rmse(actual =comparaciones$Valor, predicted = comparaciones$predicccion)
rmse.poly5
## [1] 1717544
El valor de rmse en el modelo de regresión lineal simple SI está por debajo de los 2,000,000 (dos millones) que se establecieron como métrica aceptable, por lo que este modelo SI SE ACEPTA.
Pendiente …