Ejercicio multicolinealidad
Mariana Guadaluper Rodriguez Melgar
2023-05-15
Importación 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.829630Modelo Estimado
library(stargazer)
modelo_estimado<-lm(formula=price~lotsize+sqrft+bdrms, data=hprice1)
stargazer(modelo_estimado, title = "Modelo para Ejercicio", type = "html", out.type="html")| 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 |
| html |
Indice de Condición
Cálculo “manual”
Se basa la matriz XtX
library(stargazer)
X_mat<-model.matrix(modelo_estimado)
stargazer(head(X_mat,n=6),type="html", out.type="html")| 1 | 6,126 | 2,438 | 4 |
| 1 | 9,903 | 2,076 | 3 |
| 1 | 5,200 | 1,374 | 3 |
| 1 | 4,600 | 1,448 | 3 |
| 1 | 6,095 | 2,514 | 4 |
| 1 | 8,566 | 2,754 | 5 |
| html |
XX_matrix<-t(X_mat)%*%X_mat
stargazer(XX_matrix,type = "html", out.type="html")| 88 | 793,748 | 177,205 | 314 |
| 793,748 | 16,165,159,010 | 1,692,290,257 | 2,933,767 |
| 177,205 | 1,692,290,257 | 385,820,561 | 654,755 |
| 314 | 2,933,767 | 654,755 | 1,182 |
| html |
Cálculo de la matriz de normalización
library(stargazer)
options(scipen = 999)
Sn<-solve(diag(sqrt(diag(XX_matrix))))
stargazer(Sn,type = "html", out.type="html")| 0.107 | 0 | 0 | 0 |
| 0 | 0.00001 | 0 | 0 |
| 0 | 0 | 0.0001 | 0 |
| 0 | 0 | 0 | 0.029 |
| html |
XtX normalizada:
library(stargazer)
XX_norm<-(Sn%*%XX_matrix)%*%Sn
stargazer(XX_norm,type = "html", out.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 |
| html |
Autovalores de XtX Normalizada:
library(stargazer)
#autovalores
lambdas<-eigen(XX_norm,symmetric = TRUE)
stargazer(lambdas$values,type = "html", out.type="html")| 3.482 | 0.455 | 0.039 | 0.025 |
| html |
Cálculo de κ(x)
K<-sqrt(max(lambdas$values)/min(lambdas$values))
print(K)## [1] 11.86778Como κ(x) es inferior a 20, la multicolinealidad es leve, no se considera un problema.
Cálculo del Indice de Condición usando librería “mctest”
library(mctest)
X_mat<-model.matrix(modelo_estimado)
mctest(mod = modelo_estimado)##
## 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 testCálculo del Indice de Condición usando librería “olsrr”
library(olsrr)##
## Attaching package: 'olsrr'## The following object is masked from 'package:wooldridge':
##
## cement## The following object is masked from 'package:datasets':
##
## riversols_eigen_cindex(model = modelo_estimado)## Eigenvalue Condition Index intercept lotsize sqrft bdrms
## 1 3.48158596 1.000000 0.003663034 0.0277802824 0.004156293 0.002939554
## 2 0.45518380 2.765637 0.006800735 0.9670803174 0.006067321 0.005096396
## 3 0.03851083 9.508174 0.472581427 0.0051085488 0.816079307 0.016938178
## 4 0.02471941 11.867781 0.516954804 0.0000308514 0.173697079 0.975025872Prueba de Farrar-Glaubar
Cálculo “manual”
Cálculo de |R|
library(stargazer)
Zn<-scale(X_mat[,-1])
stargazer(head(Zn,n=6),type = "html", out.type="html")| -0.284 | 0.735 | 0.513 |
| 0.087 | 0.108 | -0.675 |
| -0.375 | -1.108 | -0.675 |
| -0.434 | -0.980 | -0.675 |
| -0.287 | 0.867 | 0.513 |
| -0.045 | 1.283 | 1.702 |
| html |
Calcular la matriz R
library(stargazer)
n<-nrow(Zn)
R<-(t(Zn)%*%Zn)*(1/(n-1))
#También se puede calcular R a través de cor(X_mat[,-1])
stargazer(R,type = "html", out.type="html",digits = 4)| 1 | 0.1838 | 0.1363 |
| 0.1838 | 1 | 0.5315 |
| 0.1363 | 0.5315 | 1 |
| html |
Calcular |R|
determinante_R<-det(R)
print(determinante_R)## [1] 0.6917931Aplicando la prueba de Farrer Glaubar (Bartlett)
Estadistico χ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.814728Regla de desición:
Como χ2FG ≥ V.C. se rechaza H0, por lo tanto hay evidencia de colinealidad en los regresores
Cálculo de FG usando “mctest”
library(mctest)
mctest::omcdiag(mod = modelo_estimado)##
## Call:
## mctest::omcdiag(mod = modelo_estimado)
##
##
## 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 testCálculo de FG usando la “psych”
library(psych)
FG_test<-cortest.bartlett(X_mat[,-1])## R was not square, finding R from dataprint(FG_test)## $chisq
## [1] 31.38122
##
## $p.value
## [1] 0.0000007065806
##
## $df
## [1] 3library(magrittr)
library(fastGraph)
shadeDist(xshade = FG_test$chisq, ddist = "dchisq", parm1 = FG_test$df, lower.tail = FALSE, sub=paste("VC", VC %>% round(digits = 6),"FG", FG_test$chisq%>%round(digits = 6)), col = "black")
Factores Inflacionarios de la Varianza (FIV)
Referencia entre R2j
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionR.cuadrado.regresores<-c(0,0.5,.8,.9)
as.data.frame(R.cuadrado.regresores) %>% mutate(VIF=1/(1-R.cuadrado.regresores))## R.cuadrado.regresores VIF
## 1 0.0 1
## 2 0.5 2
## 3 0.8 5
## 4 0.9 10Cálculo manual
Matriz de Correlación de los regresores del modelo (Como se obtuvo con anterioridad):
print(R)## lotsize sqrft bdrms
## lotsize 1.0000000 0.1838422 0.1363256
## sqrft 0.1838422 1.0000000 0.5314736
## bdrms 0.1363256 0.5314736 1.0000000Inversa de la matriz de correlación R−1:
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.39666321VIF’s para el modelo estimado:
VIFs<-diag(inversa_R)
print(VIFs)## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663Cálculo de los VIF’s usando “performance”
library(performance)
VIFs<-multicollinearity(x = modelo_estimado,verbose = FALSE)
VIFs## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI Increased SE Tolerance Tolerance 95% CI
## lotsize 1.04 [1.00, 11.02] 1.02 0.96 [0.09, 1.00]
## sqrft 1.42 [1.18, 1.98] 1.19 0.70 [0.51, 0.85]
## bdrms 1.40 [1.17, 1.95] 1.18 0.72 [0.51, 0.86]plot(VIFs)## Variable `Component` is not in your data frame :/
Cálculo de los VIF’s usando “car”
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## The following object is masked from 'package:psych':
##
## logitlibrary(carData)
VIFs_car<-vif(modelo_estimado)
print(VIFs_car)## lotsize sqrft bdrms
## 1.037211 1.418654 1.396663Cálculo de los VIF’s usando “mctest”
library(mctest)
mc.plot(mod = modelo_estimado,vif = 2)