Objetivo

Analizar caso FIFA mediante un modelo de regresión polinomial con las variables Overall y Value del conjunto de datos.

Descripción

Determinar modelo de regresión plinomial de segundo y tal vez de trecer o cuarto nivel para establecer un análisi en el conjunto de datos del caso FIFA y comparar con el modelo de regresión lineal simple

Fundamento teórico. Regresión Polinomial

Los modelos lineales tienen la ventaja de ser fácilmente interpretables, sin embargo, pueden tener limitaciones importantes en capacidad predictiva. Esto se debe a que, la asunción de linealidad, es con frecuencia una aproximación demasiado simple para describir las relaciones reales entre variables. A continuación, se describen métodos que permiten relajar la condición de linealidad intentando mantener al mismo tiempo una interpretabilidad alta.

La forma más sencilla de incorporar flexibilidad a un modelo lineal es introduciendo nuevos predictores obtenidos al elevar a distintas potencias el predictor original.

Partiendo del modelo lineal:

y=β0+β1xi+ϵi

###Ahora el modelo polinómico: ## y=β0+β1xi2+β3xi3+…+βdxdin+ϵi

Proceso

1. Cargar librerías

library(readr)
library(dplyr)
## 
## 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(ggplot2)
library(caret) 
## Warning: package 'caret' was built under R version 4.0.3
## Loading required package: lattice

2. Cargar los datos

datos.FIFA <- read.csv("../datos/data.csv", encoding = "UTF-8")


datos <- select(datos.FIFA, Overall, Value)

3. Determinar variable independiente y dependiente

print("La variable 'x' independiente es Overall que significa como se valora en su totalidad un jugador")
## [1] "La variable 'x' independiente es Overall que significa como se valora en su totalidad un jugador"
print("La variable 'y' dependiente es Value character que será Valor en formato  numérico que significa el valor económico de un jugador")
## [1] "La variable 'y' dependiente es Value character que será Valor en formato  numérico que significa el valor económico de un jugador"

4. Limpiar los datos

source("https://raw.githubusercontent.com/rpizarrog/FundamentosMachineLearning/master/scripts/misfunciones.r")
datos <- datos %>%
  mutate(Valor = ifelse (substr(Value, nchar(Value), nchar(Value)) == 'M', fcleanValue(Value) * 1000000, fcleanValue(Value) * 1000)) %>%
  filter(Valor > 0)
head(datos, 10); tail(datos, 10)
##    Overall   Value     Valor
## 1       94 \200110.5M 110500000
## 2       94    \20077M  77000000
## 3       92 \200118.5M 118500000
## 4       91    \20072M  72000000
## 5       91   \200102M 102000000
## 6       91    \20093M  93000000
## 7       91    \20067M  67000000
## 8       91    \20080M  80000000
## 9       91    \20051M  51000000
## 10      90    \20068M  68000000
##       Overall Value Valor
## 17946      47  \20060K 60000
## 17947      47  \20060K 60000
## 17948      47  \20070K 70000
## 17949      47  \20060K 60000
## 17950      47  \20060K 60000
## 17951      47  \20060K 60000
## 17952      47  \20060K 60000
## 17953      47  \20060K 60000
## 17954      47  \20060K 60000
## 17955      46  \20060K 60000
ggplot(datos, aes(x = Overall, y = Valor)) +
    geom_point()

5. Partir el conjunto de datos en datos de entrenamiento y datos de validación 70%, 30%

# entrena <- 70%
# valida <- 30%
set.seed(2020)
entrena <- createDataPartition(y = datos$Valor, p = 0.7, list = FALSE, times = 1)

# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ]  # [renglones, columna]

# Datos validación
datos.validacion <- datos[-entrena, ]

head(datos.entrenamiento, 10)
##    Overall   Value     Valor
## 1       94 \200110.5M 110500000
## 2       94    \20077M  77000000
## 3       92 \200118.5M 118500000
## 5       91   \200102M 102000000
## 6       91    \20093M  93000000
## 7       91    \20067M  67000000
## 8       91    \20080M  80000000
## 11      90    \20077M  77000000
## 12      90  \20076.5M  76500000
## 13      90    \20044M  44000000
head(datos.validacion, 10)
##    Overall  Value    Valor
## 4       91   \20072M 72000000
## 9       91   \20051M 51000000
## 10      90   \20068M 68000000
## 16      89   \20089M 89000000
## 22      89   \20060M 60000000
## 23      89   \20038M 38000000
## 25      89   \20027M 27000000
## 29      88 \20069.5M 69500000
## 30      88   \20062M 62000000
## 31      88 \20073.5M 73500000

Modelo a la segunda potencia

modelo2 <- lm(formula = Valor ~ poly(Overall, 2), data = datos.entrenamiento)

summary(modelo2)
## 
## Call:
## lm(formula = Valor ~ poly(Overall, 2), data = datos.entrenamiento)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -30095610   -930187    382964   1222718  73081882 
## 
## Coefficients:
##                    Estimate Std. Error t value            Pr(>|t|)    
## (Intercept)         2442774      25076   97.41 <0.0000000000000002 ***
## poly(Overall, 2)1 398229563    2811332  141.65 <0.0000000000000002 ***
## poly(Overall, 2)2 384331743    2811332  136.71 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2811000 on 12566 degrees of freedom
## Multiple R-squared:  0.7551, Adjusted R-squared:  0.7551 
## F-statistic: 1.938e+04 on 2 and 12566 DF,  p-value: < 0.00000000000000022

y=β0+β1xi2ϵi

Modelo a la potencia de 4

modelo4 <- lm(formula = Valor ~ poly(Overall, 4), data = datos.entrenamiento)

summary(modelo4)
## 
## Call:
## lm(formula = Valor ~ poly(Overall, 4), data = datos.entrenamiento)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -48804991   -198589      3451    151184  31310143 
## 
## Coefficients:
##                    Estimate Std. Error t value            Pr(>|t|)    
## (Intercept)         2442774      16071  152.00 <0.0000000000000002 ***
## poly(Overall, 4)1 398229563    1801739  221.03 <0.0000000000000002 ***
## poly(Overall, 4)2 384331743    1801739  213.31 <0.0000000000000002 ***
## poly(Overall, 4)3 230674298    1801739  128.03 <0.0000000000000002 ***
## poly(Overall, 4)4  72936931    1801739   40.48 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1802000 on 12564 degrees of freedom
## Multiple R-squared:  0.8994, Adjusted R-squared:  0.8994 
## F-statistic: 2.81e+04 on 4 and 12564 DF,  p-value: < 0.00000000000000022

y=β0+β1xi2β1xi3+β1xi4ϵi

7. Visualizar tendencia

ggplot() + 
  geom_point(data = datos, aes(x = Overall, y = Valor)) + geom_line(aes( x = datos$Overall, y = predict(modelo2, datos)), color = "red")

ggplot() + 
  geom_point(data = datos, aes(x = Overall, y = Valor)) + geom_line(aes( x = datos$Overall, y = predict(modelo4, datos)), color = "darkred")

9. Determinar predicciones

y=β0+β1xi2+β3xi3+…+βdxdin+ϵi

# paste("Valor de b0 = ", modelo2$coefficients[1])
# paste("Valor de b1 = ", modelo2$coefficients[2])

Predicciones con modelo2

prediccion <- predict(modelo2, newdata = datos.validacion)
# head(prediccion, 10); tail(prediccion, 10)
new.datos.validacion <- mutate(datos.validacion, predicho2 = prediccion)

# head(new.datos.validacion, 10)
# tail(new.datos.validacion, 10)

Predicciones con modelo4

prediccion <- predict(modelo4, newdata = datos.validacion)
# head(prediccion, 10); tail(prediccion, 10)
new.datos.validacion <- mutate(new.datos.validacion, predicho4 = prediccion)

head(new.datos.validacion, 10)
##    Overall  Value    Valor predicho2 predicho4
## 1       91   \20072M 72000000  42439871  77346260
## 2       91   \20051M 51000000  42439871  77346260
## 3       90   \20068M 68000000  39560037  68369009
## 4       89   \20089M 89000000  36778617  60205554
## 5       89   \20060M 60000000  36778617  60205554
## 6       89   \20038M 38000000  36778617  60205554
## 7       89   \20027M 27000000  36778617  60205554
## 8       88 \20069.5M 69500000  34095610  52804991
## 9       88   \20062M 62000000  34095610  52804991
## 10      88 \20073.5M 73500000  34095610  52804991
tail(new.datos.validacion, 10)
##      Overall Value Valor predicho2 predicho4
## 5377      48  \20020K 20000   7474373  461573.5
## 5378      48  \20060K 60000   7474373  461573.5
## 5379      48  \20040K 40000   7474373  461573.5
## 5380      47  \20040K 40000   8826318  760339.0
## 5381      47  \20050K 50000   8826318  760339.0
## 5382      47  \20060K 60000   8826318  760339.0
## 5383      47  \20060K 60000   8826318  760339.0
## 5384      47  \20070K 70000   8826318  760339.0
## 5385      47  \20060K 60000   8826318  760339.0
## 5386      47  \20060K 60000   8826318  760339.0

10. Interpretación del caso

Describir de 180 a 200 palabras

¿Cuáles son las variables independientes y dependientes del caso y qué significan (b0 & b1)?

Son Overall o el desempeño general del jugador y Value o el valor económico del jugador. b0 y b1 son los parametros poblacionales de nuestros datos.

¿Cuál es valor del coeficiente de correlación R Square y R Square adjusted en el modelo?

Son .75 y .75

¿Cuál es el valor de b0 y b1 en la ecuación de regresión a la potencia 2, 3, 4 o 6 y=β0+β1xi2+β3xi3+…+βdxdin+ϵi y qué significa?

b0 es la ordenada al origen o cuánto es Y cuando X es 0 y b1 la pendiente o cuánto aumenta Y por cada aumento de X.

¿Qué tan bien predice el modelo?

Vemos que la predicción se mejora a medida que se aumentan las potencias de los parametros extras. En la cuarta potencia vemos como la tendencia de los datos predecidos se asimilan a los reales.

Es el modelo de regresión lineal polinómico adecuado para predecir el valor económico del jugador basado únicamente en la variable Overall? ¿Que comparación se tienen con el modelo lineal en estas dos variables Overall y Value?

Observamos que los datos no se comportan linealmente como tal, más bien tienden a estar en curva y se asemejan a una curva polinómica. Muestra mucho mejor la relación del Valor del jugador conforme a su desempeño en esta regresión polinómica.