Carga de datos y estimación del modelo

library(wooldridge)
data("hprice1")
head(force(hprice1), n = 5)
price assess bdrms lotsize sqrft colonial lprice lassess llotsize lsqrft
300 349.1 4 6126 2438 1 5.703783 5.855359 8.720297 7.798934
370 351.5 3 9903 2076 1 5.913503 5.862210 9.200593 7.638198
191 217.7 3 5200 1374 0 5.252274 5.383118 8.556414 7.225481
195 231.8 3 4600 1448 1 5.273000 5.445875 8.433811 7.277938
373 319.1 4 6095 2514 1 5.921578 5.765504 8.715224 7.829630 
modelo_precios <- lm(formula = price ~ lotsize + sqrft + bdrms, data = hprice1)

library(stargazer)
stargazer(modelo_precios, title = "Modelo de precios de casas", type = "html")
Modelo de precios de casas
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

Índice de condición

Cálculo “manual”

library(magrittr)
options(scipen = 999999)
X_mat <- model.matrix(modelo_precios)
XX_mat <- t(X_mat) %*% X_mat
S_n <- 
  XX_mat %>%
  diag() %>% 
  sqrt() %>% 
  diag() %>% 
  solve()
XX_norm <- (S_n %*% XX_mat) %*% S_n
Raiz_caract <- eigen(XX_norm, symmetric = TRUE)
Num_cond <- sqrt(max(Raiz_caract$values)/min(Raiz_caract$values))

Matriz \(X\)

stargazer(head(X_mat, n = 10), 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
7 1 9,000 2,067 3
8 1 6,210 1,731 3
9 1 6,000 1,767 3
10 1 2,892 1,890 3

Matriz \(X^tX\)

stargazer(XX_mat, 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

Matriz de normalización \(S_n\)

stargazer(S_n, type = "html")
0.107 0 0 0
0 0.00001 0 0
0 0 0.0001 0
0 0 0 0.029

Matriz \(X^tX\) normalizada

stargazer(XX_norm, type = "html")
1 0.666 0.962 0.974
0.666 1 0.678 0.671
0.962 0.678 1 0.970
0.974 0.671 0.970 1

Raíces características \(𝜆\)

print(Raiz_caract$values)

[1] 3.48158596 0.45518380 0.03851083 0.02471941

Número de condición \(𝜅(x)\)

print(Num_cond)

[1] 11.86778

La multicolinealidad se considera leve debido a que \(𝜅(x)≤20\).

Prueba de Farrar-Glaubar

Cálculo “manual”

Matriz \(R\)

Zn <- scale(X_mat[,-1])
n <- nrow(Zn)
R_mat <- (t(Zn) %*% Zn) * (1/(n-1))
stargazer(R_mat, type = "html")
lotsize sqrft bdrms
lotsize 1 0.184 0.136
sqrft 0.184 1 0.531
bdrms 0.136 0.531 1

Cálculo de \(|R|\)

det_R <- det(R_mat)
print(det_R)

[1] 0.6917931

Estadístico \(\chi_{FG}^2\)

m <- ncol(X_mat[,-1])
chi_FG <- -(n-1-(2*m+5)/6) * log(det_R)
print(chi_FG)

[1] 31.38122

Valor crítico

gl <- m*(m-1)/2
vc <- qchisq(p = 0.95, df = gl)
print(vc)

[1] 7.814728

Gráfica usando fastGraph

library(fastGraph)
shadeDist(vc,
          ddist = "dchisq",
          parm1 = gl,
          lower.tail = FALSE,
          xmin = 0,
          sub = paste("VC:",
                      round(vc,2),
                      " ChiSq FG:",
                      round(chi_FG,2)))

Se rechaza \(H_0\) porque \(\chi_{FG}^2≥VC\). Por lo tanto, hay evidencia de multicolinealidad.

Factores Inflacionarios de la Varianza (FIV)

Cálculo “manual”

Matriz \(R\)

stargazer(R_mat, type = "html")
lotsize sqrft bdrms
lotsize 1 0.184 0.136
sqrft 0.184 1 0.531
bdrms 0.136 0.531 1

Inversa de la matriz de correlación \(R^{-1}\)

inv_R <- solve(R_mat)
stargazer(inv_R, type = "html")
lotsize sqrft bdrms
lotsize 1.037 -0.161 -0.056
sqrft -0.161 1.419 -0.732
bdrms -0.056 -0.732 1.397

Vector de FIV

FIV <- diag(inv_R)
stargazer(FIV, type = "html")
lotsize sqrft bdrms
1.037 1.419 1.397

Cálculo y gráfica usando performance

library(performance)
FIV2 <- multicollinearity(x = modelo_precios, verbose = FALSE)
print(FIV2)
## # 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(FIV2)

Gráfica usando mctest

library(mctest)
mc.plot(mod = modelo_precios, vif = 2)

Usando un umbral del FIV de 2, las variables del modelo se consideran aceptables debido a que tienen un muy leve nivel de colinealidad.