UNIVERSIDAD DE EL SALVADOR
FACULTAD DE ECONOMÍA
ESCUELA DE ECONOMÍA
ECONOMETRIA

INTEGRANTES CARNE
Neira García, Kevin Alexander NG23003
Quijano Vásquez, Luis Daniel QV13001
Ramos Rivas, Marco Antonio RR14082

DOCENTE: MSF. Carlos Ademir Pérez Alas.

MARCO TEÓRICO Y REFERENCIAL

El valor económico de un jugador de fútbol profesional es un fenómeno complejo que ha captado la atención tanto de economistas como de analistas deportivos. Desde la publicación del concepto de Moneyball, popularizado por Michael Lewis (2003), los clubes de fútbol han adoptado metodologías cuantitativas para identificar y valorar el talento deportivo de manera más eficiente. Este enfoque, denominado analítica deportiva, busca descomponer el rendimiento de un jugador en atributos medibles que expliquen su precio de mercado.

Teoría del Capital Humano Deportivo

La teoría del capital humano (Becker, 1964) establece que los individuos acumulan habilidades y conocimientos que se traducen en mayor productividad y, por ende, en mayores ingresos. En el contexto deportivo, el capital humano de un jugador se manifiesta en sus habilidades técnicas, físicas y tácticas. Autores como Franck y Nüesch (2012) extendieron este marco para el fútbol, argumentando que el valor de mercado de un jugador refleja su productividad esperada futura, ajustada por factores institucionales como la edad, el contrato vigente y la posición dentro del campo.

Modelos Hedónicos de Precios en el Mercado de Transferencias

Los modelos de precios hedónicos (Rosen, 1974) descomponen el precio de un bien heterogéneo en función de sus atributos individuales. Aplicados al fútbol, estos modelos estiman cuánto contribuye cada característica observable de un jugador -como su velocidad, precisión en los pases o capacidad de disparo- al valor total de transferencia. Estudios como el de Müller et al. (2017) y Herm et al. (2014) han evidenciado que los atributos técnicos y la visibilidad mediática del jugador son determinantes estadísticamente significativos del valor de mercado, con la base de datos de EA Sports (FIFA/FC) siendo ampliamente utilizada como proxy de las capacidades de los jugadores.

Determinantes del Valor de Mercado en el Fútbol Moderno

La literatura identifica cuatro grandes grupos de determinantes del valor económico de un jugador:

  • Atributos técnicos y físicos: habilidades de regate, ritmo, posicionamiento, resistencia y potencia de disparo son los predictores más directos del rendimiento en campo (Carmichael et al., 2011).
  • Factores demográficos: la edad tiene una relación no lineal con el valor; alcanza su máximo entre los 24 y 28 años, y decrece posteriormente. La nacionalidad y la liga donde compite el jugador también inciden significativamente (Poli et al., 2020).
  • Factores contractuales e institucionales: el tiempo restante de contrato, el salario percibido y el club al que pertenece el jugador actúan como señales de calidad y determinan el poder de negociación en las transferencias.
  • Reputación y popularidad: la reputación internacional y la visibilidad mediática generan externalidades positivas para el club en términos de ventas de camisetas y patrocinios, elevando el precio de transferencia por encima del rendimiento puramente deportivo (Franck y Nüesch, 2012).

Evidencia Empírica y Uso del Dataset FIFA

La base de datos de videojuegos FIFA/FC de EA Sports ha sido validada como un instrumento confiable para aproximar las capacidades reales de los jugadores. Pappalardo et al. (2019) y Deloitte (2022) demuestran que las puntuaciones asignadas en el videojuego correlacionan significativamente con estadísticas reales de desempeño. El dataset FIFA 21 Messy Raw (Kaggle) contiene más de 18,000 observaciones de jugadores con variables detalladas sobre sus atributos técnicos, salarios, valores de mercado y características personales, siendo idóneo para estimar un Modelo Clásico de Regresión Lineal Múltiple (MCRLM) de determinantes del valor económico de un jugador.

Especificación

Planteamiento Teórico del Fenómeno Económico

Variable Endógena y Variables Exógenas

Variable dependiente (Y): Valor de mercado del jugador (Value), expresado en euros. Esta variable representa el precio estimado de transferencia de un jugador y es la principal señal del valor económico percibido en el mercado futbolístico.

Se proponen seis regresores (superando el mínimo de cuatro exigido), con base en la literatura revisada:

Var. Nombre Descripción Fuente / rango
X1 OVA (Overall Rating) Puntuación global de habilidades del jugador EA Sports, 0-99
X2 Age (Edad) Edad del jugador en años 16-43 años
X3 Age² (Edad al cuadrado) Captura la no linealidad del efecto de la edad construida a partir de Age
X4 Wage (Salario) Salario semanal del jugador, en euros EA Sports / club
X5 POT (Potencial) Puntuación de potencial máximo estimado EA Sports, 0-99
X6 IR (Reputación internacional) Variable ordinal de fama internacional EA Sports, 1-5

La inclusión de Age al cuadrado (X3) responde directamente a la hipótesis de no linealidad planteada en la literatura (Poli et al., 2020): el valor de un jugador no crece de forma indefinida con la edad, sino que sigue un patrón de “U invertida” -aumenta durante la etapa de desarrollo y consolidación, alcanza un máximo alrededor de los 26-28 años, y luego decrece por la depreciación física del capital humano deportivo. Para representar correctamente esta curvatura dentro de un modelo lineal en los parámetros, es necesario incorporar el término cuadrático como un regresor adicional explícito.

Relación Funcional entre las Variables (Hipótesis)

Con base en la teoría del capital humano deportivo y los modelos hedónicos, se plantean las siguientes hipótesis:

  • H1: A mayor puntuación global (OVA), mayor es el valor de mercado del jugador (\(\beta_1 > 0\)).
  • H2: La edad tiene un efecto positivo sobre el valor hasta un punto óptimo, después del cual el efecto se vuelve negativo: relación de tipo cuadrático (\(\beta_2 > 0\), \(\beta_3 < 0\)).
  • H3: Los jugadores con salarios más altos presentan valores de mercado significativamente mayores (\(\beta_4 > 0\)).
  • H4: El potencial futuro del jugador impacta positivamente su valuación presente (\(\beta_5 > 0\)).
  • H5: Una mayor reputación internacional se asocia con un valor de mercado más elevado, independientemente de los atributos técnicos (\(\beta_6 > 0\)).

Especificación del Modelo Matemático y Estadístico

Modelo Matemático

El modelo de Regresión Lineal Múltiple (MCRLM) propuesto es el siguiente:

\[Value_i = \beta_0 + \beta_1 OVA_i + \beta_2 Age_i + \beta_3 Age_i^2 + \beta_4 Wage_i + \beta_5 POT_i + \beta_6 IR_i + \varepsilon_i\]

Donde \(\beta_0\) es la constante del modelo, \(\beta_1,\dots,\beta_6\) son los coeficientes de regresión parcial de cada regresor, y \(\varepsilon_i\) es el término de error aleatorio que captura los factores no observados. El subíndice \(i\) denota cada jugador individual en la muestra.

Restricciones esperadas sobre los parámetros (signos):

Parámetro Variable Signo esperado Justificación
\(\beta_1\) OVA \(+\) Mayor habilidad global implica mayor productividad esperada en cancha (capital humano).
\(\beta_2\) Age \(+\) En la etapa de ascenso, mayor edad refleja experiencia y madurez competitiva.
\(\beta_3\) Age² \(-\) Captura la depreciación del capital humano tras el pico de rendimiento físico.
\(\beta_4\) Wage \(+\) El salario actúa como señal de calidad y compromiso del club (Akerlof, 1970).
\(\beta_5\) POT \(+\) El potencial es un “valor de opción” sobre el rendimiento futuro del jugador.
\(\beta_6\) IR \(+\) Mayor reputación genera externalidades positivas de marca y patrocinio.

Como se documenta en la sección de evidencia empírica más abajo, la variable Value presenta una fuerte asimetría positiva, por lo que también se especifica una versión en logaritmos del modelo, a estimarse en la Parte 2 junto con el modelo en niveles:

\[\ln(Value_i) = \beta_0 + \beta_1 OVA_i + \beta_2 Age_i + \beta_3 Age_i^2 + \beta_4 Wage_i + \beta_5 POT_i + \beta_6 IR_i + \varepsilon_i\]

En esta especificación semi-logarítmica, cada coeficiente \(\beta_k\) se interpreta como una semi-elasticidad: el cambio porcentual aproximado en el valor de mercado ante un cambio de una unidad en el regresor correspondiente.

Modelo Estadístico

El modelo estadístico establece que el término de error cumple con los supuestos clásicos del MCRLM:

\[E(\varepsilon_i) = 0, \quad Var(\varepsilon_i) = \sigma^2 \text{ (homocedasticidad)}, \quad Cov(\varepsilon_i,\varepsilon_j) = 0 \text{ para } i \neq j \text{ (no autocorrelación)}, \quad \varepsilon_i \sim N(0,\sigma^2) \text{ (normalidad)}\]

Los parámetros serán estimados por Mínimos Cuadrados Ordinarios (MCO), método que, bajo los supuestos de Gauss-Markov, produce estimadores MELI (Mejores Estimadores Lineales e Insesgados). La verificación formal de estos supuestos (normalidad, homocedasticidad, autocorrelación y multicolinealidad), así como las correcciones correspondientes, se desarrollará en la Parte 2 y Parte 3 de este trabajo.

Evidencia Empírica del Fenómeno Económico [Datos]

Descripción y Limpieza del Dataset

El dataset FIFA 21 Messy Raw contiene información de 18,979 jugadores profesionales de todo el mundo, con variables disponibles en SoFIFA.com. La muestra supera ampliamente el mínimo de 200 observaciones requerido por la guía del trabajo.

Tal como advierte el nombre del dataset (“messy raw data”), varias variables requieren limpieza antes de poder usarse en el modelo:

  • Value, Wage y Release Clause vienen como texto con el símbolo “€” y sufijos “K” (miles) o “M” (millones), por ejemplo "€103.5M".
  • IR (reputación internacional) viene codificada como estrellas de texto, por ejemplo "4 ★".
  • El nombre de la columna de calificación general (Overall) llega corrupto por un carácter de codificación (aparece como "↓OVA"), por lo que se renombra.
# Ajustar la ruta de archivo según la ubicación en su computadora
datos <- read.csv("fifa21 raw data v2.csv",
                  stringsAsFactors = FALSE,
                  encoding = "UTF-8")

# La columna 8 es la calificación "Overall", su nombre llega corrupto por el
# símbolo "↓" -> se renombra a OVA
names(datos)[8] <- "OVA"

# --- Limpieza de variables monetarias: "€103.5M" / "€560K" -> numérico en euros ---
limpiar_moneda <- function(x) {
  x <- gsub("\u20ac", "", x)                     # quita el símbolo de euro
  mult <- ifelse(grepl("M", x), 1e6,
          ifelse(grepl("K", x), 1e3, 1))          # detecta millones / miles
  as.numeric(gsub("[MK]", "", x)) * mult
}

# --- Limpieza de variables tipo estrella: "4 ★" -> 4 ---
limpiar_estrellas <- function(x) as.numeric(gsub("[^0-9.]", "", x))

datos$Value <- limpiar_moneda(datos$Value)
datos$Wage  <- limpiar_moneda(datos$Wage)
datos$IR    <- limpiar_estrellas(datos$IR)
datos$OVA   <- as.numeric(datos$OVA)
datos$POT   <- as.numeric(datos$POT)
datos$Age   <- as.numeric(datos$Age)

# Se excluyen jugadores con Value = 0: corresponden a perfiles sin valor de
# mercado asignado (agentes libres / datos incompletos), no a un valor económico
# real de cero, y además impiden aplicar la transformación logarítmica.
n_antes <- nrow(datos)
datos <- subset(datos, Value > 0)

# Variables derivadas para el modelo
datos$lnValue <- log(datos$Value)
datos$Age2 <- datos$Age^2

cat("Observaciones originales:", n_antes, "\n")
## Observaciones originales: 18979
cat("Observaciones tras excluir Value = 0:", nrow(datos), "\n")
## Observaciones tras excluir Value = 0: 18731

Tras la limpieza, la muestra final cuenta con 18,731 observaciones, todas con datos completos en las seis variables del modelo.

Análisis Descriptivo de las Variables

asimetria <- function(x) mean((x - mean(x))^3) / sd(x)^3
curtosis  <- function(x) mean((x - mean(x))^4) / sd(x)^4 - 3

vars <- c("Value", "lnValue", "OVA", "Age", "Wage", "POT", "IR")
etiquetas <- c("Value (€)", "ln(Value)", "OVA (0-99)", "Age (años)",
               "Wage (€/semana)", "POT (0-99)", "IR (1-5)")

tabla_desc <- t(sapply(vars, function(v) {
  x <- datos[[v]]
  c(Media = mean(x), Mediana = median(x), `Desv. Est.` = sd(x),
    Min = min(x), Max = max(x), Asimetria = asimetria(x), Curtosis = curtosis(x))
}))
rownames(tabla_desc) <- etiquetas
knitr::kable(round(tabla_desc, 2),
             caption = "Estadísticos descriptivos de las variables del modelo")
Estadísticos descriptivos de las variables del modelo
Media Mediana Desv. Est. Min Max Asimetria Curtosis
Value (€) 2902996.58 975000.00 7728744.66 9000.0 185500000.00 7.95 90.91
ln(Value) 13.89 13.79 1.24 9.1 19.04 0.61 0.79
OVA (0-99) 65.68 66.00 6.97 47.0 93.00 0.10 0.02
Age (años) 25.13 25.00 4.68 16.0 43.00 0.39 -0.51
Wage (€/semana) 9210.03 3000.00 19809.48 500.0 560000.00 7.27 92.52
POT (0-99) 71.15 71.00 6.11 47.0 95.00 0.21 0.08
IR (1-5) 1.09 1.00 0.36 1.0 5.00 4.65 25.01

Interpretación: la variable Value presenta una asimetría positiva muy fuerte (coeficiente \(\approx 8\)) y un exceso de curtosis muy elevado, confirmando que su distribución está dominada por una gran masa de jugadores de valor bajo-moderado y una “cola larga” de superestrellas con valores extremos. Al aplicar la transformación logarítmica, la asimetría se reduce drásticamente (de \(\approx 8\) a \(\approx 0.6\)) y la curtosis se acerca a la de una distribución normal, lo que confirma empíricamente la necesidad de trabajar con \(\ln(Value)\) planteada en la sección de especificación del modelo estadístico. El resto de regresores (OVA, Age, POT) muestran distribuciones razonablemente simétricas, mientras que Wage e IR replican el mismo patrón de cola larga que Value, coherente con la alta concentración de salarios y fama en un grupo reducido de jugadores de élite.

par(mfrow = c(1, 2))
hist(datos$Value, breaks = 50, col = "steelblue",
     main = "Value (niveles)", xlab = "Euros")
hist(datos$lnValue, breaks = 50, col = "darkorange",
     main = "ln(Value)", xlab = "ln(Euros)")

Análisis de Correlación entre Regresores

Como insumo preliminar para la futura verificación de multicolinealidad (Parte 2), se presenta la matriz de correlación entre los regresores propuestos:

# Si no tienen el paquete corrplot instalado: install.packages("corrplot")
library(corrplot)
m_cor <- cor(datos[c("OVA", "Age", "Wage", "POT", "IR")])
knitr::kable(round(m_cor, 3), caption = "Matriz de correlación entre regresores")
Matriz de correlación entre regresores
OVA Age Wage POT IR
OVA 1.000 0.469 0.597 0.631 0.446
Age 0.469 1.000 0.166 -0.270 0.275
Wage 0.597 0.166 1.000 0.488 0.613
POT 0.631 -0.270 0.488 1.000 0.310
IR 0.446 0.275 0.613 0.310 1.000 
corrplot(m_cor, method = "color", type = "upper", addCoef.col = "black",
         tl.col = "black", number.cex = 0.9)

Interpretación: ninguna correlación entre regresores supera 0.65, lo que sugiere a priori que no existen problemas severos de multicolinealidad, aunque esto se confirmará formalmente con el Factor de Inflación de la Varianza (VIF) en la Parte 2. Las correlaciones más altas se observan entre OVA y POT (0.63) -esperable, ya que ambas son calificaciones de habilidad de EA Sports-, y entre Wage e IR (0.61), consistente con la idea de que los jugadores más mediáticos también perciben los salarios más altos. Llama la atención la correlación negativa entre Age y POT (-0.27): refleja que el potencial de mejora (a diferencia de la calificación actual) es naturalmente mayor en jugadores jóvenes, lo cual refuerza la justificación teórica de incluir Age y Age² como regresores separados de OVA y POT.

ESTIMACIÓN DEL MODELO Y VERIFICACIÓN DE SUPUESTOS

Pruebas de Multicolinealidad

Fundamento Teórico

La multicolinealidad ocurre cuando dos o más variables regresoras del modelo están altamente correlacionadas entre sí, lo que dificulta estimar de forma precisa el efecto individual de cada regresor sobre la variable dependiente. Aunque los estimadores MCO siguen siendo insesgados, sus varianzas se inflan, provocando coeficientes estadísticamente no significativos aunque el modelo en conjunto sea significativo (R² alto con t-estadísticos bajos).

El modelo propuesto es:

Valorᵢ = β₀ + β₁ Puntuaciónᵢ + β₂ Edadᵢ + β₃ Salarioᵢ + β₄ Potencialᵢ + β₅ Reputaciónᵢ + εᵢ

Preparación de los Datos

# datos ya viene limpio de Parte 1 (Value, Wage, IR ya son numéricos, OVA ya renombrado)

datos_raw <- read.csv("fifa21 raw data v2.csv", stringsAsFactors = FALSE, encoding = "UTF-8")
names(datos_raw)[8] <- "OVA"
limpiar_moneda    <- function(x) { x <- gsub("\u20ac","",x); m <- ifelse(grepl("M",x),1e6,ifelse(grepl("K",x),1e3,1)); as.numeric(gsub("[KM]","",x))*m }
limpiar_estrellas <- function(x) as.numeric(gsub("[^0-9]","",x))
datos <- datos_raw
datos$Value <- limpiar_moneda(datos_raw$Value)
datos$Wage  <- limpiar_moneda(datos_raw$Wage)
datos$IR    <- limpiar_estrellas(datos_raw$IR)
datos$OVA   <- as.numeric(datos_raw$OVA)

muestra_df <- datos |>
  select(
    Valor      = Value,
    Puntuacion = OVA,
    Edad       = Age,
    Salario    = Wage,
    Potencial  = POT,
    Reputacion = IR
  ) |>
  filter(
    !is.na(Valor), !is.na(Puntuacion), !is.na(Edad),
    !is.na(Salario), !is.na(Potencial), !is.na(Reputacion),
    Valor > 0, Salario > 0
  ) |>
  mutate(
    lnValor   = log(Valor),
    lnSalario = log(Salario)
  )

set.seed(123)
muestra <- muestra_df |> slice_sample(n = 200)

cat("Dimensiones de la muestra:", nrow(muestra), "x", ncol(muestra), "\n")
## Dimensiones de la muestra: 200 x 8
head(muestra[, c("lnValor","Puntuacion","Edad","lnSalario","Potencial","Reputacion")], 10)

Estadísticas Descriptivas de las Variables del Modelo

vars_modelo <- muestra |>
  select(lnValor, Puntuacion, Edad, lnSalario, Potencial, Reputacion)

summary(vars_modelo) |>
  kable(caption = "Estadísticas Descriptivas — Muestra (n = 200)", digits = 3) |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)
Estadísticas Descriptivas — Muestra (n = 200)
lnValor Puntuacion Edad lnSalario Potencial Reputacion
Min. :10.46 Min. :48.00 Min. :16.00 Min. : 6.215 Min. :60.00 Min. :1.00
1st Qu.:13.12 1st Qu.:61.00 1st Qu.:21.00 1st Qu.: 6.908 1st Qu.:67.00 1st Qu.:1.00
Median :13.62 Median :65.00 Median :25.00 Median : 8.006 Median :70.00 Median :1.00
Mean :13.85 Mean :65.42 Mean :24.89 Mean : 8.089 Mean :71.01 Mean :1.09
3rd Qu.:14.46 3rd Qu.:69.25 3rd Qu.:28.00 3rd Qu.: 8.854 3rd Qu.:75.00 3rd Qu.:1.00
Max. :17.84 Max. :87.00 Max. :37.00 Max. :12.388 Max. :91.00 Max. :4.00

Estimación del Modelo de Regresión

modelo <- lm(lnValor ~ Puntuacion + Edad + lnSalario + Potencial + Reputacion,
             data = muestra)
summary(modelo)
## 
## Call:
## lm(formula = lnValor ~ Puntuacion + Edad + lnSalario + Potencial + 
##     Reputacion, data = muestra)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.05420 -0.10199  0.01004  0.11921  0.48727 
## 
## Coefficients:
##              Estimate Std. Error t value             Pr(>|t|)    
## (Intercept)  4.227458   0.317075  13.333 < 0.0000000000000002 ***
## Puntuacion   0.190544   0.006909  27.580 < 0.0000000000000002 ***
## Edad        -0.129898   0.007371 -17.622 < 0.0000000000000002 ***
## lnSalario    0.047964   0.023111   2.075              0.03927 *  
## Potencial   -0.002618   0.006133  -0.427              0.66988    
## Reputacion   0.171394   0.054512   3.144              0.00193 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2349 on 194 degrees of freedom
## Multiple R-squared:  0.9634, Adjusted R-squared:  0.9624 
## F-statistic:  1021 on 5 and 194 DF,  p-value: < 0.00000000000000022

Prueba 1: Matriz de Correlaciones entre Regresores

La primera señal de multicolinealidad es una correlación bilateral alta (|r| > 0.80) entre pares de regresores.

regresores <- muestra |>
  select(Puntuacion, Edad, lnSalario, Potencial, Reputacion)

mat_cor <- cor(regresores, use = "complete.obs")

mat_cor |>
  round(4) |>
  kable(caption = "Matriz de Correlaciones entre Regresores", align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Matriz de Correlaciones entre Regresores
Puntuacion Edad lnSalario Potencial Reputacion
Puntuacion 1.0000 0.4463 0.8209 0.5780 0.4946
Edad 0.4463 1.0000 0.2841 -0.3396 0.2205
lnSalario 0.8209 0.2841 1.0000 0.5318 0.4798
Potencial 0.5780 -0.3396 0.5318 1.0000 0.3720
Reputacion 0.4946 0.2205 0.4798 0.3720 1.0000 
corrplot(
  mat_cor,
  method      = "color",
  type        = "lower",
  addCoef.col = "black",
  number.cex  = 0.85,
  tl.col      = "black",
  tl.srt      = 45,
  col         = colorRampPalette(c("#E74C3C", "white", "#2980B9"))(200),
  title       = "Correlaciones entre Variables Explicativas",
  mar         = c(0, 0, 1.5, 0)
)
Figura 1. Mapa de calor de correlaciones entre regresores

Figura 1. Mapa de calor de correlaciones entre regresores

Interpretación: Correlaciones superiores a |0.80| entre Puntuación y Potencial son señal de posible multicolinealidad. Se procede con pruebas formales.

Prueba 2: Factor de Inflación de la Varianza (VIF)

El VIF mide cuánto se infla la varianza de cada coeficiente por la correlación con los demás regresores:

  • VIF < 5: Multicolinealidad aceptable
  • 5 ≤ VIF < 10: Multicolinealidad moderada
  • VIF ≥ 10: Multicolinealidad grave
vif_vals <- vif(modelo)

vif_df <- data.frame(
  Variable    = names(vif_vals),
  VIF         = round(vif_vals, 4),
  Diagnostico = case_when(
    vif_vals < 5  ~ "Sin problema",
    vif_vals < 10 ~ "Moderada",
    TRUE          ~ "Grave"
  )
)

vif_df |>
  kable(caption = "Factor de Inflación de la Varianza (VIF)", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(which(vif_df$VIF >= 10), background = "#FADBD8") |>
  row_spec(which(vif_df$VIF >= 5 & vif_df$VIF < 10), background = "#FEF9E7") |>
  row_spec(which(vif_df$VIF < 5), background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Factor de Inflación de la Varianza (VIF)
Variable VIF Diagnostico
Puntuacion 7.4883 Moderada
Edad 3.9673 Sin problema
lnSalario 3.2285 Sin problema
Potencial 4.7684 Sin problema
Reputacion 1.4207 Sin problema 
ggplot(vif_df, aes(x = reorder(Variable, VIF), y = VIF, fill = VIF)) +
  geom_col(width = 0.6, color = "white") +
  geom_hline(yintercept = 5,  linetype = "dashed", color = "#E67E22", linewidth = 1) +
  geom_hline(yintercept = 10, linetype = "dashed", color = "#E74C3C", linewidth = 1) +
  geom_text(aes(label = round(VIF, 2)), hjust = -0.2, fontface = "bold", size = 4) +
  scale_fill_gradient(low = "#AED6F1", high = "#C0392B") +
  coord_flip(ylim = c(0, max(vif_df$VIF) * 1.2)) +
  annotate("text", x = 0.6, y = 5.2,  label = "VIF = 5 (moderada)", color = "#E67E22", size = 3.5, hjust = 0) +
  annotate("text", x = 0.6, y = 10.2, label = "VIF = 10 (grave)",   color = "#E74C3C", size = 3.5, hjust = 0) +
  labs(title = "Factor de Inflación de la Varianza (VIF)",
       subtitle = "Modelo: lnValor ~ Puntuación + Edad + lnSalario + Potencial + Reputación",
       x = "Regresor", y = "VIF") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none",
        plot.title    = element_text(face = "bold", hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5, color = "grey40"))
Figura 2. VIF por regresor

Figura 2. VIF por regresor

Prueba 3: Tolerancia (TOL)

La Tolerancia es el inverso del VIF: TOL = 1 / VIF.
- TOL < 0.10 indica multicolinealidad severa
- TOL < 0.20 señala problema moderado

tol_df <- data.frame(
  Variable    = names(vif_vals),
  VIF         = round(vif_vals, 4),
  Tolerancia  = round(1 / vif_vals, 4),
  Diagnostico = case_when(
    1/vif_vals > 0.20 ~ "Sin problema",
    1/vif_vals > 0.10 ~ " Moderada",
    TRUE              ~ "Grave"
  )
)

tol_df |>
  kable(caption = "Tolerancia y VIF — Diagnóstico conjunto", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(which(tol_df$Tolerancia < 0.10), background = "#FADBD8") |>
  row_spec(which(tol_df$Tolerancia >= 0.10 & tol_df$Tolerancia < 0.20), background = "#FEF9E7") |>
  row_spec(which(tol_df$Tolerancia >= 0.20), background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tolerancia y VIF — Diagnóstico conjunto
Variable VIF Tolerancia Diagnostico
Puntuacion 7.4883 0.1335 Moderada
Edad 3.9673 0.2521 Sin problema
lnSalario 3.2285 0.3097 Sin problema
Potencial 4.7684 0.2097 Sin problema
Reputacion 1.4207 0.7039 Sin problema

Prueba 4: Número de Condición (κ)

  • κ < 10: Sin multicolinealidad
  • 10 ≤ κ < 30: Multicolinealidad moderada
  • κ ≥ 30: Multicolinealidad severa
X            <- scale(regresores)
eigenvalues  <- eigen(t(X) %*% X)$values
kappa_val    <- sqrt(max(eigenvalues) / min(eigenvalues))
indices_cond <- sqrt(max(eigenvalues) / eigenvalues)

cond_df <- data.frame(
  `Valor Propio`     = round(eigenvalues, 6),
  `Indice Condicion` = round(indices_cond, 4),
  Diagnostico        = case_when(
    indices_cond < 10 ~ "Sin problema",
    indices_cond < 30 ~ " Moderada",
    TRUE              ~ "Grave"
  )
)

cat("Número de Condición Global (κ):", round(kappa_val, 4), "\n")
## Número de Condición Global (κ): 6.2076
cat("Diagnóstico:",
    ifelse(kappa_val < 10, "Sin multicolinealidad",
    ifelse(kappa_val < 30, "Multicolinealidad moderada",
                           "Multicolinealidad severa")), "\n")
## Diagnóstico: Sin multicolinealidad
cond_df |>
  kable(caption = "Valores Propios e Índices de Condición de la Matriz X'X",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(which(cond_df$Diagnostico == "Grave"),       background = "#FADBD8") |>
  row_spec(which(cond_df$Diagnostico == " Moderada"),    background = "#FEF9E7") |>
  row_spec(which(cond_df$Diagnostico == "Sin problema"), background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Valores Propios e Índices de Condición de la Matriz X’X
Valor.Propio Indice.Condicion Diagnostico
544.57200 1.0000 Sin problema
263.62375 1.4373 Sin problema
123.69051 2.0983 Sin problema
48.98156 3.3344 Sin problema
14.13218 6.2076 Sin problema

Prueba 5: R² Auxiliares (Regla de Klein)

Existe multicolinealidad problemática si el R² de una regresión auxiliar supera el R² global del modelo original.

R2_global <- summary(modelo)$r.squared
vars_exog <- c("Puntuacion","Edad","lnSalario","Potencial","Reputacion")

r2_aux <- sapply(vars_exog, function(y_var) {
  summary(lm(as.formula(
    paste(y_var, "~", paste(setdiff(vars_exog, y_var), collapse = " + "))
  ), data = muestra))$r.squared
})

klein_df <- data.frame(
  Variable    = vars_exog,
  R2_Auxiliar = round(r2_aux, 4),
  R2_Global   = round(R2_global, 4),
  Klein       = ifelse(r2_aux > R2_global,
                       " R²aux > R²global → Multicolinealidad",
                       "R²aux ≤ R²global → Sin problema")
)

cat(sprintf("R² del modelo global: %.4f\n\n", R2_global))
## R² del modelo global: 0.9634
klein_df |>
  kable(caption = "Regla de Klein — R² Auxiliares vs R² Global",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(which(r2_aux > R2_global),  background = "#FEF9E7") |>
  row_spec(which(r2_aux <= R2_global), background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Regla de Klein — R² Auxiliares vs R² Global
Variable R2_Auxiliar R2_Global Klein
Puntuacion 0.8665 0.9634 R²aux ≤ R²global → Sin problema
Edad 0.7479 0.9634 R²aux ≤ R²global → Sin problema
lnSalario 0.6903 0.9634 R²aux ≤ R²global → Sin problema
Potencial 0.7903 0.9634 R²aux ≤ R²global → Sin problema
Reputacion 0.2961 0.9634 R²aux ≤ R²global → Sin problema

Prueba 6: Gráfico de Dispersión por Pares (GGpairs)

ggpairs(
  regresores,
  upper = list(continuous = wrap("cor",    size = 4,   color = "#2C3E50")),
  lower = list(continuous = wrap("smooth", alpha = 0.3, color = "#2980B9", se = FALSE)),
  diag  = list(continuous = wrap("densityDiag", fill = "#AED6F1", alpha = 0.7)),
  title = "Relaciones entre Variables Explicativas del Modelo"
) +
  theme_minimal(base_size = 11) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))
Figura 3. Matriz de dispersión entre regresores

Figura 3. Matriz de dispersión entre regresores

Resumen Diagnóstico de Multicolinealidad

resumen <- data.frame(
  Prueba = c(
    "Correlación bilateral",
    "VIF (Variable Inflation Factor)",
    "Tolerancia (TOL = 1/VIF)",
    "Número de Condición (κ)",
    "Regla de Klein (R² auxiliares)"
  ),
  `Umbral Crítico` = c(
    "|r| > 0.80",
    "VIF ≥ 10 (grave), ≥ 5 (moderado)",
    "TOL < 0.10 (grave), < 0.20 (moderado)",
    "κ ≥ 30 (grave), ≥ 10 (moderado)",
    "R²aux > R²global"
  ),
  `Resultado Obtenido` = c(
    paste0("Máx. |r| = ", round(max(abs(mat_cor[lower.tri(mat_cor)])), 3)),
    paste0("Máx. VIF = ", round(max(vif_vals), 3)),
    paste0("Mín. TOL = ", round(min(1/vif_vals), 4)),
    paste0("κ = ",        round(kappa_val, 3)),
    paste0(sum(r2_aux > R2_global), " variable(s) con R²aux > R²global")
  ),
  Diagnostico = c(
    ifelse(max(abs(mat_cor[lower.tri(mat_cor)])) > 0.80, " Correlación alta", " Aceptable"),
    ifelse(max(vif_vals) >= 10, " Grave", ifelse(max(vif_vals) >= 5, " Moderada", " Sin problema")),
    ifelse(min(1/vif_vals) < 0.10, " Grave", ifelse(min(1/vif_vals) < 0.20, " Moderada", " Sin problema")),
    ifelse(kappa_val >= 30, " Grave", ifelse(kappa_val >= 10, " Moderada", " Sin problema")),
    ifelse(any(r2_aux > R2_global), " Posible multicolinealidad", " Sin problema")
  )

)

resumen |>
  kable(caption = "Tabla Resumen: Diagnóstico de Multicolinealidad",
        col.names = c("Prueba","Umbral Crítico","Resultado","Diagnóstico"), align = "l") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = TRUE) |>
  column_spec(4, bold = TRUE) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Tabla Resumen: Diagnóstico de Multicolinealidad
Prueba Umbral Crítico Resultado Diagnóstico
Correlación bilateral &#124;r&#124; > 0.80 Máx. &#124;r&#124; = 0.821 Correlación alta
VIF (Variable Inflation Factor) VIF ≥ 10 (grave), ≥ 5 (moderado) Máx. VIF = 7.488 Moderada
Tolerancia (TOL = 1/VIF) TOL < 0.10 (grave), < 0.20 (moderado) Mín. TOL = 0.1335 Moderada
Número de Condición (κ) κ ≥ 30 (grave), ≥ 10 (moderado) κ = 6.208 Sin problema
Regla de Klein (R² auxiliares) R²aux > R²global 0 variable(s) con R²aux > R²global Sin problema

Conclusión

Con base en los resultados de las cinco pruebas aplicadas:

  1. Matriz de correlaciones: El par de regresores con mayor correlación bilateral presenta un coeficiente de 0.821, lo que supera el umbral de |r| > 0.80, sugiriendo correlación elevada.

  2. VIF: El valor máximo obtenido fue de 7.49. Esto señala una multicolinealidad moderada que merece atención.

  3. Número de condición: κ = 6.21, lo que indica ausencia de multicolinealidad sistémica.

Pruebas de Normalidad

Fundamento Teórico

Uno de los supuestos del MCRLM es que el término de error sigue una distribución normal: \(\varepsilon_i \sim N(0, \sigma^2)\). Este supuesto es necesario para que las pruebas t y F de hipótesis sean válidas en muestras pequeñas. Se aplican tres pruebas sobre los residuos del modelo estimado.

residuos <- residuals(modelo)

par(mfrow = c(1, 2))
hist(residuos, breaks = 20, col = "steelblue", border = "white",
     main = "Histograma de Residuos", xlab = "Residuos")
curve(dnorm(x, mean(residuos), sd(residuos)) * length(residuos) * diff(range(residuos))/20,
      add = TRUE, col = "red", lwd = 2)
qqnorm(residuos, main = "Q-Q Plot de Residuos")
qqline(residuos, col = "red", lwd = 2)

Prueba de Jarque-Bera

\[JB = \frac{n}{6}\left(S^2 + \frac{(K-3)^2}{4}\right)\]

donde \(S\) = asimetría y \(K\) = curtosis de los residuos. \(H_0\): los residuos son normales.

options(scipen = 999)
jb_test <- jarque.bera.test(residuos)
print(jb_test)
## 
##  Jarque Bera Test
## 
## data:  residuos
## X-squared = 252.84, df = 2, p-value < 0.00000000000000022
data.frame(
  Estadístico = round(jb_test$statistic, 4),
  `p-valor`   = round(jb_test$p.value, 6),
  Conclusión  = ifelse(jb_test$p.value < 0.05,
                       "Se rechaza H₀ → No normalidad",
                       "No se rechaza H₀ → Normalidad")
) |>
  kable(caption = "Prueba de Jarque-Bera", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Prueba de Jarque-Bera
Estadístico p.valor Conclusión
252.8399 0 Se rechaza H₀ → No normalidad

Prueba de Kolmogorov-Smirnov (KS)

Compara la distribución empírica de los residuos con una distribución normal teórica con la misma media y desviación estándar. \(H_0\): los residuos siguen una distribución normal.

options(scipen = 999)
ks_test <- ks.test(residuos, "pnorm",
                   mean = mean(residuos),
                   sd   = sd(residuos))
print(ks_test)
## 
##  Asymptotic one-sample Kolmogorov-Smirnov test
## 
## data:  residuos
## D = 0.1174, p-value = 0.008064
## alternative hypothesis: two-sided
data.frame(
  Estadístico = round(ks_test$statistic, 4),
  `p-valor`   = round(ks_test$p.value, 6),
  Conclusión  = ifelse(ks_test$p.value < 0.05,
                       "Se rechaza H₀ → No normalidad",
                       "No se rechaza H₀ → Normalidad")
) |>
  kable(caption = "Prueba de Kolmogorov-Smirnov", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Prueba de Kolmogorov-Smirnov
Estadístico p.valor Conclusión
0.1174 0.008064 Se rechaza H₀ → No normalidad

Prueba de Shapiro-Wilk

La más potente para muestras pequeñas y medianas (n ≤ 5000). \(H_0\): los residuos provienen de una distribución normal.

options(scipen = 9999)
sw_test <- shapiro.test(residuos)
print(sw_test)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.90535, p-value = 0.0000000005579
data.frame(
  Estadístico = round(sw_test$statistic, 4),
  `p-valor`   = round(sw_test$p.value, 6),
  Conclusión  = ifelse(sw_test$p.value < 0.05,
                       "Se rechaza H₀ → No normalidad",
                       "No se rechaza H₀ → Normalidad")
) |>
  kable(caption = "Prueba de Shapiro-Wilk", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Prueba de Shapiro-Wilk
Estadístico p.valor Conclusión
0.9053 0 Se rechaza H₀ → No normalidad

Resumen y Conclusión — Normalidad

resumen_norm <- data.frame(
  Prueba      = c("Jarque-Bera", "Kolmogorov-Smirnov", "Shapiro-Wilk"),
  Estadístico = round(c(jb_test$statistic, ks_test$statistic, sw_test$statistic), 4),
  `p-valor`   = round(c(jb_test$p.value,   ks_test$p.value,   sw_test$p.value),   6),
  Decisión    = ifelse(c(jb_test$p.value, ks_test$p.value, sw_test$p.value) < 0.05,
                      " Rechaza H₀", "No rechaza H₀")
)

resumen_norm |>
  kable(caption = "Resumen Pruebas de Normalidad (α = 0.05)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) |>
  row_spec(which(c(jb_test$p.value, ks_test$p.value, sw_test$p.value) < 0.05),
           background = "#FADBD8") |>
  row_spec(which(c(jb_test$p.value, ks_test$p.value, sw_test$p.value) >= 0.05),
           background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Resumen Pruebas de Normalidad (α = 0.05)
Prueba Estadístico p.valor Decisión
Jarque-Bera 252.8399 0.000000 Rechaza H₀
Kolmogorov-Smirnov 0.1174 0.008064 Rechaza H₀
Shapiro-Wilk 0.9053 0.000000 Rechaza H₀

Las tres pruebas rechazan la hipótesis nula de normalidad al 5%. Los residuos presentan una distribución no normal, lo que puede afectar la validez de las pruebas de hipótesis individuales. Como medida correctiva, en la Parte 3 se construirá una matriz de covarianzas robusta mediante estimadores HAC, que son válidos sin requerir el supuesto de normalidad.

Prueba de Heterocedatiscidad de White

Fundamento Teórico

La homocedasticidad exige que la varianza del error sea constante para todas las observaciones: \(Var(\varepsilon_i) = \sigma^2\). Cuando esto no se cumple (heterocedasticidad), los estimadores MCO siguen siendo insesgados pero dejan de ser eficientes, y los errores estándar son incorrectos, invalidando las pruebas t y F.

La prueba de White (1980) es más general que Breusch-Pagan: incluye los cuadrados y productos cruzados de los regresores como variables auxiliares, sin asumir una forma específica de heterocedasticidad.

\(H_0\): homocedasticidad (varianza constante)
\(H_1\): heterocedasticidad

Aplicación de la Prueba de White

white_test <- bptest(modelo,
  varformula = ~ Puntuacion + Edad + lnSalario + Potencial + Reputacion +
                 I(Puntuacion^2) + I(Edad^2) + I(lnSalario^2) +
                 I(Potencial^2)  + I(Reputacion^2) +
                 Puntuacion:Edad + Puntuacion:lnSalario +
                 Puntuacion:Potencial + Puntuacion:Reputacion +
                 Edad:lnSalario  + Edad:Potencial + Edad:Reputacion +
                 lnSalario:Potencial + lnSalario:Reputacion +
                 Potencial:Reputacion,
  data = muestra)

print(white_test)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo
## BP = 133.7, df = 20, p-value < 0.00000000000000022
data.frame(
  `Estadístico BP` = round(white_test$statistic, 4),
  `Grados de libertad` = white_test$parameter,
  `p-valor`  = round(white_test$p.value, 6),
  Conclusión = ifelse(white_test$p.value < 0.05,
                       "Rechaza H₀ → Heterocedasticidad",
                      "No rechaza H₀ → Homocedasticidad")
) |>
  kable(caption = "Prueba de Heterocedasticidad de White", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(1,
    background = ifelse(white_test$p.value < 0.05, "#FADBD8", "#EAFAF1")) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Prueba de Heterocedasticidad de White
Estadístico.BP Grados.de.libertad p.valor Conclusión
133.7018 20 0 Rechaza H₀ → Heterocedasticidad

Gráfico de Residuos vs Valores Ajustados

par(mfrow = c(1, 2))

plot(fitted(modelo), residuals(modelo),
     main = "Residuos vs Valores Ajustados",
     xlab = "Valores ajustados (ŷ)", ylab = "Residuos",
     col = "steelblue", pch = 16, cex = 0.7)
abline(h = 0, col = "red", lwd = 2, lty = 2)

plot(fitted(modelo), sqrt(abs(residuals(modelo))),
     main = "Scale-Location",
     xlab = "Valores ajustados (ŷ)", ylab = "√|Residuos|",
     col = "darkorange", pch = 16, cex = 0.7)
abline(lm(sqrt(abs(residuals(modelo))) ~ fitted(modelo)),
       col = "red", lwd = 2)

Conclusión — Heterocedasticidad

La prueba de White reporta un estadístico BP = 133.702 con p-valor = 0. Al ser p < 0.05, se rechaza H₀ de homocedasticidad. Existe evidencia de heterocedasticidad en los residuos del modelo, lo que implica que la varianza del error no es constante a lo largo de las observaciones. Esta violación no invalida la insesgadez de los estimadores MCO, pero sí hace que los errores estándar sean incorrectos. Como medida correctiva, en la Parte 3 se estimará el modelo con errores estándar robustos (HAC) que son válidos en presencia de heterocedasticidad y/o autocorrelación.

Pruebas de autocorrelación.

Fundamento Teórico

La autocorrelación implica que los errores del modelo están correlacionados entre sí: \(Cov(\varepsilon_i, \varepsilon_j) \neq 0\) para \(i \neq j\). Aunque es más común en series de tiempo, puede aparecer en corte transversal cuando las observaciones tienen algún orden natural (ranking, posiciones). Al igual que la heterocedasticidad, no invalida la insesgadez de MCO pero sí la eficiencia y la validez de los errores estándar.

Se aplican dos pruebas:

  • Durbin-Watson (DW): detecta autocorrelación de primer orden (\(AR(1)\)).
  • Multiplicador de Lagrange de Breusch-Godfrey (BG): más general, detecta autocorrelación de orden p (se aplica para órdenes 1 y 2).

Prueba de Durbin-Watson

\[DW = \frac{\sum_{t=2}^{n}(\hat{\varepsilon}_t - \hat{\varepsilon}_{t-1})^2}{\sum_{t=1}^{n}\hat{\varepsilon}_t^2}\]

El estadístico DW toma valores entre 0 y 4:
- DW ≈ 2: no hay autocorrelación
- DW < 1.5: autocorrelación positiva
- DW > 2.5: autocorrelación negativa

\(H_0\): no hay autocorrelación de primer orden

dw_test <- dwtest(modelo)
print(dw_test)
## 
##  Durbin-Watson test
## 
## data:  modelo
## DW = 2.0121, p-value = 0.5386
## alternative hypothesis: true autocorrelation is greater than 0
data.frame(
  `Estadístico DW` = round(dw_test$statistic, 4),
  `p-valor`        = round(dw_test$p.value, 6),
  Diagnóstico      = case_when(
    dw_test$statistic < 1.5 ~ "Autocorrelación positiva",
    dw_test$statistic > 2.5 ~ "Autocorrelación negativa",
    TRUE                    ~ "Sin autocorrelación aparente"
  ),
  Conclusión = ifelse(dw_test$p.value < 0.05,
                      "Se rechaza H₀ → Autocorrelación AR(1)",
                       "No rechaza H₀ → Sin autocorrelación AR(1)")
) |>
  kable(caption = "Prueba de Durbin-Watson", row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(1,
    background = ifelse(dw_test$p.value < 0.05, "#FADBD8", "#EAFAF1")) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Prueba de Durbin-Watson
Estadístico.DW p.valor Diagnóstico Conclusión
2.0121 0.538627 Sin autocorrelación aparente No rechaza H₀ → Sin autocorrelación AR(1)

Multiplicador de Lagrange — Orden 1 (Breusch-Godfrey)

bg1 <- bgtest(modelo, order = 1)
print(bg1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  modelo
## LM test = 0.026182, df = 1, p-value = 0.8715
data.frame(
  `Estadístico LM` = round(bg1$statistic, 4),
  `Grados libertad` = bg1$parameter,
  `p-valor`         = round(bg1$p.value, 6),
  Conclusión        = ifelse(bg1$p.value < 0.05,
                             " Rechaza H₀ → Autocorrelación orden 1",
                             " No rechaza H₀ → Sin autocorrelación orden 1")

) |>
  kable(caption = "Prueba BG — Multiplicador de Lagrange (Orden 1)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(1,
    background = ifelse(bg1$p.value < 0.05, "#FADBD8", "#EAFAF1")) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Prueba BG — Multiplicador de Lagrange (Orden 1)
Estadístico.LM Grados.libertad p.valor Conclusión
0.0262 1 0.871458 No rechaza H₀ → Sin autocorrelación orden 1

Multiplicador de Lagrange — Orden 2 (Breusch-Godfrey)

bg2 <- bgtest(modelo, order = 2)
print(bg2)
## 
##  Breusch-Godfrey test for serial correlation of order up to 2
## 
## data:  modelo
## LM test = 2.6952, df = 2, p-value = 0.2599
data.frame(
  `Estadístico LM`  = round(bg2$statistic, 4),
  `Grados libertad` = bg2$parameter,
  `p-valor`         = round(bg2$p.value, 6),
  Conclusión        = ifelse(bg2$p.value < 0.05,
                             " Rechaza H₀ → Autocorrelación orden 2",
                             " No rechaza H₀ → Sin autocorrelación orden 2")

) |>
  kable(caption = "Prueba BG — Multiplicador de Lagrange (Orden 2)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(1,
    background = ifelse(bg2$p.value < 0.05, "#FADBD8", "#EAFAF1")) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Prueba BG — Multiplicador de Lagrange (Orden 2)
Estadístico.LM Grados.libertad p.valor Conclusión
2.6952 2 0.259866 No rechaza H₀ → Sin autocorrelación orden 2

Gráfico de Residuos en Orden de Observación

par(mfrow = c(1, 2))

plot(residuos, type = "l", col = "steelblue", lwd = 1.2,
     main = "Residuos por orden de observación",
     xlab = "Observación", ylab = "Residuo")
abline(h = 0, col = "red", lty = 2, lwd = 1.5)

acf(residuos, main = "ACF de Residuos", col = "steelblue", lwd = 2)

Resumen y Conclusión — Autocorrelación

resumen_ac <- data.frame(
  Prueba      = c("Durbin-Watson (AR1)",
                  "Breusch-Godfrey orden 1",
                  "Breusch-Godfrey orden 2"),
  Estadístico = round(c(dw_test$statistic, bg1$statistic, bg2$statistic), 4),
  `p-valor`   = round(c(dw_test$p.value,   bg1$p.value,   bg2$p.value),   6),
  Decisión    = ifelse(c(dw_test$p.value, bg1$p.value, bg2$p.value) < 0.05,
                       " Rechaza H₀", " No rechaza H₀")
)

resumen_ac |>
  kable(caption = "Resumen Pruebas de Autocorrelación (α = 0.05)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) |>
  row_spec(which(c(dw_test$p.value, bg1$p.value, bg2$p.value) < 0.05),
           background = "#FADBD8") |>
  row_spec(which(c(dw_test$p.value, bg1$p.value, bg2$p.value) >= 0.05),
           background = "#EAFAF1") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Resumen Pruebas de Autocorrelación (α = 0.05)
Prueba Estadístico p.valor Decisión
Durbin-Watson (AR1) 2.0121 0.538627 No rechaza H₀
Breusch-Godfrey orden 1 0.0262 0.871458 No rechaza H₀
Breusch-Godfrey orden 2 2.6952 0.259866 No rechaza H₀

Las tres pruebas de autocorrelación no rechazan H₀ al nivel del 5%. No existe evidencia de estructuras de autocorrelación de primer ni segundo orden en los residuos del modelo. El supuesto de no autocorrelación del MCRLM se cumple, lo que valida la eficiencia de los estimadores MCO y la correcta construcción de los errores estándar.

CORRECCIONES Y SIMULACIÓN

Aplicación de Medidas Correctivas — Errores Estándar Robustos HAC

Justificación

Con base en los resultados de la Parte 2, se identificaron posibles violaciones a los supuestos de homocedasticidad y no autocorrelación del MCRLM. Los errores estándar MCO convencionales son inconsistentes bajo estas condiciones, invalidando las pruebas t y F. La solución adoptada es estimar una matriz de covarianzas robusta HAC (Heteroskedasticity and Autocorrelation Consistent) mediante el estimador de Newey-West (1987), que corrige ambos problemas simultáneamente sin necesidad de especificar la forma exacta de ninguna de las dos violaciones.

Estimación con Errores HAC

options(scipen = 999)
hac_vcov   <- vcovHAC(modelo)
modelo_hac <- coeftest(modelo, vcov = hac_vcov)
print(modelo_hac)
## 
## t test of coefficients:
## 
##               Estimate Std. Error t value              Pr(>|t|)    
## (Intercept)  4.2274578  0.4694040  9.0060 < 0.00000000000000022 ***
## Puntuacion   0.1905438  0.0104644 18.2087 < 0.00000000000000022 ***
## Edad        -0.1298975  0.0160881 -8.0741   0.00000000000007021 ***
## lnSalario    0.0479639  0.0218808  2.1921              0.029565 *  
## Potencial   -0.0026185  0.0100428 -0.2607              0.794578    
## Reputacion   0.1713938  0.0476449  3.5973              0.000408 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Comparación MCO Estándar vs HAC

options(scipen = 999)
mco_sum <- summary(modelo)$coefficients

comp_df <- data.frame(
  Variable   = rownames(mco_sum),
  Coef       = round(mco_sum[, 1], 5),
  SE_MCO     = round(mco_sum[, 2], 5),
  p_MCO      = round(mco_sum[, 4], 5),
  SE_HAC     = round(modelo_hac[, 2], 5),
  p_HAC      = round(modelo_hac[, 4], 5),
  Sig_MCO    = ifelse(mco_sum[, 4] < 0.01, "***",
               ifelse(mco_sum[, 4] < 0.05, "**",
               ifelse(mco_sum[, 4] < 0.10, "*", ""))),
  Sig_HAC    = ifelse(modelo_hac[, 4] < 0.01, "***",
               ifelse(modelo_hac[, 4] < 0.05, "**",
               ifelse(modelo_hac[, 4] < 0.10, "*", "")))
)

colnames(comp_df) <- c("Variable", "Coeficiente",
                        "SE MCO", "p-val MCO",
                        "SE HAC", "p-val HAC",
                        "Sig. MCO", "Sig. HAC")

comp_df |>
 kable(caption = "Comparacion: Errores Estandar MCO vs HAC (Newey-West)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = TRUE) |>
  column_spec(4, bold = TRUE,
    color = ifelse(mco_sum[,4] < 0.05, "#27AE60", "#E74C3C")) |>
  column_spec(6, bold = TRUE,
    color = ifelse(modelo_hac[,4] < 0.05, "#27AE60", "#E74C3C")) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Comparacion: Errores Estandar MCO vs HAC (Newey-West)
Variable Coeficiente SE MCO p-val MCO SE HAC p-val HAC Sig. MCO Sig. HAC
(Intercept) 4.22746 0.31708 0.00000 0.46940 0.00000 *** ***
Puntuacion 0.19054 0.00691 0.00000 0.01046 0.00000 *** ***
Edad -0.12990 0.00737 0.00000 0.01609 0.00000 *** ***
lnSalario 0.04796 0.02311 0.03927 0.02188 0.02957 ** **
Potencial -0.00262 0.00613 0.66988 0.01004 0.79458
Reputacion 0.17139 0.05451 0.00193 0.04764 0.00041 *** ***

La corrección HAC modifica los errores estándar de forma relevante (> 10%) en: (Intercept), Puntuacion, Edad, Potencial, Reputacion. Esto confirma que las violaciones detectadas en la Parte 2 afectan la precisión de la inferencia MCO convencional. Los resultados con errores HAC son los válidos para la interpretación final del modelo.

Pruebas de Hipótesis de los Parámetros

Pruebas Individuales con Errores HAC

Para cada parámetro \(\beta_k\) se contrasta: \[H_0: \beta_k = 0 \quad \text{vs} \quad H_1: \beta_k \neq 0\]

options(scipen = 999)

hip_df <- data.frame(
  Parámetro   = rownames(modelo_hac),
  Coeficiente = round(modelo_hac[, 1], 5),
  SE_HAC      = round(modelo_hac[, 2], 5),
  t_stat      = round(modelo_hac[, 3], 4),
  p_valor     = round(modelo_hac[, 4], 6),
  Decisión    = ifelse(modelo_hac[, 4] < 0.01,  "*** Sig. al 1%",
                ifelse(modelo_hac[, 4] < 0.05,  "**  Sig. al 5%",
                ifelse(modelo_hac[, 4] < 0.10,  "*   Sig. al 10%",
                                                "    No significativo"))),
  Signo_esp   = c("N/A", "+", "+/-", "+", "+", "+")
)

colnames(hip_df) <- c("Parametro", "Coeficiente", "Error Std. HAC",
                       "t-stat", "p-valor", "Decision", "Signo esp.")

hip_df |>
 kable(caption = "Pruebas de Hipotesis Individuales con Errores HAC (a = 0.05)",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE) |>
  row_spec(which(modelo_hac[, 4] < 0.05),  background = "#EAFAF1") |>
  row_spec(which(modelo_hac[, 4] >= 0.05), background = "#FADBD8") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Pruebas de Hipotesis Individuales con Errores HAC (a = 0.05)
Parametro Coeficiente Error Std. HAC t-stat p-valor Decision Signo esp. 
(Intercept) 4.22746 0.46940 9.0060 0.000000 *** Sig. al 1% N/A
Puntuacion 0.19054 0.01046 18.2087 0.000000 *** Sig. al 1%
Edad -0.12990 0.01609 -8.0741 0.000000 *** Sig. al 1% +/-
lnSalario 0.04796 0.02188 2.1921 0.029565 ** Sig. al 5%
Potencial -0.00262 0.01004 -0.2607 0.794578 No significativo
Reputacion 0.17139 0.04764 3.5973 0.000408 *** Sig. al 1%

Prueba Global F

\[H_0: \beta_1 = \beta_2 = \beta_3 = \beta_4 = \beta_5 = 0\]

options(scipen = 999)
f_stat   <- summary(modelo)$fstatistic
f_valor  <- f_stat[1]
f_df1    <- f_stat[2]
f_df2    <- f_stat[3]
f_pvalue <- pf(f_valor, f_df1, f_df2, lower.tail = FALSE)
r2       <- summary(modelo)$r.squared
r2_adj   <- summary(modelo)$adj.r.squared

data.frame(
 Metrica = c("R2", "R2 ajustado", "Estadistico F",
            "Grados de libertad", "p-valor F"),
  Valor   = c(round(r2, 4), round(r2_adj, 4), round(f_valor, 4),
              paste0(f_df1, " y ", f_df2),
              round(f_pvalue, 8))
) |>
  kable(caption = "Prueba Global de Significancia del Modelo",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Prueba Global de Significancia del Modelo
Metrica Valor
R2 0.9634
R2 ajustado 0.9624
Estadistico F 1021.0233
Grados de libertad 5 y 194
p-valor F 0

Con F = 1021.023 y p-valor = 0, se rechaza H₀ al 1% de significancia. El modelo en conjunto es estadísticamente significativo. El R² = 0.9634 indica que el modelo explica el 96.3% de la variabilidad en ln(Valor de mercado). El R² ajustado = 0.9624 confirma el buen ajuste penalizando el número de regresores.

Interpretación de los Coeficientes

El modelo está en forma semi-logarítmica (ln(Valor) como variable dependiente), por lo que cada coeficiente representa la variación porcentual aproximada en el valor de mercado ante un cambio unitario en el regresor, ceteris paribus:

  • Puntuacion (OVA): Un punto adicional en la calificacion global se asocia con un aumento aproximado del 19.05% en el valor de mercado (significativo al 5%).

  • Edad: Un año adicional de edad se asocia con un cambio del -12.99% en el valor (significativo al 5%).

  • ln(Salario): Un incremento del 1% en el salario semanal se asocia con un 4.8% de cambio en el valor de mercado (significativo al 5%).

  • Potencial (POT): Un punto adicional en el potencial se asocia con un -0.26% de cambio en el valor (no significativo al 5%).

  • Reputación (IR): Un nivel adicional de reputación internacional se asocia con un 17.14% de cambio en el valor (significativo al 5%).

Intervalos de Confianza para los Parámetros

options(scipen = 999)
ic_mco <- confint(modelo, level = 0.95)
ic_hac <- coefci(modelo, vcov = hac_vcov, level = 0.95)

ic_df <- data.frame(
  Parametro = rownames(ic_mco),
  Coeficiente  = round(coef(modelo), 5),
  IC_MCO_inf   = round(ic_mco[, 1], 5),
  IC_MCO_sup   = round(ic_mco[, 2], 5),
  IC_HAC_inf   = round(ic_hac[, 1], 5),
  IC_HAC_sup   = round(ic_hac[, 2], 5)
)

colnames(ic_df) <- c("Parametro", "Coeficiente",
                      "IC MCO inf (2.5%)", "IC MCO sup (97.5%)",
                      "IC HAC inf (2.5%)", "IC HAC sup (97.5%)")

ic_df |>
  kable(caption = "Intervalos de Confianza al 95% - MCO Estandar vs HAC",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = TRUE) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Intervalos de Confianza al 95% - MCO Estandar vs HAC
Parametro Coeficiente IC MCO inf (2.5%) IC MCO sup (97.5%) IC HAC inf (2.5%) IC HAC sup (97.5%)
(Intercept) 4.22746 3.60210 4.85281 3.30167 5.15325
Puntuacion 0.19054 0.17692 0.20417 0.16991 0.21118
Edad -0.12990 -0.14444 -0.11536 -0.16163 -0.09817
lnSalario 0.04796 0.00238 0.09355 0.00481 0.09112
Potencial -0.00262 -0.01471 0.00948 -0.02243 0.01719
Reputacion 0.17139 0.06388 0.27891 0.07743 0.26536 
vars_plot <- rownames(ic_hac)[-1]

ic_plot_df <- data.frame(
  Variable = rep(vars_plot, 2),
  Tipo = rep(c("MCO estandar", "HAC Newey-West"), each = length(vars_plot)),
  Coef = rep(coef(modelo)[-1], 2),
  LI = c(ic_mco[-1, 1], ic_hac[-1, 1]),
  LS = c(ic_mco[-1, 2], ic_hac[-1, 2])
)

ggplot(ic_plot_df, aes(x = Variable, y = Coef, color = Tipo, shape = Tipo)) +
  geom_point(position = position_dodge(0.5), size = 3.5) +
  geom_errorbar(aes(ymin = LI, ymax = LS),
                width = 0.25, linewidth = 0.9,
                position = position_dodge(0.5)) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
  scale_color_manual(values = c("steelblue", "#E74C3C")) +
  labs(title = "IC al 95% por Parametro",
       subtitle = "MCO estandar vs HAC",
       x = "Regresor", y = "Coeficiente",
       color = "Metodo", shape = "Metodo") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "top")

Un IC que no cruza el cero indica que el parámetro es significativamente distinto de cero al 95% de confianza.

Con errores HAC, los parámetros de Puntuacion, Edad, lnSalario, Reputacion tienen IC que no cruzan el cero: son estadísticamente significativos.

Los parámetros de Potencial tienen IC que cruzan el cero con la corrección HAC: no son significativamente distintos de cero al 5%.

Análisis de Simulación Bootstrap (5,000 iteraciones)

Metodología y Medidas de Desempeño

data.frame(
  Medida = c("ECM - Error Cuadratico Medio",
             "RECM - Raiz del ECM",
             "EAM - Error Absoluto Medio",
             "EPM - Error Porcentual Medio",
             "MAPE - Error Porcentual Abs. Medio"),
  Formula = c("mean(e^2)",
              "sqrt(mean(e^2))",
              "mean(|e|)",
              "mean(e/Y) x 100",
              "mean(|e/Y|) x 100"),
  Interpretacion = c("Penaliza errores grandes",
                     "En las mismas unidades que Y",
                     "Error promedio en valor absoluto",
                     "Sesgo direccional del modelo",
                     "Error relativo promedio")
) |>
  kable(caption = "Medidas de desempeno predictivo evaluadas en la simulacion",
        row.names = FALSE, align = "l") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) |>
  column_spec(1, bold = TRUE) |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Medidas de desempeno predictivo evaluadas en la simulacion
Medida Formula Interpretacion
ECM - Error Cuadratico Medio mean(e^2) Penaliza errores grandes
RECM - Raiz del ECM sqrt(mean(e^2)) En las mismas unidades que Y
EAM - Error Absoluto Medio mean(&#124;e&#124;) Error promedio en valor absoluto
EPM - Error Porcentual Medio mean(e/Y) x 100 Sesgo direccional del modelo
MAPE - Error Porcentual Abs. Medio mean(&#124;e/Y&#124;) x 100 Error relativo promedio

En cada una de las 5,000 iteraciones se divide la muestra aleatoriamente en 80% entrenamiento / 20% prueba, se estima el modelo con los datos de entrenamiento y se calculan las cinco medidas sobre el conjunto de prueba.

Ejecución de la Simulación

set.seed(42)
n_iter  <- 5000
n_obs   <- nrow(muestra)
n_train <- round(0.80 * n_obs)

resultados_sim <- matrix(NA, nrow = n_iter, ncol = 5)
colnames(resultados_sim) <- c("ECM","RECM","EAM","EPM","MAPE")

for (i in 1:n_iter) {
  idx   <- sample(1:n_obs, size = n_train, replace = FALSE)
  train <- muestra[idx, ]
  test  <- muestra[-idx, ]

  mod  <- lm(lnValor ~ Puntuacion + Edad + lnSalario + Potencial + Reputacion,
             data = train)
  pred <- predict(mod, newdata = test)
  e    <- test$lnValor - pred

  resultados_sim[i, "ECM"]  <- mean(e^2)
  resultados_sim[i, "RECM"] <- sqrt(mean(e^2))
  resultados_sim[i, "EAM"]  <- mean(abs(e))
  resultados_sim[i, "EPM"]  <- mean(e / test$lnValor) * 100
  resultados_sim[i, "MAPE"] <- mean(abs(e / test$lnValor)) * 100
}

sim_df <- as.data.frame(resultados_sim)
cat("Simulación completada:", n_iter, "iteraciones — partición 80/20\n")
## Simulación completada: 5000 iteraciones — partición 80/20

Resultados de Desempeño Predictivo

options(scipen = 999)

resumen_sim <- data.frame(
  Medida   = c("ECM", "RECM", "EAM", "EPM (%)", "MAPE (%)"),
  Media    = round(colMeans(sim_df),               5),
  Mediana  = round(apply(sim_df, 2, median),       5),
  Desv_Est = round(apply(sim_df, 2, sd),           5),
  P5       = round(apply(sim_df, 2, quantile, .05),5),
  P95      = round(apply(sim_df, 2, quantile, .95),5)
)

colnames(resumen_sim) <- c("Medida", "Media", "Mediana",
                            "Desv. Est.", "Percentil 5", "Percentil 95")

resumen_sim |>
  kable(caption = paste0("Desempeño predictivo — ", n_iter,
                         " iteraciones Bootstrap (80/20)"),
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover","condensed"),
                full_width = FALSE) |>
  row_spec(5, bold = TRUE, background = "#EBF5FB") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Desempeño predictivo — 5000 iteraciones Bootstrap (80/20)
Medida Media Mediana Desv. Est. Percentil 5 Percentil 95
ECM 0.06010 0.05748 0.02352 0.02975 0.10187
RECM 0.24062 0.23974 0.04694 0.17249 0.31918
EAM 0.16938 0.16793 0.02452 0.13159 0.21213
EPM (%) -0.04094 -0.02891 0.32969 -0.61768 0.48517
MAPE (%) 1.24493 1.23062 0.19479 0.95337 1.58175

Distribución de las Medidas

par(mfrow = c(2, 3))

colores <- c("steelblue","darkorange","darkgreen","purple","#E74C3C")
titulos <- c("ECM","RECM","EAM","EPM (%)","MAPE (%)")

for (i in 1:5) {
  hist(sim_df[[i]], breaks = 60, col = colores[i], border = "white",
       main = titulos[i], xlab = titulos[i], cex.main = 1.1)
  abline(v = mean(sim_df[[i]]), col = "black", lwd = 2, lty = 2)
}

# Convergencia del MAPE
mape_acum <- cumsum(sim_df$MAPE) / seq_along(sim_df$MAPE)
plot(mape_acum, type = "l", col = "steelblue", lwd = 1.5,
     main = "Convergencia MAPE acumulado",
     xlab = "Iteración", ylab = "MAPE promedio acumulado (%)")
abline(h = mean(sim_df$MAPE), col = "red", lwd = 2, lty = 2)
legend("topright", legend = paste0("Media = ", round(mean(sim_df$MAPE), 3), "%"),
       col = "red", lty = 2, lwd = 2, bty = "n")

Conclusión — Simulación

Con base en las 5000 iteraciones de validacion cruzada bootstrap:

  • MAPE medio = 1.245%: La capacidad predictiva del modelo es excelente. En promedio, el pronostico del ln(Valor) se desvia un 1.245% del valor real.

  • RECM medio = 0.24062: Confirma un error cuadratico consistente y estable a traves de las particiones.

  • EAM medio = 0.16938: El error absoluto promedio de prediccion en escala logaritmica.

  • EPM medio = -0.041%: El modelo no presenta sesgo sistematico de prediccion.

La grafica de convergencia del MAPE acumulado confirma la estabilidad del modelo: a partir de aproximadamente 1,000 iteraciones el promedio se estabiliza, validando que 5,000 iteraciones son suficientes para obtener estimaciones confiables del desempeno predictivo.

Proyecciones para Perfiles de Jugadores

options(scipen = 999)

perfiles <- data.frame(
  Perfil = c("Joven promesa", "Titular consolidado", "Estrella mundial",
             "Veterano experimentado", "Mediocampista estandar"),
  Puntuacion = c(72, 82, 91, 80, 76),
  Edad       = c(20, 26, 28, 33, 25),
  lnSalario  = c(log(5000), log(25000), log(150000), log(50000), log(10000)),
  Potencial  = c(85, 86, 93, 81, 82),
  Reputacion = c(1, 3, 5, 3, 2)
)

pred_ic <- predict(modelo,
  newdata  = perfiles[, c("Puntuacion","Edad","lnSalario","Potencial","Reputacion")],
  interval = "prediction", level = 0.95)

proy_df <- data.frame(
  Perfil        = perfiles$Perfil,
  ln_Valor_est  = round(pred_ic[, "fit"], 4),
  Valor_est_EUR = format(round(exp(pred_ic[, "fit"])), big.mark = ","),
  IC_inf_95     = format(round(exp(pred_ic[, "lwr"])), big.mark = ","),
  IC_sup_95     = format(round(exp(pred_ic[, "upr"])), big.mark = ",")
)

colnames(proy_df) <- c("Perfil", "ln(Valor) est.",
                        "Valor est. (EUR)",
                        "IC inf. 95% (EUR)",
                        "IC sup. 95% (EUR)")

proy_df |>
  kable(caption = "Proyecciones de Valor de Mercado para Perfiles Hipoteticos",
        row.names = FALSE, align = "c") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE) |>
  row_spec(3, bold = TRUE, background = "#EBF5FB") |>
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Proyecciones de Valor de Mercado para Perfiles Hipoteticos
Perfil ln(Valor) est. Valor est. (EUR) IC inf. 95% (EUR) IC sup. 95% (EUR)
Joven promesa 15.7060 6,622,612 4,123,845 10,635,461
Titular consolidado 17.2494 30,997,490 18,806,023 51,092,373
Estrella mundial 19.1149 200,217,252 110,797,605 361,803,380
Veterano experimentado 16.0054 8,934,091 5,429,588 14,700,560
Mediocampista estandar 16.0312 9,167,571 5,704,261 14,733,611 
proy_plot <- data.frame(
  Perfil = perfiles$Perfil,
  Est = exp(pred_ic[, "fit"]) / 1e6,
  LI  = exp(pred_ic[, "lwr"]) / 1e6,
  LS  = exp(pred_ic[, "upr"]) / 1e6
)

ggplot(proy_plot, aes(x = reorder(Perfil, Est), y = Est)) +
  geom_col(fill = "steelblue", alpha = 0.85, width = 0.6) +
  geom_errorbar(aes(ymin = LI, ymax = LS),
                width = 0.3, color = "#E74C3C", linewidth = 1) +
  geom_text(aes(label = paste0("EUR ", round(Est, 1), "M")),
            hjust = -0.15, fontface = "bold", size = 3.8) +
  coord_flip(ylim = c(0, max(proy_plot$LS) * 1.2)) +
  labs(title    = "Valor de Mercado Estimado por Perfil de Jugador",
       subtitle = "Barras: estimacion puntual | Lineas: IC prediccion al 95%",
       x = NULL, y = "Valor estimado (millones EUR)") +
  theme_minimal(base_size = 12) +
  theme(plot.title    = element_text(face = "bold", hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5, color = "grey40"))

Las proyecciones reflejan correctamente la jerarquía esperada de valores de mercado según los atributos de cada perfil:

  • La estrella mundial (OVA=91, Reputación=5) alcanza un valor estimado de €200.2M, el más alto del escenario.

  • La joven promesa (OVA=72, 20 años, alto potencial) se valúa en €6.6M, reflejando que el mercado descuenta la experiencia aún no acumulada.

  • El veterano experimentado (33 años) presenta un valor de €8.9M, consistente con la hipótesis de depreciación del capital humano deportivo planteada en la Parte 1.

Los amplios intervalos de predicción al 95% son normales en modelos de cross-section con alta heterogeneidad individual, y refuerzan la necesidad de complementar el modelo con variables adicionales (posición, liga, club) en futuras especificaciones.

Dataset: FIFA 21 Messy Raw Data — Kaggle / sofifa.com Ciclo I 2026 — Escuela de Economía, Universidad de El Salvador.

Referencias

Akerlof, G. A. (1970). The Market for ‘Lemons’: Quality Uncertainty and the Market Mechanism. The Quarterly Journal of Economics, 84(3), 488-500.

Becker, G. S. (1964). Human Capital: A Theoretical and Empirical Analysis. University of Chicago Press.

Carmichael, F., Thomas, D., & Ward, R. (2011). Production and Efficiency in Association Football. Journal of Sports Economics, 2(3), 228-243.

Franck, E., & Nüesch, S. (2012). Talent and/or Popularity: What Does It Take to Be a Superstar? Economic Inquiry, 50(1), 202-216.

Herm, S., Callsen-Bracker, H. M., & Kreis, H. (2014). When the crowd evaluates soccer players’ market values: Accuracy and evaluation attributes of an opinion exchange platform. Sport Management Review, 17(4), 484-492.

Lewis, M. (2003). Moneyball: The Art of Winning an Unfair Game. W. W. Norton & Company.

Müller, O., Simons, A., & Weinmann, M. (2017). Beyond crowd judgments: Data-driven estimation of market value in association football. European Journal of Operational Research, 263(2), 611-624.

Pappalardo, L., Cintia, P., Rossi, A., Massucco, E., et al. (2019). A public data set of spatio-temporal match events in soccer competitions. Scientific Data, 6, 236.

Poli, R., Ravenel, L., & Besson, R. (2020). Predicting transfer fees. CIES Football Observatory Monthly Report, 52.

Rosen, S. (1974). Hedonic Prices and Implicit Markets: Product Differentiation in Pure Competition. Journal of Political Economy, 82(1), 34-55.

Kaggle. (2021). FIFA 21 Messy, Raw Dataset for Cleaning/Exploring. Recuperado de: https://www.kaggle.com/datasets/yagunnersya/fifa-21-messy-raw-dataset-for-cleaning-exploring

SoFIFA. (2021). Descripción de variables y atributos de jugadores. Recuperado de: https://sofifa.com/