Regresión logística sobre datos de futbolistas en la temporada 23/24, aplicando metodología data science

Objetivo

El objetivo de este análisis es realizar una predicción usando modelos de regresión logística sobre datos existentes de futbolistas, alojados en la web de TransferMarkt y obtenidos el 02/06/24, es por lo que los modelos serán supervisados.

PROBABILIDAD DE QUE UN FUTBOLISTA ANOTE UN GOL

FASE 1: PREPARACION DE LOS DATOS

A. Carga de Datos

Conexión a la base de datos y obtención de datos; dentro del script SQL se detalla el proceso de limpieza de valores faltantes:

# Cargamos la libreria necesaria

library(odbc)

# Ejecutamos una funcion para conectar a la base de datos

connect_to_db <- function(driver, server, database) {
  connection_string <- paste0("Driver={", driver, "};Server=", server, ";Database=", database, ";Trusted_Connection=yes;")
  dbConnect(odbc::odbc(), .connection_string = connection_string)
}

# Conectamos a la base de datos

conn <- connect_to_db("ODBC Driver 17 for SQL Server", "LAPTOP-P7645H6F", "TransferMarkt")

# Ejecutamos la consulta SQL

query <- "
WITH inicial AS
  (
SELECT 
  player_id,
  game_id,
  yellow_cards,
  red_cards,
  goals,
  assists,
  minutes_played
FROM 
  dbo.appearances_fct 
WHERE 
  date BETWEEN '20230107' AND '20240630' -- FILTRAMOS DATOS POR LA ULTIMA TEMPORADA
  ),
    tabla1 AS
  (
SELECT 
  DISTINCT (player_id),
  COUNT(game_id) OVER (PARTITION BY player_id) AS partidos_jugados,
  SUM (yellow_cards) OVER (PARTITION BY player_id) AS tarj_amarillas,
  SUM (red_cards) OVER (PARTITION BY player_id) AS tarj_rojas,
  SUM (goals) OVER (PARTITION BY player_id) AS goles,
  SUM (assists) OVER (PARTITION BY player_id) AS asistencias,
  SUM (minutes_played) OVER (PARTITION BY player_id) AS minutos_jugados
FROM
 inicial
 )
SELECT 
T1.player_id,
-- PARA LA MANIPULACION DE DATOS FALTANTES, SE OPTA POR PONER LA PALABRA 'desconocido'
-- A LAS VARIABLES CATEGORICAS pais_nacimiento y pie_bueno Y SE OPTA POR SUSTITUIR
-- LOS VALORES FALTANTES DE LA VARIABLE NUMERICA Altura POR LA MEDIA OBTENIDA SIN
-- LOS VALORES FALTANTES
CASE WHEN T2.country_of_birth IS NULL THEN 'desconocido' ELSE T2.country_of_birth END AS pais_nacimiento,
T2.position,
CASE WHEN T2.foot IS NULL THEN 'desconocido' ELSE T2.foot END AS pie_bueno,
CASE WHEN T2.height_in_cm IS NULL THEN 182 ELSE T2.height_in_cm END AS Altura,
T2.edad_actual,
T1.minutos_jugados,
T1.partidos_jugados,
T1.asistencias,
T1.goles,
T1.tarj_amarillas,
T1.tarj_rojas,
T2.market_value_in_eur 
FROM
tabla1 T1
INNER JOIN jugadores T2
ON T1.player_id = T2.player_id
"

# Obtenemos los resultados de la consulta y lo guardamos en una variable llamada 'df'

df <- dbGetQuery(conn, query)

B.Exploración inicial

Mostramos las primeras filas de los resultados de la consulta:

##   player_id pais_nacimiento   position pie_bueno Altura edad_actual
## 1     58088       Argentina Goalkeeper     right    190          38
## 2     58843           UdSSR   Defender     right    182          35
## 3     96533          France     Attack     right    183          37
## 4     96718           Spain   Defender     right    182          35
## 5    130365           Italy   Defender     right    173          33
##   minutos_jugados partidos_jugados asistencias goles tarj_amarillas tarj_rojas
## 1            6175               69           0     0              5          0
## 2             586                7           0     0              6          0
## 3             798               28           3     7              1          0
## 4            4694               59           8     3             11          0
## 5            2244               44           7     1              9          0
##   market_value_in_eur
## 1             1400000
## 2              125000
## 3              300000
## 4             1800000
## 5             2000000

Mostramos la estadística descriptiva de los datos:

library(skimr)
skim(df)

Data summary

Name	df
Number of rows	8193
Number of columns	13
_______________________
Column type frequency:
character	3
numeric	10
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pais_nacimiento	0	1	4	21	0	148	0
position	0	1	6	10	0	5	0
pie_bueno	0	1	4	11	0	4	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
player_id	0	1.00	418361.92	256183.80	3333	212847	381833	591796	1240467	▇▇▆▂▁
Altura	0	1.00	182.40	6.76	160	178	182	187	206	▁▅▇▃▁
edad_actual	0	1.00	26.83	4.73	16	23	26	30	43	▃▇▇▂▁
minutos_jugados	0	1.00	1652.58	1454.80	1	407	1270	2618	7110	▇▃▂▁▁
partidos_jugados	0	1.00	25.41	18.60	1	9	22	39	88	▇▅▃▂▁
asistencias	0	1.00	1.80	2.99	0	0	1	2	34	▇▁▁▁▁
goles	0	1.00	2.34	4.50	0	0	1	3	63	▇▁▁▁▁
tarj_amarillas	0	1.00	3.45	3.72	0	1	2	5	27	▇▂▁▁▁
tarj_rojas	0	1.00	0.09	0.31	0	0	0	0	3	▇▁▁▁▁
market_value_in_eur	60	0.99	4870622.77	11187481.60	10000	400000	1000000	4000000	180000000	▇▁▁▁▁

Podemos observar que, gracias al preprocesamiento de datos en SQL sólo aparecen valores faltantes en la variable ‘market_value_in_eur’

FASE 2: PREPROCESAMIENTO DE LOS DATOS

A.Tratamiento de valores faltantes en la variable ‘market_value_in_eur’

Dado que tenemos 60 valores faltantes sobre un total de 8193 observaciones, se estima eliminar los valores faltantes, ya que sólo representan el 0,73 % aproximadamente del total de observaciones del dataset:

df_limpio <- na.omit(df)

Volvemos a revisar la estadística descriptiva de los datos:

skim(df_limpio)

Data summary

Name	df_limpio
Number of rows	8133
Number of columns	13
_______________________
Column type frequency:
character	3
numeric	10
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pais_nacimiento	0	1	4	21	0	148	0
position	0	1	6	10	0	5	0
pie_bueno	0	1	4	11	0	4	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
player_id	0	1	414626.06	252858.26	3333	211637	378972	586659	1229924	▇▇▆▂▁
Altura	0	1	182.41	6.76	160	178	182	187	206	▁▅▇▃▁
edad_actual	0	1	26.88	4.71	16	23	26	30	43	▃▇▇▂▁
minutos_jugados	0	1	1664.34	1453.66	1	421	1287	2632	7110	▇▃▂▁▁
partidos_jugados	0	1	25.58	18.56	1	10	23	39	88	▇▅▅▂▁
asistencias	0	1	1.82	3.00	0	0	1	2	34	▇▁▁▁▁
goles	0	1	2.36	4.52	0	0	1	3	63	▇▁▁▁▁
tarj_amarillas	0	1	3.47	3.72	0	1	2	5	27	▇▂▁▁▁
tarj_rojas	0	1	0.09	0.31	0	0	0	0	3	▇▁▁▁▁
market_value_in_eur	0	1	4870622.77	11187481.60	10000	400000	1000000	4000000	180000000	▇▁▁▁▁

Podemos observar que se han eliminado 60 observaciones del total del dataset.

B.Identificación, visualización y ajuste de valores atípicos

Procedemos a analizar la variable ‘goles’ en función de la posición del jugador; para ello usamos un diagrama de cajas para visualizar las variables y observar posibles valores atipicos:

library(ggplot2)
library(gridExtra)
plot1 <- ggplot(df_limpio, aes(x = position, y = goles)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de Goles por Posición", y = "Número de Goles", x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

print(plot1)

Vemos que existe una posición ‘Missing’, la cual después de verificar los datos, procedemos a sustituir por la posición ‘Attack’:

library(dplyr)

df_limpio <- df_limpio %>%
  mutate(position = ifelse(position == "Missing", "Attack", position))

Realizamos un nuevo boxplot con los datos actualizados:

box_goles_x_posicion <- ggplot(df_limpio, aes(x = position, y = goles)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Goles por Posición", y = "Número de Goles", x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

Realizamos una comparativa antes y después del cambio:

grid.arrange(plot1, box_goles_x_posicion, ncol = 1)

Una vez realizada la transformación, elaboramos varios diagramas de cajas sin discriminar por posición para todas las variables numéricas y así obtener una visión clara de todos los valores atípicos que tenemos en el dataset:

box_Altura <- ggplot(df_limpio, aes(y = Altura)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de Altura", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_edad_actual <- ggplot(df_limpio, aes(y = edad_actual)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de Edad_actual", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_minutos_jugados <- ggplot(df_limpio, aes(y = minutos_jugados)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de minutos_jugados", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_partidos_jugados <- ggplot(df_limpio, aes(y = partidos_jugados)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de partidos_jugados", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_asistencias <- ggplot(df_limpio, aes(y = asistencias)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de asistencias", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_goles <- ggplot(df_limpio, aes(y = goles)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de goles", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_tarj_amarillas <- ggplot(df_limpio, aes(y = tarj_amarillas)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de tarj_amarillas", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_tarj_rojas <- ggplot(df_limpio, aes(y = tarj_rojas)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de tarj_rojas", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

box_market_value_in_eur  <- ggplot(df_limpio, aes(y = market_value_in_eur )) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightblue") +
  coord_flip() +
  labs(title = "Boxplot de market_value_in_eur", y = NULL, x = NULL) +
    theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )

grid.arrange(box_Altura, box_edad_actual, box_minutos_jugados, box_partidos_jugados, box_asistencias, box_goles, box_tarj_amarillas, box_tarj_rojas, box_market_value_in_eur, ncol = 2)

C. Transformación de los datos

Después de verificar los valores atípicos de cada una de las variables numéricas, vamos a intentar reducir esos valores mediante una transformación logarítmica de las variables que consideramos que pueden interferir en la robustez de modelo de regresión logística que vamos a realizar posteriormente y comparamos el resultado obtenido mediante diagramas de cajas:

library(dplyr)

# Creamos las nuevas variables log-transformadas y las incluimos en el dataset:

df_limpio <- df_limpio %>%
  mutate(
    minutos_jugados_log = log(minutos_jugados + 1),
    asistencias_log = log(asistencias + 1),
    goles_log = log(goles + 1),
    tarj_amarillas_log = log(tarj_amarillas + 1),
    market_value_in_eur_log = log(market_value_in_eur + 1)
  )

# Creamos los gráficos de las variables log-transformadas:

box_minutos_jugados_log <- ggplot(df_limpio, aes(y = minutos_jugados_log)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Minutos Jugados (Log)", y = NULL, x = NULL) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )


box_asistencias_log <- ggplot(df_limpio, aes(y = asistencias_log)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Asistencias (Log)", y = NULL, x = NULL) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )


box_goles_log <- ggplot(df_limpio, aes(y = goles_log)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Goles (Log)", y = NULL, x = NULL) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )


box_tarj_amarillas_log <- ggplot(df_limpio, aes(y = tarj_amarillas_log)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Tarjetas Amarillas (Log)", y = NULL, x = NULL) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )


box_market_value_in_eur_log  <- ggplot(df_limpio, aes(y = market_value_in_eur_log)) +
  geom_boxplot(outlier.colour = "red", outlier.shape = 16, outlier.size = 1, fill = "lightgreen") +
  coord_flip() +
  labs(title = "Boxplot de Valor de Mercado (Log)", y = NULL, x = NULL) +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  )


grid.arrange(box_minutos_jugados,
  box_minutos_jugados_log, box_asistencias, box_asistencias_log,
  box_goles, box_goles_log, box_tarj_amarillas, box_tarj_amarillas_log, box_market_value_in_eur,
  box_market_value_in_eur_log,
  ncol = 2
)

Podemos observar que las variables logarítmicas reducen la cantidad de valores atípicos.

FASE 3: MODELADO

A. Preparación de la variable de respuesta

Vamos a comprobar como se comporta el modelo de regresión logística primero sin las variables log y luego con ellas. Para ello lo primero que haremos será transformar la variable ‘goles’ a código binario, donde 0 significa no hay goles y 1 hay goles:

df_limpio$goles_bin <- ifelse(df_limpio$goles > 0, 1, 0)

B. Ajuste de modelos de regresión logística

Ahora realizaremos todas las fases de la creación de los modelos de regresión logística; para ello, vamos a realizar dos modelos, en el primer modelo usaremos las variables originales (sin transformación logarítmica) y en el segundo modelo sustituiremos las variables originales por la logarítmicas, con el próposito de observar el comportamiento de ambos modelos y escoger el mejor de ellos

MODELO CON VARIABLES ORIGINALES

# Creamos el modelo de regresión logística

modelo <- glm(goles_bin ~ edad_actual + position + minutos_jugados + partidos_jugados+ market_value_in_eur + asistencias, 
              data = df_limpio, family = "binomial")

# Calculamos las probabilidades predictivas usando el modelo ajustado

prob_sin_log <- predict(modelo, type = "response")

# Añadimos las probabilidades al dataset

df_limpio$prob_goles <- prob_sin_log

MODELO CON VARIABLES LOGARITMICAS

# Creamos el modelo de regresión logística

modelo_log <- glm(goles_bin ~ edad_actual + position + minutos_jugados_log + partidos_jugados + market_value_in_eur_log + asistencias_log, 
              data = df_limpio, family = "binomial")

# Calculamos las probabilidades predictivas usando el modelo ajustado

prob_con_log <- predict(modelo_log, type = "response")

# Añadimos las probabilidades al dataset

df_limpio$prob_goles_log <- prob_con_log

C. Evaluación de los modelos

Vamor a comparar los dos modelos obtenidos, para ello, vamos a usar la curva ROC y los indicadores de AIC y AUC:

# Cargamos la librería necesaria

library(pROC)

# Calculamos el AIC de los modelos para valorar su calidad

aic_modelo <- AIC(modelo)
aic_modelo_log <- AIC(modelo_log)

# Obtenemos las predicciones

predicciones_modelo <- predict(modelo, df_limpio, type = "response")
predicciones_modelo_log <- predict(modelo_log, df_limpio, type = "response")

# Creamos los objetos ROC

roc_obj <- roc(df_limpio$goles_bin, predicciones_modelo)
roc_obj_log <- roc(df_limpio$goles_bin, predicciones_modelo_log)

# Convertimos los objetos ROC a data frames para usarlos en ggplot2

roc_df <- data.frame(
  fpr = c(roc_obj$specificities, roc_obj_log$specificities),
  tpr = c(roc_obj$sensitivities, roc_obj_log$sensitivities),
  model = factor(rep(c("Modelo Original", "Modelo Logarítmico"), each = length(roc_obj$specificities)))
)

# Creamos el gráfico con ggplot2

ggplot(roc_df, aes(x = 1 - fpr, y = tpr, color = model)) +
  geom_line() +
  geom_abline(linetype = "dashed") +
  labs(title = "Curvas ROC Comparativas", 
       x = "Tasa de Falsos Positivos", 
       y = "Tasa de Verdaderos Positivos") +
  scale_color_manual(values = c("blue", "red")) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, size = 14, face = "bold")
  ) +
  theme(legend.position = "none") +  
  annotate("text", x = 0.7, y = 0.3, 
           label = paste("Modelo Original\n(AUC =",     round(auc(roc_obj), 2), 
                         ", AIC =", round(aic_modelo, 2), ")"), 
           color = "blue", size = 3.5) +
  annotate("text", x = 0.7, y = 0.2, 
           label = paste("Modelo Logarítmico\n(AUC =", round(auc(roc_obj_log), 2), 
                         ", AIC =", round(aic_modelo_log, 2), ")"), 
           color = "red", size = 3.5)

Podemos concluir que el modelo logarítmico mejora al modelo original, ya que arroja un AUC superior (0.91), lo cual indica que tiene una capacidad predictiva muy buena y también tiene un mejor AIC (6255.52), lo que indica un mejor ajuste del modelo.

FASE 4: VALIDACION Y DIAGNOSTICO

A.Validación Cruzada

Vamos a evaluar el rendimiento del modelo logarítmico mediante validación cruzada para garantizar que generaliza bien con nuevos datos.

# Creamos una función para dividir los datos en K pliegues (folds)

crear_pliegues <- function(data, K) {
  pliegues <- sample(rep(1:K, length.out = nrow(data)))
  return(pliegues)
}

# Creamos un función para realizar la validación cruzada manual en el modelo

validacion_cruzada_logistica <- function(data, formula, K = 5) {
  
# Creamos los pliegues
 
pliegues <- crear_pliegues(data, K)
  
# Creamos una variable para almacenar la precisión en cada iteración

precision <- numeric(K)
  
# Realizamos un bucle sobre cada pliegue, donde dividimos los datos en entrenamiento y prueba

for (i in 1:K) {
  datos_entrenamiento <- data[pliegues != i, ]  
  datos_prueba <- data[pliegues == i, ]       
    
# Ajustarmos el modelo en el conjunto de entrenamiento
  
modelo_log <- glm(formula, data = datos_entrenamiento, family = binomial)
    
# Predecimos las probabilidades en el conjunto de prueba

predicciones <- predict(modelo_log, newdata = datos_prueba, type = "response")
    
# Convertimos las probabilidades en clases (0 o 1)

clases_predichas <- ifelse(predicciones > 0.5, 1, 0)
    
# Evaluamos la precisión

clases_reales <- datos_prueba[, as.character(formula[[2]])]
precision[i] <- mean(clases_predichas == clases_reales)
  }
  
# Retornarmos el promedio de la precisión de todos los pliegues

return(mean(precision))
}

# Aplicamos la función de validación cruzada al dataset

# El modelo predice 'goles_bin' basado en las variables independientes 
precision_promedio <- validacion_cruzada_logistica(
  df_limpio, 
  goles_bin ~ edad_actual + position + minutos_jugados_log + partidos_jugados + market_value_in_eur_log + asistencias_log, 
  K = 5
)

# Mostramos el resultado de la validación cruzada

print(paste("Precisión promedio en la validación cruzada: ", round(precision_promedio, 4)))

## [1] "Precisión promedio en la validación cruzada:  0.8184"

El resultado indica que el modelo, en promedio, clasifica correctamente por encima del 80 % de los casos, lo que indica que el modelo tiene una efectividad sólida en su rendimiento.

B. Multicolinealidad

Verificamos si existe multicolinealidad usando el VIF (Variance Inflation Factor).

# Cargamos la librería necesaria

library(car)

# Ajustamos el modelo de regresión logística en los datos completos

modelo_log <- glm(goles_bin ~ edad_actual + position + minutos_jugados_log + partidos_jugados + market_value_in_eur_log + asistencias_log, 
                  data = df_limpio, 
                  family = binomial)

# Calculamos el VIF para las variables independientes del modelo

vif_resultados <- vif(modelo_log)

# Mostramos los resultados del VIF

print(vif_resultados)

##                             GVIF Df GVIF^(1/(2*Df))
## edad_actual             1.121123  1        1.058831
## position                1.487911  3        1.068471
## minutos_jugados_log     4.309226  1        2.075868
## partidos_jugados        3.945419  1        1.986308
## market_value_in_eur_log 1.365263  1        1.168445
## asistencias_log         1.387616  1        1.177971

Los resultados indican que, aunque existen variables con un GVIF DE 2.08 Y 1.99, no provocan una multicolinealidad seria y al no haber ninguna variable cercana al GVIF == 5, se concluye que no existe multicolinealidad.

C. Análisis de residuos

Para realizar un diagnóstico de la calidad del modelo, procedemos a realizar un análisis de residuos.

• Cálculo de valores predichos y residuos:

Se extraen los valores predichos del modelo, los residuos y los valores de leverage para cada observación:

library(broom)

df_limpio <- df_limpio %>%
  mutate(
    fitted = predict(modelo_log, type = "response"), 
    residuos = residuals(modelo_log, type = "deviance"),
    leverage = hatvalues(modelo_log)
  )

• Cálculo de residuos estandarizados:

Los residuos se estandarizan usando el leverage para obtener residuos estándar, lo que permite una mejor interpretación y comparación:

df_limpio <- df_limpio %>%
  mutate(
    residuos_stand = residuos / sqrt(1 - leverage)
  )

• Visualización de los residuos:

Se generan varios gráficos para diagnosticar el ajuste del modelo; el primer gráfico es de utilidad para detectar puntos influyentes (leverage):

ggplot(df_limpio, aes(x = leverage, y = residuos_stand)) +
  geom_point(alpha = 0.5, color = "gray") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Leverage vs Residuos Estándarizados",
       x = "Leverage",
       y = "Residuos Estándarizados") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"))

Podemos observar una concentración de residuos en los mismos sectores arriba y debajo de la linea discontinua, pero estos no los podemos considerar extremos, además de una linea de puntos alrededor del valor 0 a lo largo del eje de influencia (leverage), lo que indica que hay un buen ajuste en general con una leve tendencia a la sobreestimación.

El histograma de residuos estandarizados nos permite evaluar visualmente su distribucion:

ggplot(df_limpio, aes(x = residuos_stand)) +
  geom_histogram(binwidth = 0.5, fill = "lightblue", color = "black", alpha = 0.7) +
  labs(title = "Histograma de Residuos Estándarizados",
       x = "Residuos Estándarizados",
       y = "Frecuencia") +
  theme_minimal() +
   theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"))

Podemos observar una distribución normal general de los residuos, con una ligera cola larga a la izquierda.

El gráfico QQ plot nos permite visualizar la normalidad de los residuos estandarizados:

ggplot(df_limpio, aes(sample = residuos_stand)) +
  stat_qq(color = "orange") +
  stat_qq_line(color = "darkblue") +
  labs(title = "Q-Q Plot de Residuos Estándarizados",
       x = "Cuantiles Teóricos",
       y = "Cuantiles de Residuos") +
  theme_minimal() +
   theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"))

Podemos observar que los puntos estan distribuidos a lo largo de la linea azul, lo que indica normalidad en los residuos.

FASE 5: RESULTADOS Y CONCLUSIONES

A. Visualización y presentación de resultados

Vamos a visualizar mediante una muestra los resultados obtenidos y las predicciones mediante el modelo de regresión logística usando variables logarítmicas:

df_limpio %>%
  select(player_id, position, prob_goles_log) %>%
  slice_head(n = 10)

Podemos ver que, por ejemplo, los porteros tienen una probabilidad muy baja de marcar gol, comparados con otros jugadores que ocupan otras posiciones más adelantadas en el terreno de juego.

B. Exploración de variables

Para este punto, analizamos la matriz de correlación entre las variables de interés:

# Seleccionamos solo las variables logarítmicas y otras adicionales de nuestro interés

variables_seleccionadas <- df_limpio %>% select(
  contains("_log"),  
  edad_actual,        
  partidos_jugados, 
  tarj_rojas, 
  Altura, 
  goles_bin  
)

# Calculamos la matriz de correlación

matriz_correlacion_log <- cor(variables_seleccionadas, use = "complete.obs")

# Graficamos la matriz de correlación

library(ggcorrplot)

ggcorrplot(matriz_correlacion_log, hc.order = TRUE, type = "upper", 
           lab = TRUE, lab_size = 3,
           colors = c("red", "white", "blue"), 
           title = "Matriz de Correlación_log y otras variables") +
           theme(plot.title = element_text(hjust = 0.5))

Podemos observar las correlaciones entre todas las variables seleccionadas, para así poder realizar nuevos analisis entre ellas.