knitr::opts_chunk$set(echo = TRUE)
Ejercicio de pruebas de Multicolinealidad
Importación de datos
library(wooldridge)
data(hprice1)
head(force(hprice1),n=5) #Se muestras 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.829630
Estimación del modelo
library(stargazer)
modelo_price<-lm(formula = price~lotsize+sqrft+bdrms,data = hprice1)
stargazer(modelo_price,title = "Modelo Price",type = "html")
Modelo Price
|
|
|
|
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.01
|
Calculo de Sigma Matriz
#Cálculo de matriz X
library(stargazer)
Matriz_X<-model.matrix(modelo_price)
stargazer(head(Matriz_X,n=6),type = "html")
|
|
|
|
(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
|
|
|
#Calculo de la Sigma Matriz
Matriz_XX<-t(Matriz_X)%*%Matriz_X
stargazer(Matriz_XX,type = "html")
|
|
|
|
(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 de la Sigma Matriz
#Cálculo de la matriz de normalización
library(stargazer)
options(scipen = 999999)
SN<-solve(diag(sqrt(diag(Matriz_XX))))
stargazer(SN,type = "html")
|
|
|
0.107
|
0
|
0
|
0
|
|
0
|
0.00001
|
0
|
0
|
|
0
|
0
|
0.0001
|
0
|
|
0
|
0
|
0
|
0.029
|
|
|
#Cálculo de la Sigma Matriz Normalizada
library(stargazer)
Norm_XX<-(SN%*%Matriz_XX)%*%SN
stargazer(Norm_XX,type = "html",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 de la Sigma Matriz Normalizada
library(stargazer)
autoval<-eigen(Norm_XX,symmetric=TRUE)
stargazer(autoval$values,type = "html")
Cálculo del Indice de Condición
K<-sqrt(max(autoval$values)/min(autoval$values)) #Interpretación: Se evidencia que la multicolinealidad es leve al ser el indice de condición es menor a 20, por lo tanto no se considera un problema
print(K)
## [1] 11.86778
Calculo del Indice de Condición con McTest
library(mctest)
mctest(modelo_price)
##
## 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.6918 0
## Farrar Chi-Square: 31.3812 1
## Red Indicator: 0.3341 0
## Sum of Lambda Inverse: 3.8525 0
## Theil's Method: -0.7297 0
## Condition Number: 11.8678 0
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test
Prueba de Farrar Glaubar
#Normalizar Matriz X
library(stargazer)
ZN<-scale(Matriz_X[,-1])
stargazer(head(ZN,n=6),type = "html")
|
|
|
|
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
|
|
|
#Calculo de Matriz R
n<-nrow(ZN)
R<-(t(ZN)%*%ZN)*(1/(n-1))
stargazer(R,type = "html", digits = 4)
|
|
|
|
lotsize
|
sqrft
|
bdrms
|
|
|
|
lotsize
|
1
|
0.1838
|
0.1363
|
|
sqrft
|
0.1838
|
1
|
0.5315
|
|
bdrms
|
0.1363
|
0.5315
|
1
|
|
|
#Cálculo de R
determinante_R<-det(R) #Interpretación: Al ser R, un valor cercano a 1 se puede confirmar que la multicolinealidad es leve.
print(determinante_R)
[1] 0.6917931
Aplicando prueba Farrar Glaubar (Bartlett)
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
library(fastGraph)
gl<-m*(m-1)/2
VC<-qchisq(p=0.95,df=gl)
print(VC)
## [1] 7.814728
shadeDist(xshade = chi_FG,ddist = "dchisq",parm1 = gl,lower.tail = FALSE, sub=paste("VC:",VC))
#Interpretación: Al ser mayor el estadistico de prueba superior al valor crítico, hay evidencia para rechazar la hipótesis nula, indicando que existe colinealidad en los regresores.
Prueba Farrar Glaubar usando librería Psych
library(psych)
options(scipen = 99999)
FG_test<-cortest.bartlett(Matriz_X[,-1])
## R was not square, finding R from data
print(FG_test)
## $chisq
## [1] 31.38122
##
## $p.value
## [1] 0.0000007065806
##
## $df
## [1] 3
#Interpretación: Al ser el p-value menor que el de nivel de significancia se evidencia que existe colinealidad entre los regresores.
Factores Inflacionarios de la Varianza
Calculo de la 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 para Modelo_price
VIFs<-diag(inversa_R)
print(VIFs)
## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663
VIFs usando librería CAR
library(car)
VIFs_CAR<-vif(modelo_price)
print(VIFs_CAR)
## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663
Obtención de los VIFs usando librería McTest
library(mctest)
mc.plot(modelo_price, vif = 2)
