Solución Parcial 2
Rodrigo Roque, Carné: RS18005
16/6/2020
Parte Teórica
1.Para un modelo con 2 regresores, la matriz de correlación es [1,0.96;0.96,1], el VIF es de:
options(scipen = 999999)
# matriz de correlacion
matriz_R<-matrix(data = c(1,0.96,0.96,1), nrow = 2, ncol = 2,byrow = TRUE)
print(matriz_R)## [,1] [,2]
## [1,] 1.00 0.96
## [2,] 0.96 1.00# VIF
VIF<-diag(solve(matriz_R))
print(VIF)## [1] 12.7551 12.7551R/ El VIF es de 12.7551
2. Prueba robusta para evaluar la normalidad de los residuos independientemente del tamaño muestral
R/ Prueba de Normalidad de Jarque Bera
3. En una prueba FG, para un modelo con 5 regresores y 60 observaciones con un alpha de 4.3% el estadístico de prueba dio 40, el valor del determinante de la matriz de correlación es de:
options(scipen = 999999)
FG_test<-40
m<-5
n<-60
determinante_R<- exp(FG_test/-((n-1)-((2*m+5)/6)))
print(determinante_R)## [1] 0.4926459R/ El determinante de la matriz de correlacion es de 0.4926459
4. Si el VIF para una variable es de 2.5 y el coeficiente de correlación entre la variable y el resto de los regresores es de:
# Ya que el VIF = 1/1-R², entonces despejando R², R² = VIF-1/VIF
VIF_1<-2.5
coeficiente_correlacion<-(VIF_1-1)/VIF_1
print(coeficiente_correlacion)## [1] 0.6R/ El coeficiente de correlación es de 0.6
5. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad KS es:
residuos_modelo<-matrix(data = c(10,15,-10,-15,4,-4), nrow = 1, ncol = 6,byrow = TRUE)
library(nortest)
lillie.test(residuos_modelo)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: residuos_modelo
## D = 0.1374, p-value = 0.9763R/ El estadístico de prueba de la prueba de normalidad KS es 0.1374
6. En una prueba FG, para un modelo con 5 regresores y un alfa de 4.3% el Valor Crítico es de:
# Grados de Libertad
regresores<-5
gl<-regresores*(regresores-1)/2
# Valor Critico
Valor_critico<-qchisq(p = 0.043,df = gl,lower.tail = FALSE)
print(Valor_critico)## [1] 18.79093R/ El valor crítico es 18.79093
7. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad JB es:
library(normtest)
jb.norm.test(residuos_modelo)##
## Jarque-Bera test for normality
##
## data: residuos_modelo
## JB = 0.51072, p-value = 0.599R/ El estadístico de prueba de la prueba de normalidad JB es 0.51072
8. Para una tolerancia de 0.05 el VIF es de:
nivel_tolerancia<-0.05
VIF_2<-1/nivel_tolerancia
print(VIF_2)## [1] 20R/ El VIF es de 20
9. Sean 10,15,-10,-15,4,-4, los residuos de un modelo. El estadístico de prueba para el contraste de normalidad de Shapiro Wilk es:
shapiro.test(residuos_modelo)##
## Shapiro-Wilk normality test
##
## data: residuos_modelo
## W = 0.96164, p-value = 0.8323R/ El estadístico de prueba de la prueba de normalidad SW es 0.96164
- Para un VIF=2.5, la tolerancia es de:
VIF_3<-2.5
tolerancia<-1/VIF_3
print(tolerancia)## [1] 0.4R/ La tolerancia es de 0.4
Parte Práctica
CLAVE 1
Sea el conjunto de datos, indicados en el enlace de abajo, tomados en 24 meses correspondientes a los gastos de comercialización (C) de una empresa, el nivel de ventas (V), su coste de personal (P) y los costes de materias primas (M); se trata de estimar el nivel de ventas a partir de las restantes variables.
Cargando el modelo
library(stargazer)
library(readxl)
ventas_empresa <- read_excel("C:/Users/ADMIN/Downloads/ventas_empresa.xlsx")
# Estimando el modelo
modelo_ventas<-lm(formula = V~C+P+M,data = ventas_empresa)
stargazer(modelo_ventas,title = 'Nivel de ventas',type = 'text')##
## Nivel de ventas
## ===============================================
## Dependent variable:
## ---------------------------
## V
## -----------------------------------------------
## C 0.923***
## (0.223)
##
## P 0.950***
## (0.156)
##
## M 1.298***
## (0.431)
##
## Constant 107.444***
## (18.057)
##
## -----------------------------------------------
## Observations 24
## R2 0.980
## Adjusted R2 0.977
## Residual Std. Error 9.506 (df = 20)
## F Statistic 323.641*** (df = 3; 20)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_ventas$residuals, distr = 'norm')
plot(ajuste_normal)
Prueba de normalidad de JB
jb.norm.test(modelo_ventas$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_ventas$residuals
## JB = 1.4004, p-value = 0.287El valor crítico para un nivel de significancia del 5% es 5.9915 y el estadístico de prueba JB es 1.4004 por lo que según la regla de decisión, Ho no se rechaza ya que JB<VC por lo que hay evidencia de que los residuos del modelo siguen una distribución normal.
Prueba de normalidad KS
lillie.test(modelo_ventas$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_ventas$residuals
## D = 0.13659, p-value = 0.2935El p-value del estadístico de prueba KS es 0.2935 y el nivel de significancia es 5%, por lo tanto, según la regla de decisión, Ho no se rechaza ya que P-value>nivel de significancia y hay evidencia de que los residuos del modelo siguen una distribución normal.
Prueba de normalidad SW
shapiro.test(modelo_ventas$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_ventas$residuals
## W = 0.95315, p-value = 0.3166# Normalizando W
miu<-0.0038915*((log(24))^3)-0.083751*((log(24))^2)-0.31082*(log(24))-1.5861
sigma<-exp(1)^((0.0030302*(log(24)^2))-0.082676*(log(24))-0.4803)
Wn <-(log(1-0.95315)-miu)/sigma
print(Wn)## [1] 0.4772707El valor crítico para un nivel de significancia del 5% es 1.644854 y el estadístico de prueba Wn es 0.4772707 por lo que según la regla de decisión, Ho no se rechaza ya que Wn<VC por lo que hay evidencia de que los residuos del modelo siguen una distribución normal.
Pruebas de Multicolinealidad
Indice de condición
library(mctest)
source(file = 'C:/Users/ADMIN/Downloads/correccion_eigprop.R')
my_eigprop(mod = modelo_ventas)##
## Call:
## my_eigprop(mod = modelo_ventas)
##
## Eigenvalues CI (Intercept) C P M
## 1 3.9869 1.0000 0.0007 0.0001 0.0003 0.0001
## 2 0.0095 20.4852 0.8776 0.0049 0.0877 0.0075
## 3 0.0028 37.8141 0.1183 0.1594 0.8478 0.0636
## 4 0.0008 71.1635 0.0034 0.8356 0.0642 0.9288
##
## ===============================
## Row 4==> C, proportion 0.835554 >= 0.50
## Row 3==> P, proportion 0.847805 >= 0.50
## Row 4==> M, proportion 0.928751 >= 0.50Se puede ver que el índice de condición del modelo es 71.1635 y este es mayor que 30 por lo que se puede concluir que el modelo tiene evidencia de multicolinealidad severa.
Prueba de FG
# calcular Mat_x
matriz_x<-model.matrix(modelo_ventas)
library(fastGraph)
library(psych)
FG_test1<-cortest.bartlett(matriz_x[,-1])
VC_1<-qchisq(0.05,FG_test1$df,lower.tail = FALSE)
print(FG_test1)## $chisq
## [1] 71.20805
##
## $p.value
## [1] 0.000000000000002352605
##
## $df
## [1] 3shadeDist(xshade = FG_test1$chisq,ddist = 'dchisq',parm1 = FG_test1$df,lower.tail = FALSE,sub=paste('VC:',VC_1,'FG:',FG_test1$chisq))
Se observa que el Estadistico de prueba FG es 71.20805 y el VC es 7.8147 por lo que según la regla de decisión Ho se rechaza ya que FG>VC y por lo tanto hay evidencia de multicolinealidad en los regresores del modelo.
VIF con Car
library(car)
VIF_car<-vif(modelo_ventas)
print(VIF_car)## C P M
## 7.631451 3.838911 9.449210VIF con mctest
library(mctest)
mc.plot(modelo_ventas,vif = 2)
Se puede observar que para un umbral de 2, las varibales que más inflan la varianza son los costes de materias primas y los gastos de comercializacion, con un valor de 9.449210 y 7.631451 respectivamente.
CLAVE 2
Se tienen los datos para trabajadores hombres, en el archivo adjunto, con ellos estime un modelo donde educ es años de escolaridad, como variable dependiente, y como regresores sibs (número de hermanos), meduc (años de escolaridad de la madre) y feduc (años de escolaridad del padre)
Cargando el modelo
load('C:/Users/ADMIN/Downloads/wage2.RData')
# Estimanción del modelo
modelo_escolaridad<-lm(formula = educ~sibs+meduc+feduc,data = wage2)
stargazer(modelo_escolaridad,title = 'Modelo de escolaridad',type = 'text')##
## Modelo de escolaridad
## ===============================================
## Dependent variable:
## ---------------------------
## educ
## -----------------------------------------------
## sibs -0.094***
## (0.034)
##
## meduc 0.131***
## (0.033)
##
## feduc 0.210***
## (0.027)
##
## Constant 10.364***
## (0.359)
##
## -----------------------------------------------
## Observations 722
## R2 0.214
## Adjusted R2 0.211
## Residual Std. Error 1.987 (df = 718)
## F Statistic 65.198*** (df = 3; 718)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_escolaridad$residuals,distr = 'norm')
plot(ajuste_normal)
Prueba de normalidad de JB
jb.norm.test(modelo_escolaridad$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_escolaridad$residuals
## JB = 35.655, p-value < 0.00000000000000022El valor crítico para un nivel de significancia del 5% es 5.9915 y el estadístico de prueba JB es 35.655 por lo que según la regla de decisión, Ho se rechaza ya que JB>VC por lo que hay evidencia de que los residuos del modelo no siguen una distribución normal.
Prueba de normalidad KS
lillie.test(modelo_escolaridad$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_escolaridad$residuals
## D = 0.089992, p-value = 0.000000000000003394El p-value del estadístico de prueba KS es 0.000000000000003394 y el nivel de significancia es 5%, por lo tanto, según la regla de decisión, Ho se rechaza ya que P-value<nivel de significancia y hay evidencia de que los residuos del modelo no siguen una distribución normal.
Prueba de normalidad SW
shapiro.test(modelo_escolaridad$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_escolaridad$residuals
## W = 0.96692, p-value = 0.00000000001058# Normalizando W
miu<-0.0038915*((log(935))^3)-0.083751*((log(935))^2)-0.31082*(log(935))-1.5861
sigma<-exp(1)^((0.0030302*(log(935)^2))-0.082676*(log(935))-0.4803)
Wn <-(log(1-0.96692)-miu)/sigma
print(Wn)## [1] 7.351479El valor crítico para un nivel de significancia del 5% es 1.644854 y el estadístico de prueba Wn es 7.351479 por lo que según la regla de decisión, Ho se rechaza ya que Wn>VC por lo que hay evidencia de que los residuos del modelo no siguen una distribución normal.
Pruebas de Multicolinealidad
Indice de condición
library(mctest)
source(file = 'C:/Users/ADMIN/Downloads/correccion_eigprop.R')
my_eigprop(mod = modelo_escolaridad)##
## Call:
## my_eigprop(mod = modelo_escolaridad)
##
## Eigenvalues CI (Intercept) sibs meduc feduc
## 1 3.5576 1.0000 0.0033 0.0194 0.0031 0.0046
## 2 0.3756 3.0778 0.0015 0.7200 0.0107 0.0184
## 3 0.0417 9.2337 0.3235 0.1056 0.0813 0.8786
## 4 0.0251 11.9094 0.6717 0.1549 0.9049 0.0984
##
## ===============================
## Row 2==> sibs, proportion 0.720032 >= 0.50
## Row 4==> meduc, proportion 0.904919 >= 0.50
## Row 3==> feduc, proportion 0.878599 >= 0.50Se puede ver que el índice de condición del modelo es 11.9094 y este es menor que 20 por lo que se puede concluir que el modelo tiene evidencia de multicolinealidad leve.
Prueba de FG
# calcular Mat_x
matriz_x_1<-model.matrix(modelo_escolaridad)
library(fastGraph)
library(psych)
FG_test2<-cortest.bartlett(matriz_x_1[,-1])
VC_2<-qchisq(0.05,FG_test2$df,lower.tail = FALSE)
print(FG_test2)## $chisq
## [1] 358.3897
##
## $p.value
## [1] 0.0000000000000000000000000000000000000000000000000000000000000000000000000000227501
##
## $df
## [1] 3shadeDist(xshade = FG_test2$chisq,ddist = 'dchisq',parm1 = FG_test2$df,lower.tail = FALSE,sub=paste('VC:',VC_2,'FG:',FG_test2$chisq))
Se observa que el Estadistico de prueba FG es 358.3897 y el VC es 7.8147 por lo que según la regla de decisión Ho se rechaza ya que FG>VC y por lo tanto hay evidencia de multicolinealidad en los regresores del modelo.
VIF con Car
library(car)
VIF_car_1<-vif(modelo_escolaridad)
print(VIF_car_1)## sibs meduc feduc
## 1.098950 1.561254 1.506359VIF con mctest
library(mctest)
mc.plot(modelo_escolaridad,vif = 2)
Se puede observar que para un umbral de 2, ninguno de los regresores alcanza dicho umbral, esto se comprueba ya que el índice de condición es de 11.90 por lo que se puede corroborar graficamente que la multicolinealidad del modelo es leve.
CLAVE 3
El sueldo inicial medio (salary) para los recién graduados de la Facultad de Economía se determina mediante una función lineal: log(salary)=f(SAT,GPA ,log(libvol),log(cost),rank). Donde LSAT es la media del puntaje LSAT del grupo de graduados, GPA es la media del GPA (promedio general) del grupo, libvol es el número de volúmenes en la biblioteca de la Facultad de Economía, cost es el costo anual por asistir a dicha facultad y rank es una clasificación de las escuelas de Economía (siendo rank 1 la mejor)
Correr el modelo
load('C:/Users/ADMIN/Downloads/LAWSCH85.RData')
# Estimando el modelo
modelo_sueldo<-lm(formula = lsalary~LSAT+GPA+llibvol+lcost+rank,data = LAWSCH85)
stargazer(modelo_sueldo,title = 'Modelo sueldo',type = 'text')##
## Modelo sueldo
## ===============================================
## Dependent variable:
## ---------------------------
## lsalary
## -----------------------------------------------
## LSAT 0.005
## (0.004)
##
## GPA 0.248***
## (0.090)
##
## llibvol 0.095***
## (0.033)
##
## lcost 0.038
## (0.032)
##
## rank -0.003***
## (0.0003)
##
## Constant 8.343***
## (0.533)
##
## -----------------------------------------------
## Observations 136
## R2 0.842
## Adjusted R2 0.836
## Residual Std. Error 0.112 (df = 130)
## F Statistic 138.230*** (df = 5; 130)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Pruebas de normalidad de los residuos
library(fitdistrplus)
ajuste_normal<-fitdist(data = modelo_sueldo$residuals,distr = 'norm')
plot(ajuste_normal)
Prueba de normalidad de JB
jb.norm.test(modelo_sueldo$residuals)##
## Jarque-Bera test for normality
##
## data: modelo_sueldo$residuals
## JB = 0.36511, p-value = 0.829El valor crítico para un nivel de significancia del 5% es 5.9915 y el estadístico de prueba JB es 0.36511 por lo que según la regla de decisión, Ho no se rechaza ya que JB<VC por lo que hay evidencia de que los residuos del modelo siguen una distribución normal.
Prueba de normalidad KS
lillie.test(modelo_sueldo$residuals)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_sueldo$residuals
## D = 0.054571, p-value = 0.4123El p-value del estadístico de prueba KS es 0.4123 y el nivel de significancia es 5%, por lo tanto, según la regla de decisión, Ho no se rechaza ya que P-value>nivel de significancia y hay evidencia de que los residuos del modelo siguen una distribución normal.
Prueba de normalidad SW
shapiro.test(modelo_sueldo$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_sueldo$residuals
## W = 0.99282, p-value = 0.7235# Normalizando W
miu<-0.0038915*((log(156))^3)-0.083751*((log(156))^2)-0.31082*(log(156))-1.5861
sigma<-exp(1)^((0.0030302*(log(156)^2))-0.082676*(log(156))-0.4803)
Wn <-(log(1-0.99282)-miu)/sigma
print(Wn)## [1] -0.3320221El valor crítico para un nivel de significancia del 5% es 1.644854 y el estadístico de prueba Wn es 0.3320221 por lo que según la regla de decisión, Ho no se rechaza ya que Wn<VC por lo que hay evidencia de que los residuos del modelo siguen una distribución normal.
Pruebas de Multicolinealidad
Indice de condición
library(mctest)
source(file = 'C:/Users/ADMIN/Downloads/correccion_eigprop.R')
my_eigprop(mod = modelo_sueldo)##
## Call:
## my_eigprop(mod = modelo_sueldo)
##
## Eigenvalues CI (Intercept) LSAT GPA llibvol lcost rank
## 1 5.7351 1.0000 0.0000 0.0000 0.0000 0.0001 0.0000 0.0021
## 2 0.2604 4.6930 0.0000 0.0000 0.0002 0.0004 0.0001 0.2884
## 3 0.0021 52.4800 0.0058 0.0030 0.0007 0.8411 0.1155 0.1357
## 4 0.0018 55.7648 0.0002 0.0010 0.3355 0.1095 0.1756 0.0161
## 5 0.0004 123.2068 0.4254 0.0588 0.4407 0.0423 0.6610 0.4700
## 6 0.0002 186.7153 0.5686 0.9371 0.2229 0.0066 0.0478 0.0877
##
## ===============================
## Row 6==> LSAT, proportion 0.937119 >= 0.50
## Row 3==> llibvol, proportion 0.841136 >= 0.50
## Row 5==> lcost, proportion 0.661004 >= 0.50Se puede ver que el índice de condición del modelo es 186.7153 y este es mayor que 30 por lo que se puede concluir que el modelo tiene evidencia de multicolinealidad severa.
Prueba de FG
mctest(modelo_sueldo)##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.0521 0
## Farrar Chi-Square: 391.5090 1
## Red Indicator: 0.5819 1
## Sum of Lambda Inverse: 13.8127 0
## Theil's Method: -0.3680 0
## Condition Number: 181.9505 1
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the testGraficando Prueba FG.
# calcular Mat_x
Matriz_x_1<-model.matrix(modelo_sueldo)
library(fastGraph)
library(psych)
FG_test2<-cortest.bartlett(Matriz_x_1[,-1])
VC_2<-qchisq(0.05,FG_test2$df,lower.tail = FALSE)
print(FG_test2)## $chisq
## [1] 391.509
##
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000006031929
##
## $df
## [1] 10shadeDist(xshade = FG_test2$chisq,ddist = 'dchisq',parm1 = FG_test2$df,lower.tail = FALSE,sub=paste('VC:',VC_2,'FG:',FG_test2$chisq))
Se observa que el Estadistico de prueba FG es 391.5090 y por lo tanto hay evidencia de multicolinealidad en los regresores del modelo de modo que Ho se rechaza.
VIF con Car
library(car)
VIF_car_2<-vif(modelo_sueldo)
print(VIF_car_2)## LSAT GPA llibvol lcost rank
## 3.635214 3.369004 2.110802 1.573583 3.124106VIF con mctest
library(mctest)
mc.plot(modelo_sueldo,vif = 2)
Se puede observar que para un umbral de 2, la variable que más infla la varianza para tal umbral es LSAT, es decir, la media del puntaje del grupo de graduados.