Ejercicio de multicolinealidad
KEVIN ALBERTO LANDAVER FRANDO
2024-05-12
Datos del modelo
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.Modelo estimado
library(stargazer)##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazermodelo_estimado<-lm(price~bdrms+lotsize+sqrft,data = hprice1)
head(modelo_estimado)## $coefficients
## (Intercept) bdrms lotsize sqrft
## -21.770308148 13.852521744 0.002067707 0.122778185
##
## $residuals
## 1 2 3 4 5 6
## -45.639765 74.848732 -8.236558 -12.081520 18.093192 62.939597
## 7 8 9 10 11 12
## 40.320875 69.843246 -43.142550 -17.817835 -47.855859 -85.461169
## 13 14 15 16 17 18
## -54.466158 -54.300415 -52.129801 -29.766931 -51.441108 32.675968
## 19 20 21 22 23 24
## 67.603959 33.275839 -16.596960 -26.696234 -24.271531 -107.080889
## 25 26 27 28 29 30
## 30.924022 5.363331 -40.869022 46.907165 -48.350295 44.334467
## 31 32 33 34 35 36
## -6.707262 -77.172687 19.168108 -37.749811 55.091131 -59.845223
## 37 38 39 40 41 42
## -33.801248 18.801816 -65.502849 26.236229 9.099900 198.660139
## 43 44 45 46 47 48
## -3.537785 55.470305 32.253952 12.433611 -48.704980 -91.243980
## 49 50 51 52 53 54
## 32.529367 66.478628 -11.629207 36.031430 6.700640 -74.702719
## 55 56 57 58 59 60
## 1.399296 -13.815798 -41.749618 -16.271207 20.334434 -16.762094
## 61 62 63 64 65 66
## -2.824941 16.718018 67.426518 69.707122 -0.195089 112.729191
## 67 68 69 70 71 72
## -6.752801 -2.745208 -63.699108 -7.662789 -36.663785 19.219211
## 73 74 75 76 77 78
## 163.795081 -11.312669 -13.462160 209.375830 -115.508697 24.909926
## 79 80 81 82 83 84
## -36.646568 7.386314 -120.026447 -5.446904 -62.566594 37.147186
## 85 86 87 88
## -6.402439 -23.651448 54.418366 -19.683427
##
## $effects
## (Intercept) bdrms lotsize sqrft
## -2753.7058885 486.7680086 268.7113603 554.9610899 25.4866980
##
## 79.8846254 38.3465749 68.9602787 -44.1073961 -18.8977985
##
## -39.9794564 -68.0903889 -60.1637880 -55.6501929 -54.5888895
##
## -20.1835745 -42.6601484 31.6150481 67.7101416 42.3137908
##
## -18.2789552 -28.7404300 -25.2392601 -97.5342378 30.5983950
##
## 3.9490697 -42.3243300 44.8576279 -12.7398954 52.7137241
##
## 3.2932703 -71.2413766 18.5862159 -28.5724173 63.4834829
##
## -50.0999693 -27.3696821 32.2467317 -56.3640927 15.6350078
##
## 8.3944236 212.7067033 6.0860829 56.1483057 50.5655342
##
## 11.3504854 -52.0042977 -87.2516059 32.1930408 76.1775257
##
## -13.1865331 24.8377960 6.7553450 -75.7891627 0.3888991
##
## -4.4256324 -32.0740589 -7.1303545 18.9426251 -8.8726749
##
## -3.3624090 26.4283272 98.6181130 86.5182358 7.5822006
##
## 119.3865196 2.0808382 3.8270677 -57.1555475 -8.1665896
##
## -37.8157766 18.8725543 176.7651392 -12.0605337 -26.9755231
##
## 209.1528754 -111.8892845 22.6737755 -27.6744413 6.8031314
##
## -109.8904060 -6.9244001 -54.1622307 35.9911525 -7.2162797
##
## -24.1232829 44.6221298 -10.2307172
##
## $rank
## [1] 4
##
## $fitted.values
## 1 2 3 4 5 6 7 8
## 345.6398 295.1513 199.2366 207.0815 354.9068 403.3354 292.1791 245.1568
## 9 10 11 12 13 14 15 16
## 249.1425 257.8178 332.8559 385.4612 459.4662 266.3004 317.1298 257.1669
## 17 18 19 20 21 22 23 24
## 291.4411 252.3240 200.3960 276.7242 282.5970 296.6962 249.2715 257.0809
## 25 26 27 28 29 30 31 32
## 216.0760 269.6367 270.8690 296.0928 525.8503 305.6655 236.7073 412.1727
## 33 34 35 36 37 38 39 40
## 231.8319 272.7498 305.9089 249.8452 393.8012 556.1982 274.5039 198.7638
## 41 42 43 44 45 46 47 48
## 236.9001 514.8399 251.5378 174.5297 342.7460 252.5664 361.7050 508.7440
## 49 50 51 52 53 54 55 56
## 220.4706 248.5214 275.6292 218.9686 203.2994 254.7027 248.6007 263.8158
## 57 58 59 60 61 62 63 64
## 250.7496 274.2712 268.6656 332.7621 227.8249 249.2820 242.5735 401.5429
## 65 66 67 68 69 70 71 72
## 335.1951 382.2708 286.2528 382.7452 388.6991 227.6628 251.6638 220.7808
## 73 74 75 76 77 78 79 80
## 561.2049 241.3127 319.4622 215.6242 433.5087 305.0901 282.6466 217.6137
## 81 82 83 84 85 86 87 88
## 231.0264 273.5719 306.5666 257.8528 242.4024 226.1514 164.5816 261.6834
##
## $assign
## [1] 0 1 2 32. Verifique si hay evidencia de la dependencia 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 prueba de FG presente también sus resultados de forma gráfica usando la librería fasGraph
Calculo manual del índice de condición
library(stargazer)
X_mat<-model.matrix(modelo_estimado)
head(X_mat,n=6)## (Intercept) bdrms lotsize sqrft
## 1 1 4 6126 2438
## 2 1 3 9903 2076
## 3 1 3 5200 1374
## 4 1 3 4600 1448
## 5 1 4 6095 2514
## 6 1 5 8566 2754XX_matrix<-t(X_mat)%*%X_mat
head(XX_matrix)## (Intercept) bdrms lotsize sqrft
## (Intercept) 88 314 793748 177205
## bdrms 314 1182 2933767 654755
## lotsize 793748 2933767 16165159010 1692290257
## sqrft 177205 654755 1692290257 385820561library(stargazer)
options(scipen = 999)
Sn<-solve(diag(sqrt(diag(XX_matrix))))
head(Sn)## [,1] [,2] [,3] [,4]
## [1,] 0.1066004 0.00000000 0.000000000000 0.00000000000
## [2,] 0.0000000 0.02908649 0.000000000000 0.00000000000
## [3,] 0.0000000 0.00000000 0.000007865204 0.00000000000
## [4,] 0.0000000 0.00000000 0.000000000000 0.00005091049XtX normalizada:
library(stargazer)
XX_norm<-(Sn%*%XX_matrix)%*%Sn
head(XX_norm,n=4)## [,1] [,2] [,3] [,4]
## [1,] 1.0000000 0.9735978 0.6655050 0.9617052
## [2,] 0.9735978 1.0000000 0.6711613 0.9695661
## [3,] 0.6655050 0.6711613 1.0000000 0.6776293
## [4,] 0.9617052 0.9695661 0.6776293 1.0000000Autovalores de XtX Normalizada:
library(stargazer)
lambdas<-eigen(XX_norm,symmetric = TRUE)
head(lambdas$values)## [1] 3.48158596 0.45518380 0.03851083 0.02471941K<-sqrt(max(lambdas$values)/min(lambdas$values))
print(K)## [1] 11.86778Calculo del índice 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 test##Calculo del índice 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 bdrms lotsize sqrft
## 1 3.48158596 1.000000 0.003663034 0.002939554 0.0277802824 0.004156293
## 2 0.45518380 2.765637 0.006800735 0.005096396 0.9670803174 0.006067321
## 3 0.03851083 9.508174 0.472581427 0.016938178 0.0051085488 0.816079307
## 4 0.02471941 11.867781 0.516954804 0.975025872 0.0000308514 0.173697079Pruena de Farrar-Glaubar
Cálculo manual
library(stargazer)
Zn<-scale(X_mat[,-1])
head(Zn,n=6)## bdrms lotsize sqrft
## 1 0.5132184 -0.28443295 0.7351230
## 2 -0.6752874 0.08680198 0.1079482
## 3 -0.6752874 -0.37544792 -1.1082857
## 4 -0.6752874 -0.43442091 -0.9800787
## 5 0.5132184 -0.28747989 0.8667951
## 6 1.7017243 -0.04460949 1.2826015Calcular la matriz R
library(stargazer)
n<-nrow(Zn)
R<-(t(Zn)%*%Zn)*(1/(n-1))
head(R,n=4)## bdrms lotsize sqrft
## bdrms 1.0000000 0.1363256 0.5314736
## lotsize 0.1363256 1.0000000 0.1838422
## sqrft 0.5314736 0.1838422 1.0000000Calcular |R|
determinante_R<-det(R)
print(determinante_R)## [1] 0.6917931Aplicando la prueba de Farrer Glaubar (Bartlett)
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
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] 3Factores inflacionarios de la varianza (FIV)
Referencia entre R2
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áluclo manual
print(R)## bdrms lotsize sqrft
## bdrms 1.0000000 0.1363256 0.5314736
## lotsize 0.1363256 1.0000000 0.1838422
## sqrft 0.5314736 0.1838422 1.0000000Inversa de la matriz de correlación R−1:
inversa_R<-solve(R)
print(inversa_R)## bdrms lotsize sqrft
## bdrms 1.39666321 -0.05582352 -0.7320270
## lotsize -0.05582352 1.03721145 -0.1610145
## sqrft -0.73202696 -0.16101454 1.4186543VIF’s para el modelo estimado
VIFs<-diag(inversa_R)
print(VIFs)## bdrms lotsize sqrft
## 1.396663 1.037211 1.418654Cá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
## bdrms 1.40 [1.17, 1.95] 1.18 0.72 [0.51, 0.86]
## 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]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':
##
## logitVIFs_car<-vif(modelo_estimado)
print(VIFs_car)## bdrms lotsize sqrft
## 1.396663 1.037211 1.418654Cálculo de los VIF’s usando “mctest”
library(mctest)
mc.plot(mod = modelo_estimado,vif = 2)