Ejercicio Multicolinealidad
CRISTALI DAYAMARI AGUILAR ZACARIAS AZ20006
2023-05-14
Importación de datos
library(wooldridge)
data(hprice1)
head(force(hprice1),n=5) #mostrar las primeras 5 observaciones## price assess bdrms lotsize sqrft colonial lprice lassess llotsize lsqrft
## 1 300 349.1 4 6126 2438 1 5.703783 5.855359 8.720297 7.798934
## 2 370 351.5 3 9903 2076 1 5.913503 5.862210 9.200593 7.638198
## 3 191 217.7 3 5200 1374 0 5.252274 5.383118 8.556414 7.225482
## 4 195 231.8 3 4600 1448 1 5.273000 5.445875 8.433811 7.277938
## 5 373 319.1 4 6095 2514 1 5.921578 5.765504 8.715224 7.8296301. Modelo estimado
price = ˆα + ˆα1(lotsize) + ˆα2(sqrft) + ˆα3(bdrms) + e
# Sigma matriz
library(stargazer)
model_price <- lm( formula = price ~ lotsize + sqrft + bdrms, data = hprice1)
stargazer(model_price, title = 'Modelo estimado', type = 'text')##
## Modelo estimado
## ===============================================
## Dependent variable:
## ---------------------------
## price
## -----------------------------------------------
## lotsize 0.002***
## (0.001)
##
## sqrft 0.123***
## (0.013)
##
## bdrms 13.853
## (9.010)
##
## Constant -21.770
## (29.475)
##
## -----------------------------------------------
## Observations 88
## R2 0.672
## Adjusted R2 0.661
## Residual Std. Error 59.833 (df = 84)
## F Statistic 57.460*** (df = 3; 84)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.012. Verifique si hay evidencia de la independencia de los regresores (no colinealidad), a través de:
- Indice de condición y prueba de FG
Indice de condicion
options(scipen = 999999)
Matriz_X <- model.matrix(model_price)
stargazer(head(Matriz_X, n = 6), type = "text")##
## =================================
## (Intercept) lotsize sqrft bdrms
## ---------------------------------
## 1 1 6,126 2,438 4
## 2 1 9,903 2,076 3
## 3 1 5,200 1,374 3
## 4 1 4,600 1,448 3
## 5 1 6,095 2,514 4
## 6 1 8,566 2,754 5
## ---------------------------------Matriz_XX <- t(Matriz_X)%*%Matriz_X
stargazer(Matriz_XX, type = "text")##
## ==============================================================
## (Intercept) lotsize sqrft bdrms
## --------------------------------------------------------------
## (Intercept) 88 793,748 177,205 314
## lotsize 793,748 16,165,159,010 1,692,290,257 2,933,767
## sqrft 177,205 1,692,290,257 385,820,561 654,755
## bdrms 314 2,933,767 654,755 1,182
## --------------------------------------------------------------# Normalización
library(stargazer)
options(scipen = 99999)
Sn <- solve(diag(sqrt(diag(Matriz_XX))))
stargazer(Sn, type = "text")##
## ==========================
## 0.107 0 0 0
## 0 0.00001 0 0
## 0 0 0.0001 0
## 0 0 0 0.029
## --------------------------# Sigma matriz normalizada
library(stargazer)
options(scipen = 99999)
XX_normalizada <- (Sn%*%Matriz_XX)%*%Sn
stargazer(XX_normalizada,type = "text",digits = 4)##
## ===========================
## 1 0.6655 0.9617 0.9736
## 0.6655 1 0.6776 0.6712
## 0.9617 0.6776 1 0.9696
## 0.9736 0.6712 0.9696 1
## ---------------------------# Autovalores de sigma matriz normalizada
library(stargazer)
lambda<-eigen(XX_normalizada,symmetric = TRUE)
stargazer(lambda$values,type = "text")##
## =======================
## 3.482 0.455 0.039 0.025
## -----------------------K<-sqrt(max(lambda$values)/min(lambda$values))
print(K)## [1] 11.86778Usando mctest
library(mctest)
eigprop(model_price)##
## Call:
## eigprop(mod = model_price)
##
## Eigenvalues CI (Intercept) lotsize sqrft bdrms
## 1 3.4816 1.0000 0.0037 0.0278 0.0042 0.0029
## 2 0.4552 2.7656 0.0068 0.9671 0.0061 0.0051
## 3 0.0385 9.5082 0.4726 0.0051 0.8161 0.0169
## 4 0.0247 11.8678 0.5170 0.0000 0.1737 0.9750
##
## ===============================
## Row 2==> lotsize, proportion 0.967080 >= 0.50
## Row 3==> sqrft, proportion 0.816079 >= 0.50
## Row 4==> bdrms, proportion 0.975026 >= 0.50El índice de condición es de 11.8678, por lo que existe evidencia que los regresores presentan leve multicolinealidad.
Prueba de Farrar-Glaubar
# Normalizar matriz X
library(stargazer)
Zn<-scale(Matriz_X[,-1])
stargazer(head(Zn,n=6),type = "text")##
## =======================
## lotsize sqrft bdrms
## -----------------------
## 1 -0.284 0.735 0.513
## 2 0.087 0.108 -0.675
## 3 -0.375 -1.108 -0.675
## 4 -0.434 -0.980 -0.675
## 5 -0.287 0.867 0.513
## 6 -0.045 1.283 1.702
## -----------------------# Calcular matriz R
library(stargazer)
n<-nrow(Zn)
R<-(t(Zn)%*%Zn)*(1/(n-1))
stargazer(R,type = "text",digits = 4)##
## =============================
## lotsize sqrft bdrms
## -----------------------------
## lotsize 1 0.1838 0.1363
## sqrft 0.1838 1 0.5315
## bdrms 0.1363 0.5315 1
## -----------------------------# Determinante de R
determinante_R<-det(R)
print(determinante_R)## [1] 0.6917931# Estadístico FG
m<-ncol(Matriz_X[,-1])
n<-nrow(Matriz_X[,-1])
chi_FG<--(n-1-(2*m+5)/6)*log(determinante_R)
print(chi_FG)## [1] 31.38122# Valor crítico
gl<-m*(m-1)/2
ValorC<-qchisq(p = 0.95,df = gl)
print(ValorC)## [1] 7.814728Dado que el estadístico de Farrar-Glaubar es mayor que el valor crítico, se rechaza la Ho. Por lo tanto, hay evidencia de colinealidad en los regresores.
Usando librería Psych
library(psych)
FG_test<-cortest.bartlett(Matriz_X[,-1])
print(FG_test)## $chisq
## [1] 31.38122
##
## $p.value
## [1] 0.0000007065806
##
## $df
## [1] 3#Gráfica
library(magrittr)
library(fastGraph)
shadeDist(xshade= FG_test$chisq, ddist = "dchisq", parm1 = FG_test$df, lower.tail = FALSE, sub = paste("VC:" ,ValorC%>%round(digits = 6), "FG:" ,FG_test$chisq%>%round(digits = 6)), col = "black")
- Factores inflacionarios de la varianza
# Inversa de la matriz de correlación
inversa_R <- solve(R)
print(inversa_R)## lotsize sqrft bdrms
## lotsize 1.03721145 -0.1610145 -0.05582352
## sqrft -0.16101454 1.4186543 -0.73202696
## bdrms -0.05582352 -0.7320270 1.39666321#VIF’s para el modelo estimado
VIFs <- diag(inversa_R)
print(VIFs)## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663Usando librería “Car”
library(car)
vifs <- vif(model_price)
print(vifs)## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663#Gráfica
library(mctest)
mc.plot(mod = model_price,vif = 2)
Interpretación: Los Valores Inflacionarios de la Varianza de los regresores son menores que 2, existe evidencia de multicolinealidad leve.