Prueba de Colinealidad
Kevin Adonay Lemus Perez LP16027
28/5/2021
Carga de Datos
library(wooldridge)
data(hprice1)
head(force(hprice1),n=5)## 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. Estimacion del Modelo
modelo_hprice1<-lm(formula = price~ (lotsize) + (sqrft) + (bdrms) , data = hprice1)
library(stargazer)
stargazer(modelo_hprice1, title = "hprice1", type = "text", digits = 8)##
## hprice1
## ===============================================
## Dependent variable:
## ---------------------------
## price
## -----------------------------------------------
## lotsize 0.00206771***
## (0.00064213)
##
## sqrft 0.12277820***
## (0.01323741)
##
## bdrms 13.85252000
## (9.01014500)
##
## Constant -21.77031000
## (29.47504000)
##
## -----------------------------------------------
## Observations 88
## R2 0.67236220
## Adjusted R2 0.66066090
## Residual Std. Error 59.83348000 (df = 84)
## F Statistic 57.46023000*** (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:
a) Indice de condición y prueba de FG, presente sus resultados de manera tabular en ambos casos y para la prueba de FG presente también sus resultados de forma gráfica usando la librería fastGraph
Calcular la matriz |Xt X|
X_mat<-model.matrix(modelo_hprice1)
print(X_mat)## (Intercept) lotsize sqrft bdrms
## 1 1 6126 2438 4
## 2 1 9903 2076 3
## 3 1 5200 1374 3
## 4 1 4600 1448 3
## 5 1 6095 2514 4
## 6 1 8566 2754 5
## 7 1 9000 2067 3
## 8 1 6210 1731 3
## 9 1 6000 1767 3
## 10 1 2892 1890 3
## 11 1 6000 2336 4
## 12 1 7047 2634 5
## 13 1 12237 3375 3
## 14 1 6460 1899 3
## 15 1 6519 2312 3
## 16 1 3597 1760 4
## 17 1 5922 2000 4
## 18 1 7123 1774 3
## 19 1 5642 1376 3
## 20 1 8602 1835 4
## 21 1 5494 2048 3
## 22 1 7800 2124 3
## 23 1 6003 1768 3
## 24 1 5218 1732 4
## 25 1 9425 1440 3
## 26 1 6114 1932 3
## 27 1 6710 1932 3
## 28 1 8577 2106 3
## 29 1 8400 3529 7
## 30 1 9773 2051 4
## 31 1 4806 1573 4
## 32 1 15086 2829 4
## 33 1 5763 1630 3
## 34 1 6383 1840 4
## 35 1 9000 2066 4
## 36 1 3500 1702 4
## 37 1 10892 2750 4
## 38 1 15634 3880 5
## 39 1 6400 1854 4
## 40 1 8880 1421 2
## 41 1 6314 1662 3
## 42 1 28231 3331 5
## 43 1 7050 1656 4
## 44 1 5305 1171 3
## 45 1 6637 2293 5
## 46 1 7834 1764 3
## 47 1 1000 2768 3
## 48 1 8112 3733 4
## 49 1 5850 1536 3
## 50 1 6660 1638 4
## 51 1 6637 1972 3
## 52 1 15267 1478 2
## 53 1 5146 1408 3
## 54 1 6017 1812 3
## 55 1 8410 1722 3
## 56 1 5625 1780 4
## 57 1 5600 1674 4
## 58 1 6525 1850 4
## 59 1 6060 1925 3
## 60 1 5539 2343 4
## 61 1 7566 1567 3
## 62 1 5484 1664 4
## 63 1 5348 1386 6
## 64 1 15834 2617 5
## 65 1 8022 2321 4
## 66 1 11966 2638 4
## 67 1 8460 1915 4
## 68 1 15105 2589 4
## 69 1 10859 2709 4
## 70 1 6300 1587 3
## 71 1 11554 1694 3
## 72 1 6000 1536 3
## 73 1 31000 3662 5
## 74 1 4054 1736 3
## 75 1 20700 2205 2
## 76 1 5525 1502 3
## 77 1 92681 1696 4
## 78 1 8178 2186 3
## 79 1 5944 1928 4
## 80 1 18838 1294 3
## 81 1 4315 1535 4
## 82 1 5167 1980 3
## 83 1 7893 2090 4
## 84 1 6056 1837 3
## 85 1 5828 1715 3
## 86 1 6341 1574 3
## 87 1 6362 1185 2
## 88 1 4950 1774 4
## attr(,"assign")
## [1] 0 1 2 3XX_mat<-t(X_mat)%*%X_mat
print(XX_mat)## (Intercept) lotsize sqrft bdrms
## (Intercept) 88 793748 177205 314
## lotsize 793748 16165159010 1692290257 2933767
## sqrft 177205 1692290257 385820561 654755
## bdrms 314 2933767 654755 1182head(force(hprice1),n=5)## 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.829630Normalizacion |XtX|
library(stargazer)
options(scipen = 999)
Sn<-solve(diag(sqrt(diag(XX_mat))))
stargazer(Sn,type = "text")##
## ==========================
## 0.107 0 0 0
## 0 0.00001 0 0
## 0 0 0.0001 0
## 0 0 0 0.029
## --------------------------Normalizada:
library(stargazer)
XX_norm<-(Sn%*%XX_mat)%*%Sn
stargazer(XX_norm,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
## ---------------------------Cálculo del indice de condición
Autovalores Normalizada:
library(stargazer)
lambdas<-eigen(XX_norm,symmetric = TRUE)
stargazer(lambdas$values,type = "text")##
## =======================
## 3.482 0.455 0.039 0.025
## -----------------------# Calculo de K(x)
K<-sqrt(max(lambdas$values)/min(lambdas$values))
print(K)## [1] 11.86778Obtencion del Indice de Condicón
library(mctest)
eigprop(mod=modelo_hprice1)##
## Call:
## eigprop(mod = modelo_hprice1)
##
## 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.50Prueba FG
Calculo de |R|,Normalizar la matriz X
library(stargazer)
Zn<-scale(X_mat[,-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 la 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
## -----------------------------#R
determinante_R<-det(R)
print(determinante_R)## [1] 0.6917931Estadistico χ2FG
m<-ncol(X_mat[,-1])
n<-nrow(X_mat[,-1])
chi_FG<--(n-1-(2*m+5)/6)*log(determinante_R)
print(chi_FG)## [1] 31.38122Valor Critico
gl<-m*(m-1)/2
VC<-qchisq(p = 0.95,df = gl)
print(VC)## [1] 7.814728Hay evidencia de colinealidad en los regresores, por lo que H0 se rechaza.
fastGraph::shadeDist(xshade = chi_FG,ddist = "dchisq",parm1 = gl,lower.tail = FALSE,sub=paste("VC:",VC,"FG:",chi_FG))