En este trabajo, realizamos un análisis del campeonato argentino de Primera División del año 2015. Para ello utilizaremos los siguientes paquetes y el dataset campeonatos.
library(tidyverse)
## -- Attaching packages -------------------------------------------------------------------- tidyverse 1.2.1 --
## v ggplot2 3.2.0 v purrr 0.3.2
## v tibble 2.1.3 v dplyr 0.8.3
## v tidyr 0.8.3 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.4.0
## -- Conflicts ----------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(ggpubr)
## Loading required package: magrittr
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
campeonato_2015 <- read.csv2("datos_2015.csv", encoding = "latin1")
campeonato_2015$valor <- as.numeric(as.character(campeonato_2015$valor))
campeonato_2015$inversion_abs <- as.numeric(as.character(campeonato_2015$inversion_abs))
campeonato_2015$inversion_relativa <- as.numeric(as.character(campeonato_2015$inversion_relativa))
campeonato_2015$PJ <- as.numeric(as.character(campeonato_2015$PJ))
Como puede observarse, el dataframe contiene 49 variables y 30 equipos (los que jugaron el campeonato de 2015). Además, la base incluye los puntos de tres campeonatos anteriores (importante para medir los descensos), las inversiones en el equipo en 2015, el valor del equipo al comienzo del campeonato y si jugaron copas internacionales (Libertadores, más importante; y la Sudamericana, de menor valor). Estos son los datos más importantes y con los que trabajaremos.
head(campeonato_2015)
## club Pts_2012_13 Pts_2013_14 Pts_2014 inversion_abs
## 1 Quilmes 50 45 12 6.33
## 2 Olimpo 0 50 19 2.25
## 3 Banfield 0 0 20 7.55
## 4 Godoy Cruz 0 0 20 3.40
## 5 Rosario Central 0 54 21 10.83
## 6 Defensa y Justicia 49 56 21 1.27
## inversion_relativa valor libertadores sudamericana ascenso Pos Pts PJ PG
## 1 0.6509656 13.23 0 0 0 11 45 30 13
## 2 0.2548922 10.00 0 0 0 18 36 30 8
## 3 0.5905074 16.93 0 0 0 8 50 30 14
## 4 0.3010224 13.08 0 0 0 22 32 30 8
## 5 1.0882558 16.33 0 0 0 3 59 30 16
## 6 0.2034120 6.90 0 0 0 21 32 30 8
## PE PP GF GC Dif Pos_Fecha_1 Pos_Fecha_2 Pos_Fecha_3 Pos_Fecha_4
## 1 6 11 38 37 1 19 18 24 23
## 2 12 10 23 26 -3 25 25 29 29
## 3 8 8 38 32 6 19 12 12 18
## 4 8 14 32 40 -8 14 18 14 8
## 5 11 3 47 26 21 8 4 3 1
## 6 8 14 27 31 -4 8 14 18 15
## Pos_Fecha_5 Pos_Fecha_6 Pos_Fecha_7 Pos_Fecha_8 Pos_Fecha_9 Pos_Fecha_10
## 1 19 20 22 20 22 23
## 2 29 25 26 27 28 30
## 3 13 9 5 6 7 9
## 4 16 19 18 21 23 24
## 5 1 1 3 4 4 4
## 6 18 18 17 19 18 21
## Pos_Fecha_11 Pos_Fecha_12 Pos_Fecha_13 Pos_Fecha_14 Pos_Fecha_15
## 1 21 20 23 23 23
## 2 28 25 25 26 28
## 3 10 9 10 10 12
## 4 22 21 19 22 22
## 5 5 3 3 5 5
## 6 24 24 24 25 27
## Pos_Fecha_16 Pos_Fecha_17 Pos_Fecha_18 Pos_Fecha_19 Pos_Fecha_20
## 1 23 23 21 18 15
## 2 28 26 26 22 22
## 3 10 14 13 12 9
## 4 18 19 17 19 19
## 5 4 6 4 4 6
## 6 26 24 22 24 25
## Pos_Fecha_21 Pos_Fecha_22 Pos_Fecha_23 Pos_Fecha_24 Pos_Fecha_25
## 1 15 15 14 13 13
## 2 24 22 23 21 22
## 3 9 8 9 7 6
## 4 21 23 25 23 25
## 5 4 3 3 3 3
## 6 22 24 21 19 20
## Pos_Fecha_26 Pos_Fecha_27 Pos_Fecha_28 Pos_Fecha_29 Pos_Fecha_30
## 1 11 11 11 11 11
## 2 20 20 18 17 18
## 3 8 9 10 9 8
## 4 25 23 21 22 22
## 5 3 3 2 3 3
## 6 22 19 20 20 21
Comenzamos con un análisis exploratorio. Rápidamente, podemos definir que el equipo campeón sacó 64 puntos, mientras que el último obtuvo un total de 14 puntos en las 30 fechas. Por su parte, el equipo más “caro” tiene un valor de 43 millones de dólares, mientras que el equipo más económico tiene un valor de 3 millones de dólares aproximadamente (¡una diferencia de casi 40 millones entre el más caro y el más económico!). Finalmente, el promedio de inversión de los equipos para el campeonato 2015 fue de 2 millones y medio de dólares aproximadamente.
summary(campeonato_2015$Pts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 14.00 30.50 40.00 40.33 49.75 64.00
summary(campeonato_2015$valor)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.380 7.312 13.155 15.012 17.973 43.400
summary(campeonato_2015$inversion_abs)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2.900 0.045 0.790 2.403 4.075 11.200
A continuación, haremos los siguientes cálculos:
Compararemos la posición del campeonato 2015 con el valor de los 15 equipos que hayan sacado más puntos
Finalmente, evaluamos la efectividad de la inversión, comparando inversión relativa y los puntos sacados en 2015.
quince_primeros <- top_n(campeonato_2015, 15, Pts) %>%
arrange(-Pts)
#sacamos el promedio del valor de estos quince equipos para graficarlo
summary(quince_primeros$valor)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 6.58 12.51 16.91 20.02 23.25 43.40
A continuación podrá verse lo siguiente: Boca Juniors fue el campeón (con 64 puntos), seguido por San Lorenzo, Rosario Central y Racing. A su vez, Boca, San Lorenzo y River Plate fueron los equipos más caros: superan -junto con Newell´s Old Boys, el promedio del valor de los quince equipos.
quince_primeros %>% ggplot(aes(x = reorder(club, Pts),
y=valor,
label=Pts, fill = libertadores))+
geom_bar(stat = "identity") +
coord_flip()+
geom_text(size = 3, colour= "white",
position = position_stack(vjust = 0.9))+
geom_hline(yintercept=20.02, color = "red")+
theme(legend.position = "none")+
labs(title = "15 equipos con más puntos de la Liga 2015",
subtitle = "Puntos del equipo según su valor y celeste si jugó Copa Libertadores",
x= "Equipo",
y= "Valor en millones de dólares")
Asimismo, realizamos una comparación entre la diferencia entre la inversión de 2014 a 2015 en los equipos (eje x) y los puntos que obtuvieron en el 2015 (eje y). Además, agregamos una línea roja, correspondiente a la mediana de los puntos que obtuvieron los 30 equipos (corresponde a la mitad de la tabla de posiciones).
De acuerdo al gráfico, de los equipos que invirtieron menos que en 2015, solamente Racing sumó una cantidad de puntos considerable (había sido el equipo campeón en 2014).
Por su parte, San Lorenzo tuvo un rendimiento muy positivo: invirtió poco para la cantidad de puntos que obtuvo. Los equipos como Godoy Cruz y Olimpo no fueron efectivos: su inversión fue alta, pero su rendimiento no fue tan bueno (está con los equipos que sacaron menos puntos).
campeonato_2015 %>%
ggplot(aes(x= inversion_relativa, y= Pts,label=club))+
geom_point() +geom_text(aes(label=club))+
geom_hline(yintercept=40, color = "red")+
theme(axis.text.x = element_text(angle = 90, hjust = 1))
En este apartado, analizamos la relación que existe entre los puntos obtenidos en el campeonato de 2015 y distintas variables (puntos de campeonatos anteriores, valor del equipo, inversiones para 2015, participación en copas y ascenso).
Para ver la correlación, que aunque no indique causalidad sí implica una relación entre variables, utilizamos la funcion cor. A continuación puede observarse que la correlación más importante es entre puntos obtenidos en 2015 y el valor del equipo (0,61), los puntos obtenidos en el campeonato anterior (0,57) y la inversión realizada para el 2015 (0,53). Finalmente, vale la pena aclarar que hay una correlación negativa entre los puntos del campeonato 2015 y haber ascendido ese año (-0,50).
cor(campeonato_2015$Pts, campeonato_2015$Pts_2012_13)
## [1] 0.2926954
cor(campeonato_2015$Pts, campeonato_2015$Pts_2013_14)
## [1] 0.3953979
cor(campeonato_2015$Pts, campeonato_2015$Pts_2014)
## [1] 0.5709222
cor(campeonato_2015$Pts, campeonato_2015$valor)
## [1] 0.6173146
cor(campeonato_2015$Pts, campeonato_2015$inversion_abs)
## [1] 0.5333254
cor(campeonato_2015$Pts, campeonato_2015$inversion_relativa)
## [1] 0.4372295
cor(campeonato_2015$Pts, campeonato_2015$libertadores)
## [1] 0.4884535
cor(campeonato_2015$Pts, campeonato_2015$sudamericana)
## [1] 0.1099872
cor(campeonato_2015$Pts, campeonato_2015$ascenso)
## [1] -0.5052544
Realizamos las regresiones lineales.
reg_multiple <- lm(Pts ~ valor +
inversion_abs+
inversion_relativa+
Pts_2012_13+
Pts_2013_14+
Pts_2014+
libertadores+
sudamericana+
ascenso,
data = campeonato_2015)
Como puede apreciarse a continuación, vemos que el valor del equipo, el aumento de la inversión de 2014 a 2015 y los puntos del campeonato 2014 tienen realación con los puntos obtenidos en el campeonato 2015: los tres tienen un asterísco en su valor p. La utilización de las variables seleccionadas explica el 57% de la varianza de los puntos del campeonatos (0.56 del R^2 ajustado).
summary(reg_multiple)
##
## Call:
## lm(formula = Pts ~ valor + inversion_abs + inversion_relativa +
## Pts_2012_13 + Pts_2013_14 + Pts_2014 + libertadores + sudamericana +
## ascenso, data = campeonato_2015)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.1568 -3.9097 -0.2494 3.4886 15.7965
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 15.058086 7.459359 2.019 0.0571 .
## valor 0.834816 0.338797 2.464 0.0229 *
## inversion_abs -2.173272 1.268791 -1.713 0.1022
## inversion_relativa 40.110542 15.874772 2.527 0.0201 *
## Pts_2012_13 -0.084927 0.103988 -0.817 0.4237
## Pts_2013_14 0.008748 0.106711 0.082 0.9355
## Pts_2014 0.575616 0.223596 2.574 0.0181 *
## libertadores 3.896544 5.391639 0.723 0.4782
## sudamericana -1.348871 3.915157 -0.345 0.7340
## ascenso 7.400458 5.703893 1.297 0.2092
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.973 on 20 degrees of freedom
## Multiple R-squared: 0.7028, Adjusted R-squared: 0.5691
## F-statistic: 5.256 on 9 and 20 DF, p-value: 0.0009804
Para confirmar esto, utilizamos la función step la cual nos permitirá seleccionar las variables más relevantes para nuestro modelo.
step(reg_multiple)
## Start: AIC=132.4
## Pts ~ valor + inversion_abs + inversion_relativa + Pts_2012_13 +
## Pts_2013_14 + Pts_2014 + libertadores + sudamericana + ascenso
##
## Df Sum of Sq RSS AIC
## - Pts_2013_14 1 0.43 1271.8 130.41
## - sudamericana 1 7.55 1279.0 130.58
## - libertadores 1 33.20 1304.6 131.17
## - Pts_2012_13 1 42.40 1313.8 131.38
## <none> 1271.4 132.40
## - ascenso 1 107.01 1378.4 132.82
## - inversion_abs 1 186.51 1457.9 134.51
## - valor 1 385.98 1657.4 138.35
## - inversion_relativa 1 405.84 1677.3 138.71
## - Pts_2014 1 421.30 1692.7 138.99
##
## Step: AIC=130.41
## Pts ~ valor + inversion_abs + inversion_relativa + Pts_2012_13 +
## Pts_2014 + libertadores + sudamericana + ascenso
##
## Df Sum of Sq RSS AIC
## - sudamericana 1 8.26 1280.1 128.60
## - libertadores 1 32.91 1304.8 129.18
## - Pts_2012_13 1 61.06 1332.9 129.82
## <none> 1271.8 130.41
## - ascenso 1 107.47 1379.3 130.84
## - inversion_abs 1 186.18 1458.0 132.51
## - valor 1 387.90 1659.8 136.40
## - inversion_relativa 1 412.75 1684.6 136.84
## - Pts_2014 1 458.42 1730.3 137.65
##
## Step: AIC=128.6
## Pts ~ valor + inversion_abs + inversion_relativa + Pts_2012_13 +
## Pts_2014 + libertadores + ascenso
##
## Df Sum of Sq RSS AIC
## - libertadores 1 33.46 1313.6 127.38
## - Pts_2012_13 1 57.59 1337.7 127.92
## <none> 1280.1 128.60
## - ascenso 1 109.66 1389.8 129.07
## - inversion_abs 1 210.54 1490.6 131.17
## - valor 1 404.33 1684.4 134.84
## - Pts_2014 1 457.72 1737.8 135.78
## - inversion_relativa 1 467.99 1748.1 135.95
##
## Step: AIC=127.38
## Pts ~ valor + inversion_abs + inversion_relativa + Pts_2012_13 +
## Pts_2014 + ascenso
##
## Df Sum of Sq RSS AIC
## - Pts_2012_13 1 49.17 1362.7 126.48
## <none> 1313.6 127.38
## - ascenso 1 186.84 1500.4 129.37
## - inversion_abs 1 248.65 1562.2 130.58
## - inversion_relativa 1 511.20 1824.8 135.24
## - Pts_2014 1 533.75 1847.3 135.61
## - valor 1 806.24 2119.8 139.74
##
## Step: AIC=126.48
## Pts ~ valor + inversion_abs + inversion_relativa + Pts_2014 +
## ascenso
##
## Df Sum of Sq RSS AIC
## <none> 1362.7 126.48
## - ascenso 1 151.63 1514.4 127.65
## - inversion_abs 1 235.60 1598.3 129.27
## - inversion_relativa 1 533.79 1896.5 134.40
## - Pts_2014 1 645.87 2008.6 136.12
## - valor 1 762.31 2125.0 137.81
##
## Call:
## lm(formula = Pts ~ valor + inversion_abs + inversion_relativa +
## Pts_2014 + ascenso, data = campeonato_2015)
##
## Coefficients:
## (Intercept) valor inversion_abs
## 13.5176 0.9416 -2.3508
## inversion_relativa Pts_2014 ascenso
## 43.9452 0.4665 7.8035
Efectivamente, el modelo step escogió las mismas variables (valor del equipo, inversión relativa, inversión total y puntos del campeonato 2014). También incluyó el “ascenso” como variable relevante. Construimos nuestro nuevo modelo. Según el R^2, nuestro nuevo modelo explica un poco más que el anterior: el 61% de la varianza de los puntos del campeonato 2015. Por eso, vamos a seguir trabajando con el nuevo modelo.
Algo que podemos señalar de los resultados obtenidos, y que nos servirá a la hora de calcular el intervalo de confianza es la columna estimate. En este modelo, vemos que toma como intercept un puntaje igual a 13.5. Es decir, en el supuesto caso que X=0, el valor de los puntos de un equipo en el campeonato 2015 es 13.5. Siguiendo la columna, cuando agregamos 1 punto al valor del equipo, los puntos que saca aumentan en 0.94. Al subir un punto de inversion_absoluta, vemos bajar 2.3 puntos la cantidad de puntos obtenidos en 2015. Esto indica que los equipos que más invirtieron no fueron necesariamente los que sacaron más puntos. Al subir un punto de inversion_relativa, aumenta 43.9 la cantidad de puntos. Este número es muy alto porque, como podemos apreciar en la base de datos, sólo un equipo (Rosario Central) aumentó en un puntosu inversión relativa. Al subir un punto los resultados del campeonato 2014, se aumenta 0.46 puntos el campeonato 2015. Por último, no contamos aquí el resultado de ascenso, ya que es una variable categórica.
reg_step <- lm(Pts ~ valor +
inversion_abs+
inversion_relativa+
Pts_2014+
ascenso,
data = campeonato_2015)
summary(reg_step)
##
## Call:
## lm(formula = Pts ~ valor + inversion_abs + inversion_relativa +
## Pts_2014 + ascenso, data = campeonato_2015)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.303 -3.851 -0.657 3.961 14.887
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 13.5176 6.0767 2.224 0.03578 *
## valor 0.9416 0.2570 3.664 0.00123 **
## inversion_abs -2.3508 1.1540 -2.037 0.05282 .
## inversion_relativa 43.9452 14.3326 3.066 0.00530 **
## Pts_2014 0.4665 0.1383 3.373 0.00252 **
## ascenso 7.8035 4.7753 1.634 0.11528
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.535 on 24 degrees of freedom
## Multiple R-squared: 0.6815, Adjusted R-squared: 0.6152
## F-statistic: 10.27 on 5 and 24 DF, p-value: 2.345e-05
library(gridExtra)
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
plot_1 <- ggplot(data = campeonato_2015) +
geom_point(aes(x = valor, y = Pts)) +
labs(title = "Correlación entre valor del equipos y los puntos de 2015",
x= "valor del equipo",
y = "puntos campeonato 2015",
caption = "con línea de regresión vía geom_smooth()") +
geom_smooth(aes(x = valor, y = Pts), method = "lm")
plot_2 <- ggplot(data = campeonato_2015) +
geom_point(aes(x = Pts_2014, y = Pts)) +
labs(title = "Correlación entre los puntos obtenidos en 2014 y los puntos de 2015",
x= "Puntos campeonato 2014",
y = "puntos campeonato 2015",
caption = "con línea de regresión vía geom_smooth()") +
geom_smooth(aes(x = Pts_2014, y = Pts), method = "lm")
plot_3 <- ggplot(data = campeonato_2015) +
geom_point(aes(x = inversion_relativa, y = Pts)) +
labs(title = "Correlación entre la inversión en 2015 y los puntos de 2015",
x= "Aumento de inversión 2015",
y = "puntos campeonato 2015",
caption = "con línea de regresión vía geom_smooth()") +
geom_smooth(aes(x = inversion_relativa, y = Pts), method = "lm")
plot_4 <- ggplot(data = campeonato_2015) +
geom_point(aes(x = ascenso, y = Pts)) +
labs(title = "Correlación entre el ascenso y los puntos de 2015",
x= "Ascenso",
y = "puntos campeonato 2015",
caption = "con línea de regresión vía geom_smooth()") +
geom_smooth(aes(x = ascenso, y = Pts), method = "lm")
grid.arrange(plot_1, plot_2, plot_3, plot_4)
variables_puntos <- campeonato_2015 %>%
select(Pts, valor, inversion_abs,inversion_relativa,
Pts_2014)
pairs(variables_puntos)
Ahora es momento de plotear nuestro modelo para realizar un diagnóstico de su precisión y la distribución de los residuos.
par (mfrow=c(2,2))
plot(reg_step)
El primer gráfico (Residuals vs Fitted) muestra si los residuos siguen patrones lineales. Por ejemplo, si tuvieran forma de “abanico”, los residuos aumentarían conforme al incremento de los valores de x. Como puede apreciarse, en este modelo los residuos siguen patrones no lineales; es decir, lo hacen aleatoriamente. Lo idea es que se ubiquen sobre la línea horizontal del medio (y=0), pero el hecho de que tengan un patrón aleatorio es algo positivo.
El segundo gráfico muestra la distribución normal de los residuos; sólo se alejan un poco al aumentar la x. Los valores que se alejan corresponden a los equipos Belgrano de Córdoba y Unión de Santa Fe.
El tercer gráfico sirve para saber si el error del modelo tienen siempre la misma varianza (homocedasticidad). Al ser una distribución aleatoria (la línea roja es horizontal), puede afirmarse que se cumple el principio de homocedasticidad.
El último gráfico nos indica si hay valores muy diferentes al promedio que estén alterando nuestro modelo hacia arriba o hacia abajo. Como puede observarse, solamente un punto traspasa la distancia de Cook (líneas punteadas). De esta forma, podemos concluir que sólo hay un outliers que está afectando al modelo (River Plate). Este outlier puede ser consecuencia de dos cosas: River sacó menos puntos que el valor de su equipo y la inversión en 2015 porque jugó la Copa Libertadores hasta el final de dicho torneo. Al jugarse al mismo tiempo el campeonato local (Pts) y la Libertadores, es posible que River haya priorizado la Libertadores y eso le haya costado puntos del torneo local.
En primer lugar, vamos a replicar el modelo implementado por pasando los puntos obtenidos a una escala logarítmica, para estandarizarlos. Con esto, queremos ver si el modelo puede ser mejorado o si es innecesario aplicar el modelo logarítmico.
Podemos notar en el siguiente análisis que hay variables que adquieren una mayor importancia para explicar los puntos (inversión relativa y los puntos obtenidos en 2014). Además, y más importante, el R^2 ha disminuido y pasado a ser de 52%. Por este motivo, rechazamos el fiteo realizado a la variable dependiente.
log_puntos <- campeonato_2015 %>%
mutate(log_puntos = log(Pts))
reg_log_puntos <- lm(log_puntos~valor +
inversion_abs+
inversion_relativa+
Pts_2014+
ascenso,
data = log_puntos)
summary(reg_log_puntos)
##
## Call:
## lm(formula = log_puntos ~ valor + inversion_abs + inversion_relativa +
## Pts_2014 + ascenso, data = log_puntos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.62664 -0.08581 -0.00939 0.13246 0.40935
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.981438 0.184588 16.152 2.15e-14 ***
## valor 0.023143 0.007806 2.965 0.00675 **
## inversion_abs -0.059214 0.035056 -1.689 0.10415
## inversion_relativa 1.137570 0.435374 2.613 0.01525 *
## Pts_2014 0.011739 0.004201 2.794 0.01006 *
## ascenso 0.181737 0.145056 1.253 0.22232
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2289 on 24 degrees of freedom
## Multiple R-squared: 0.6032, Adjusted R-squared: 0.5206
## F-statistic: 7.297 on 5 and 24 DF, p-value: 0.0002788
En este apartado buscaremos los intervalos de confianza de nuestras variables representativas. Para ello vamos a utilizar el método bootstrap para calcular el valor de los parámetros, el error estándar y los intervalos de confianza. En este caso, nuestra intención es determinar la importancia en los puntos obtenidos por un equipo de su valor en dólares, los puntos del campeonato anterior, la inversión absoluta y relativa y si ascendió en este campeonato o no. En general, esto podría resolverse utilizando otras muestras (otros campeonatos) para conocer las variaciones de nuestros resultados y saber si las variables son relevantes o si eran importanter para nuestra muestra del campeonato 2015.
En este caso, al tener una sola muestra (campeonato 2015), debemos aplicar un método bootstrap para calcular sus variaciones e intervalos de confianza y, de ese modo, conocer la representatividad de la muestra.
En primer lugar realizamos nuestro modelo botstrap de las variables seleccionadas de 1000 repeticiones con reposición (para garantizar variación en las muestras).
bootstrap <- function(X,Y){
boot <- sample.int(nrow(campeonato_2015),nrow(campeonato_2015),replace=T)
boot_fit = lm(Pts ~ valor + inversion_abs + inversion_relativa + Pts_2014+
ascenso, data=campeonato_2015[boot,])
return(coef(boot_fit))
}
boot <- t(replicate(10000,bootstrap(X,Y)))
head(boot)
## (Intercept) valor inversion_abs inversion_relativa Pts_2014
## [1,] 9.652097 1.0387833 -3.3103514 57.58782 0.5258803
## [2,] 16.594704 0.6465572 0.4497977 15.16900 0.4860525
## [3,] 13.625108 1.0162555 -2.1718703 42.42675 0.3231927
## [4,] 15.780799 0.8047907 -2.7461590 51.19832 0.5797456
## [5,] 12.615414 0.9459582 -3.1571700 51.39401 0.4971515
## [6,] 6.622784 1.2620355 -2.9342774 52.19812 0.4236617
## ascenso
## [1,] 7.807684
## [2,] 10.728724
## [3,] 8.330148
## [4,] 6.042924
## [5,] 8.657939
## [6,] 12.239185
Ahora calculamos el promedio de las 1000 repeticiones que hicimos. Como puede notarse, son similares a los valores que obtuvimos al realizar la regresión de nuestro modelo step.
mean(boot[,1]) #intercept
## [1] 13.63889
mean(boot[,2]) #valor del equipo
## [1] 0.9077226
mean(boot[,3]) #inversión total
## [1] -1.981904
mean(boot[,4]) #inversión en 2015
## [1] 40.70916
mean(boot[,5]) #puntos en 2014
## [1] 0.4731489
mean(boot[,6]) #ascenso
## [1] 8.052789
A continuación realizaremos los gráficos correspondientes a cada estimación. Como podemos apreciar, las distribuciones de nuestro ejercicio Bootstrap arrojan valores que forman una distribución normal.
par(mfrow=c(2,2))
MASS::truehist(boot[,1],xlab = "intercept")
MASS::truehist(boot[,2], xlab = "Valor del Equipo")
MASS::truehist(boot[,3], xlab = "Inversión total")
MASS::truehist(boot[,4], xlab = "Inversión 2015")
MASS::truehist(boot[,5], xlab = "Puntos en 2014")
MASS::truehist(boot[,6], xlab = "Ascenso")
Finalmente, calculamos los intervalos de confianza.
Como puede verse, con un 95% de confianza, los valores caeran entre:
Valor del equipo = al subir un punto el valor del equipo, podemos afirmar que los puntos en el campeonato del equipo aumentarán entre un 0.13 y un 1.4 en el 95% de los casos. Y un promedio de 0.94 puntos por cada punto que suba el valor del equipo.
Inversión total = al subir un punto de la inversión en el equipo, podemos afirmar que los puntos en el campeonato del equipo oscilarán entre una caída del 4.35 y un aumento de 1.5 en el 95% de los casos. Y un promedio de -2.35 puntos por cada punto que aumente la inversión total.
Inversión relativa = en este tipo de inversión hay una diferencia. Al subir un punto la inversión realizada para ese campeonato en cada equipo, los puntos en ese campeonato del equipo aumentarán entre un 0.18 y 73.3 en el 95% de los casos. Y un promedio de 43.9 puntos por cada punto que aumenta la inversión relativa del equipo. Como hemos mencionado, los números son tan altos porque casi ningún equipo aumentó en un punto su inversión entre 2014 y 2015.
Puntos del campeonato anterior = al subir un punto los resultados del campeonato anterior, los puntos del campeonato actual aumentan entre un 0.19 y un 0.74 en el 95% de los casos; con un promedio de 0.94 puntos por cada punto que suba el valor del equipo.
quantile(boot[,1],p=c(.025,.25,.5,.75,.975))#intercept
## 2.5% 25% 50% 75% 97.5%
## 1.793013 9.131477 12.952036 17.444202 29.493776
quantile(boot[,2],p=c(.025,.25,.5,.75,.975))#valor del equipo
## 2.5% 25% 50% 75% 97.5%
## 0.1366965 0.7814165 0.9371615 1.0766450 1.4245037
quantile(boot[,3],p=c(.025,.25,.5,.75,.975))#inversión total
## 2.5% 25% 50% 75% 97.5%
## -4.366465 -2.959190 -2.158785 -1.179790 1.450786
quantile(boot[,4],p=c(.025,.25,.5,.75,.975))#inversión 2015
## 2.5% 25% 50% 75% 97.5%
## 1.773984 30.826620 41.683902 51.728890 72.973285
quantile(boot[,5],p=c(.025,.25,.5,.75,.975))#Puntos 2014
## 2.5% 25% 50% 75% 97.5%
## 0.1941294 0.3885786 0.4713866 0.5564926 0.7440113
quantile(boot[,6],p=c(.025,.25,.5,.75,.975))#ascenso
## 2.5% 25% 50% 75% 97.5%
## -1.483490 5.226152 8.179887 10.923070 16.955908
Luego de realizar nuestras regresiones y calcular los intervalos de confianza, desarrollaremos un test de hipótesis. Este método de inferencia estadística nos permite comparar diferentes hipótesis de una muestra. En este caso, averiguaremos si se puede decir que existe algún coeficiente de las variables explicativas que sea estadísticamente distinto de cero.
Entonces, tenemos dos hipotesis: H_1 = Alguna de las variables utilizadas explica la variación de los puntos del campeonato 2015 H_0 = Ninguna de las variables seleccionadas explica la variación de los puntos del campeonato 2015
M_0 <- select(campeonato_2015, Pts)
M_1 <- select(campeonato_2015, Pts, valor, inversion_abs, inversion_relativa, Pts_2014, ascenso)
Realizo los modelos para cada caso
fit_M0 <- lm(Pts ~ ., data = M_0)
fit_M1 <- lm(Pts ~ ., data = M_1)
A continuación voy a extraer los errores de ambos modelos.
# Extraigo los errores
residuos_M1 <- fit_M1$residuals
residuos_M0 <- fit_M0$residuals
Realizo el test F, el cual voy a utilizar para construir mi test de hipótesis.
# Calculo la suma de los errores al cuadrado del modelo de interés (M1, quien contiene al modelo M0 y a la sumatoria de distintos parámetros) y M0 contine solo el intercept
RSS_M1 <- sum(residuos_M1 ^ 2)
RSS_M0 <- sum(residuos_M0 ^ 2)
# Calculo los grados de libertad. Son las variables: M0 tiene una (Puntos), mientras que M1 tiene seis(Puntos, valor del equipo, inversión absoluta, inversión relativa, puntos de 2014, ascenso).
p_M0 <- fit_M0$rank
p_M1 <- fit_M1$rank
N = nrow(M_1)
# Estadístico F.
#Este estadístico está compuesto de la división de la resta de los errores del modelo sobre los grados de libertad del modelo de la hipótesis menos los de la hipótesis nula (5 en este caso) y la división de los errores del modelo de la hipóstesis sobre la cantidad de casos menos los grados de libertad de la hipótesis (6 en este caso). Por eso, primero construyo el numerador y el denominador de mi división final:
numerador = (RSS_M0 - RSS_M1) / (p_M1 - p_M0)
denominador = RSS_M1 / (N - p_M1)
# Finalmente, calculo F
F_obs <- numerador / denominador
F_obs
## [1] 10.27088
Ya tenemos nuestro estadístico F. Ahora definimos a M_0 como el modelo de la hipótesis nula y construimos la distribución bajo la hipótesis nula del estadístico del test.
Primero, extraigo la prediccion del modelo nulo M0, la cual voy a usar para generar un dataset sintético y construir un modelo bootstrap.
B0 = fit_M0$fitted.values
Armamos la función:
reg_test_hip <- function(M_0, M_1, B0, residuos_M1) {
# índice para hacer el boostrap
N <- nrow(M_1)
boot_i <- sample.int(N, N, replace = T)
# y sintético:
residuos_2_boot <- residuos_M1[boot_i]
M_0$Pts <- residuos_2_boot + B0
M_1$Pts <- residuos_2_boot + B0
# M1 con los Pts sintéticos:
boot_fit_M0 = lm(Pts ~ ., data = M_0)
boot_fit_M1 = lm(Pts ~ ., data = M_1)
# Residuos:
boot_residuos_M0 <- boot_fit_M0$residuals
boot_residuos_M1 <- boot_fit_M1$residuals
# Suma residuos al cuadrado:
RSS_M0 <- sum(boot_residuos_M0 ^ 2)
RSS_M1 <- sum(boot_residuos_M1 ^ 2)
# F simulacion boot:
p_M0 <- boot_fit_M0$rank
p_M1 <- boot_fit_M1$rank
numerador = (RSS_M0 - RSS_M1) / (p_M1 - p_M0)
denominador = RSS_M1 / (N - p_M1)
F_boot <- numerador / denominador
# Devuelve F_boot:
return(F_boot)
}
Realizamos nuestro bootstrap comparando el modelo estadístico F que generamos con los que construimos mediante la función reg_test_hip.
boot_test_hip <- t(replicate(2000, reg_test_hip(M_0, M_1, B0, residuos_M1)))
Ya construimos nuestro modelo estadístico de la M_1 (nuestra hipótesis con las variables que determinan el puntaje del campeonato) y la hemos comparado con modelos desarrollados mediante el modelo bootstrap de la M_0 (la hipótesis nula que indica que no hay relación entre nuestras variables y la cantidad de puntos). A continuación vamos a calcular si nuestra M_1 está dentro de los valores de la M_0 (lo que no nos dejaría rechazar la hipótesis nula) y averiguar si nuestra hipótesis es estadísticamente significativa. Esto último nos permitiría rechazar la hipótesis nula y sostener que no hay una relación azarosa entre el puntaje del campeonato y las variables que seleccionamos.
A continuación vemos que la media de los valores mayores a el estadístico de la M_1 es igual a 0. Es decir: prácticamente ningún resultado de nuestro test de bootstrap alcanzó los valores de nuestra hipótesis. Los
# Que tan probable es?
mean(F_obs < boot_test_hip)
## [1] 0
(mean(F_obs < boot_test_hip)) < .05
## [1] TRUE
Como se puede apreciar en el gráfico presentado a continuación, se puede rechazar la hipótesis nula: las variables utilizadas influyen en la cantidad de puntos que los equipos obtuvieron en 2015.
hist(boot_test_hip,xlim = c(0,20))
abline(v=F_obs,col="red",lwd=3)
Finalmente, realizamos un análisis para saber si el hecho de haber jugado alguna copa internacional -Libertadores y/o Sudamericana- influye en la cantidad de puntos obtenidos en 2015. Para esto vamos a aplicar la técnica de analisis de varianza ANOVA. Esta técnica permite analizar el efecto que tiene la inclusión de uno o más factores en la media de la variable. Es decir, en este caso, si al considerar la participación en copas de los equipos, la media de los puntos se modifica o no.
Por este motivo, nuestra hipótesis nula es que el promedio de los puntos obtenidos es el misma en cada uno de los grupos (los equipos que juegan copas y los que no).
En primer lugar, antes de realizar nuestro análisis de ANOVA, vamos a construir un boxplot de los puntos obtenidos en el campeonato según jueguen copa libertadores o sudamericana. Este gráfico nos permitirá tener una primera aproximación a la diferencia de medias, varianzas y valores atípicos de los grupos.
A continuación presentamos el boxplot: en el eje y están los puntos obtenidos; en el eje x si jugó o no Libertadores (0=no, 1= sí) y el color si jugó o no sudamericana (rosa =no, celeste = sí).
Como puede apreciarse, parecería haber una diferencia de medias, especialmente en los puntos de los equipos que jugaron solamente Copa Libertadores. Los equipos que no jugaron ninguna copa y los que jugaron sólo Sudamericana parecen ser más similares, con algunos outliers. No contaremos los que jugaron ambas copas, ya que sólo son dos equipos (River y Huracán).
boxplot_copa <- ggplot(data = campeonato_2015, aes(x = as.character(libertadores), y = Pts, colour = as.character(sudamericana))) +
geom_boxplot() + theme_bw()
boxplot_copa
A continuación calculamos la ANOVA para ver si tales variaciones son significativas.
Como puede observarse a continuación, el valor F es alto en los equipos que juegan la Copa Libertadores con un importante nivel de significación. Por este motivo, podemos rechazar la hipótesis nula y afirmar que jugar Copa Libertadores infuye en la cantidad de puntos obtenidos. 1
anova <- aov(formula = Pts~libertadores+sudamericana, data = campeonato_2015)
summary(anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## libertadores 1 1021 1020.8 8.491 0.00709 **
## sudamericana 1 12 11.8 0.099 0.75603
## Residuals 27 3246 120.2
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Finalmente, ¿cuál es la probabilidad de cometer un error del tipo 1 (rechazar una hipótesis nua verdadera)? Es decir, ¿cuál es la probabilidad de que el resultado obtenido ser ruido y en realidad no participar de la Libertadores no sea importante? Para ello, realizamos una corrección Bonferroni.
El resultado es 0.0062, lo que nos permite rechazar la hipótesis nula!
pairwise.t.test(campeonato_2015$Pts, campeonato_2015$libertadores, "bonferroni")
##
## Pairwise comparisons using t tests with pooled SD
##
## data: campeonato_2015$Pts and campeonato_2015$libertadores
##
## 0
## 1 0.0062
##
## P value adjustment method: bonferroni
Probablemente esto esté relacionado al valor del equipo y a los puntos obtenidos en campeonatos anteriores, ya que es esto último lo que determina que haya participado de la Libertadores 2015.↩