Utilizando los datos del dataframe hprice1: disponible en el paquete wooldridge use el siguiente código para generar el dataframe:

#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.829630

1. Estimación del modelo

#Sigma matriz
library(stargazer)
modelo_precio <- lm(formula = price ~ lotsize + sqrft + bdrms, data = hprice1)
stargazer(modelo_precio, title = "Modelo precio", type = "html")
Modelo precio
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

2. 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

Indice de condicion
options(scipen = 999999)
Matriz_X <- model.matrix(modelo_precio)
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
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
library(stargazer)
options(scipen = 99999)
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
#Sigma matriz normalizada
library(stargazer)
options(scipen = 99999)
XX_norm <- (Sn%*%Matriz_XX)%*%Sn
stargazer(XX_norm,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
#Autovalores de sigma matriz normalizada
library(stargazer)
lambdas<-eigen(XX_norm,symmetric = TRUE)
stargazer(lambdas$values,type = "html")
3.482 0.455 0.039 0.025
K<-sqrt(max(lambdas$values)/min(lambdas$values))
print(K)
## [1] 11.86778

Usando mctest

library(mctest)
eigprop(modelo_precio)
## 
## Call:
## eigprop(mod = modelo_precio)
## 
##   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.50

El índice de condición es de 11.8678, por lo que existe evidencia que los regresores presentan leve multicolinealidad.

Prueba de Farrar-Glaubar
#Calculo de R
#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
#Calcular matriz R
library(stargazer)
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
#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.814728

Dado 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")

b) Factores inflacionarios de la varianza, presente sus resultados de forma tabular y de forma gráfica.

#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.396663

Usando librería "Car"

library(car)
vifs <- vif(modelo_precio)
print(vifs)
##  lotsize    sqrft    bdrms 
## 1.037211 1.418654 1.396663
#Gráfica
library(mctest)
mc.plot(mod = modelo_precio,vif = 2)

Interpretación: Los Valores Inflacionarios de la Varianza de los regresores son menores que 2, existe evidencia de multicolinealidad leve.