Analizar caso FIFA mediante un modelo de regresión lienal simple
Determinar modelo de regresión lineal simple para establecer un análisi en el conjunto de datos del caso FIFA
Cargar librerías Cargar los datos Determinar variable independiente y dependiente Limpiar los datos Partir el conjunto de datos en datos de entrenamiento y datos de validción 70%, 30% Determinar el modelo de regresión lineal simple Evaluar el modelo. Interpretación Linea de tendencia Determinar predicciones
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) # Para particionar datos
## Warning: package 'caret' was built under R version 4.0.3
## Loading required package: lattice
datos.FIFA <- read.csv('C:/Users/Blue/Documents/fifa.csv', encoding = "UTF-8")
datos <- select(datos.FIFA, Overall, Value)
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"
Primero cargar la función
source('C:/Users/Blue/Documents/funciones.R')
Limpiar el datos de Value convertirlo a numérico
datos <- datos %>%
mutate(Valor = ifelse (substr(Value, nchar(Value), nchar(Value)) == 'M', fcleanValue(Value) * 1000000, fcleanValue(Value) * 1000)) %>%
filter(Valor > 0)
Quitar los de valor =0 o solo dejar los que tengan Valor
datos <- filter(datos, Valor > 0)
Ver los primeros diez y últimos diez registros
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
Visualizar la dispersión de los datos
ggplot(datos, aes(x = Overall, y = Valor)) +
geom_point()
De acuerdo la gráfica se aprecia una relación en forma de curva y no precisamente lineal, pero a pesar de ello, se construirá un modelo de regresión lineal simple con estas dos variables.
# 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
Para cuestión de interpetación se determina el coeficiente de correlación entre las varibles Overall y Valor del conjunto de datos Además una prueba de hipótesis para descartar que la correlación es diferente de 0
correla <- cor(x = datos.entrenamiento$Overall, y = datos.entrenamiento$Valor, method = "pearson")
correla
## [1] 0.6252835
cor.test(datos.entrenamiento$Overall, datos.entrenamiento$Valor)
##
## Pearson's product-moment correlation
##
## data: datos.entrenamiento$Overall and datos.entrenamiento$Valor
## t = 89.821, df = 12567, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6145185 0.6358156
## sample estimates:
## cor
## 0.6252835
Ahora determinar el coeficiente de determinación R2 o R Square o Multiple R-squared: en el modelo de regresión lineal que se construye más adelante.
CR <- correla ^ 2
CR
## [1] 0.3909794
El Coefiente de Correlación en la regresión lineal significa responder a la pregunta: ¿qué porcentaje de la variación total en Y se debe a la variación en X?, en otras palabras, cual es la proporción de la variación total en Y que puede ser explicada por la variación en X? (https://rpubs.com/osoramirez/316691)
Para este caso signifca que Overall explica el 39.1% del Valor económico del jugador . Tal vez no es representativo la variable Overall sobre el Valor económico del jugador. Habrá que buscar otra variable diferente a Overall que explique más o se tenga un valor mayor a 39.1%
Ya que se tienen el conjunto de datos de entrenamiento, sobre ese conjunto de datos construir el modelo
modelo <- lm(formula = Valor ~ Overall, data = datos.entrenamiento)
summary(modelo)
##
## Call:
## lm(formula = Valor ~ Overall, data = datos.entrenamiento)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9583770 -2104319 -889593 1030270 102871367
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -31403214 378886 -82.88 <0.0000000000000002 ***
## Overall 511216 5692 89.82 <0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4434000 on 12567 degrees of freedom
## Multiple R-squared: 0.391, Adjusted R-squared: 0.3909
## F-statistic: 8068 on 1 and 12567 DF, p-value: < 0.00000000000000022
par(mfrow = c(2, 2))
plot(modelo)
Residual vs Fitted: Deberia estar distribuidos aleatoriamente alrededor de la linea horizontal que representa un error residual de cero
Normal Q-Q: deberia sugerir que los errores residuales se distribuyen normalmente.
Scale-Location Muestra la raiz cuadrada de los residuos estandarizados, como una funcion de los valores ajustados. No deberia existir una tendencia clara en ese trama.
Residual vs Leverage Las distancias mas grandes que 1 son sospechosos y sugieren la presencia de un valor atipico posible y su eliminacion podria tener efectos sobre la regresion. (https://rpubs.com/osoramirez/316691)
Linea de tendencia con ggplot()
ggplot(data = datos, mapping = aes(x = Overall, y = Valor)) +
geom_point(color = "firebrick", size = 2) +
labs(title = 'Valor ~ Overall', x = 'Overall') +
geom_smooth(method = "lm", se = FALSE, color = "black") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
## `geom_smooth()` using formula 'y ~ x'
Precisamente se observa que no hay del todo una relación lineal
Algunas predicciones con el conjunto de datos de validación usando el modelo Predecir conforme a la fórmula y=a+bx a = -31403213.910327 b = 511215.7312696
paste("Valor de a = ", modelo$coefficients[1])
## [1] "Valor de a = -31403213.910327"
paste("Valor de b = ", modelo$coefficients[2])
## [1] "Valor de b = 511215.731269587"
Por cada unidad de Overall en el jugador el valor de Y aumenta 511215.7312696 veces Con head() y tail(), verificar algunas predicciones
prediccion <- predict(modelo, newdata = datos.validacion)
#head(prediccion, 10); tail(prediccion, 10)
Agregar a datos de validación una columna con las predicciones construidas para comparar
datos.validacion <- mutate(datos.validacion, predicho = prediccion)
head(datos.validacion, 10)
## Overall Value Valor predicho
## 1 91 \20072M 72000000 15117418
## 2 91 \20051M 51000000 15117418
## 3 90 \20068M 68000000 14606202
## 4 89 \20089M 89000000 14094986
## 5 89 \20060M 60000000 14094986
## 6 89 \20038M 38000000 14094986
## 7 89 \20027M 27000000 14094986
## 8 88 \20069.5M 69500000 13583770
## 9 88 \20062M 62000000 13583770
## 10 88 \20073.5M 73500000 13583770
tail(datos.validacion, 10)
## Overall Value Valor predicho
## 5377 48 \20020K 20000 -6864859
## 5378 48 \20060K 60000 -6864859
## 5379 48 \20040K 40000 -6864859
## 5380 47 \20040K 40000 -7376075
## 5381 47 \20050K 50000 -7376075
## 5382 47 \20060K 60000 -7376075
## 5383 47 \20060K 60000 -7376075
## 5384 47 \20070K 70000 -7376075
## 5385 47 \20060K 60000 -7376075
## 5386 47 \20060K 60000 -7376075