Ejercicio Multicolinealidad

Librerias.

library(wooldridge)
library(car)
library(knitr)
library(kableExtra)
library(fastGraph)
library(corrplot)

Data

data("hprice1")
kable(head(hprice1, 5), digits = 3, caption = "Primeras 5 observaciones")
Primeras 5 observaciones
price assess bdrms lotsize sqrft colonial lprice lassess llotsize lsqrft
300 349.1 4 6126 2438 1 5.704 5.855 8.720 7.799
370 351.5 3 9903 2076 1 5.914 5.862 9.201 7.638
191 217.7 3 5200 1374 0 5.252 5.383 8.556 7.225
195 231.8 3 4600 1448 1 5.273 5.446 8.434 7.278
373 319.1 4 6095 2514 1 5.922 5.766 8.715 7.830

Estimacion del modelo.

modelo <- lm(price ~ lotsize + sqrft + bdrms, data = hprice1)
summary(modelo)
## 
## Call:
## lm(formula = price ~ lotsize + sqrft + bdrms, data = hprice1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -120.026  -38.530   -6.555   32.323  209.376 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.177e+01  2.948e+01  -0.739  0.46221    
## lotsize      2.068e-03  6.421e-04   3.220  0.00182 ** 
## sqrft        1.228e-01  1.324e-02   9.275 1.66e-14 ***
## bdrms        1.385e+01  9.010e+00   1.537  0.12795    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 59.83 on 84 degrees of freedom
## Multiple R-squared:  0.6724, Adjusted R-squared:  0.6607 
## F-statistic: 57.46 on 3 and 84 DF,  p-value: < 2.2e-16
tabla <- as.data.frame(summary(modelo)$coefficients)

knitr::kable(tabla, caption = "Coeficientes del modelo") %>%
  kable_styling(
    bootstrap_options = c("striped","hover"),
    full_width = FALSE
  )
Coeficientes del modelo
Estimate Std. Error t value Pr(>&#124;t&#124;)
(Intercept) -21.7703081 29.4750419 -0.7386014 0.4622078
lotsize 0.0020677 0.0006421 3.2200957 0.0018229
sqrft 0.1227782 0.0132374 9.2750930 0.0000000
bdrms 13.8525217 9.0101454 1.5374360 0.1279451

Verifique si hay evidencia de la independencia de los regresores (no colinealidad), a traves de:

a) Indice de condicion 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.

X <- model.matrix(modelo)[,-1]

matriz_cor <- cor(X)

valores_propios <- eigen(matriz_cor)$values

indice_condicion <- sqrt(max(valores_propios) / valores_propios)

# Tabla de Indice de Condicion.

tabla_ic <- data.frame(
  Eigenvalor = round(valores_propios, 3),
  Indice_Condicion = round(indice_condicion, 3)
)

kable(tabla_ic, caption = "Indice de condicion", format = "html") %>%
  kable_styling(
    bootstrap_options = c("striped","hover","condensed"),
    full_width = FALSE,
    position = "center"
  )
Indice de condicion
Eigenvalor Indice_Condicion
1.615 1.000
0.919 1.326
0.466 1.861 
## Matriz de correlacion.
regresores <- hprice1[, c("lotsize", "sqrft", "bdrms")]

matriz_cor <- round(cor(regresores), 3)

kable(matriz_cor, caption = "Prueba FG: Matriz de correlacion", format = "html") %>%
  kable_styling(
    bootstrap_options = c("striped","hover","condensed"),
    full_width = FALSE,
    position = "center"
  )
Prueba FG: Matriz de correlacion
lotsize sqrft bdrms
lotsize 1.000 0.184 0.136
sqrft 0.184 1.000 0.531
bdrms 0.136 0.531 1.000 
## Gráfico FG
corrplot(matriz_cor,
         method = "number",
         type = "upper")

b) Factores inflacionarios de la varianza, presente sus resultados de forma tabular y de forma grafica.

## Factores Inflacionarios de la Varianza (VIF)
vif_valores <- vif(modelo)

tabla_vif <- data.frame(
  Variable = names(vif_valores),
  VIF = round(as.numeric(vif_valores), 3)
)

kable(tabla_vif, caption = "Factores Inflacionarios de la Varianza", format = "html") %>%
  kable_styling(
    bootstrap_options = c("striped","hover","condensed"),
    full_width = FALSE,
    position = "center"
  )
Factores Inflacionarios de la Varianza
Variable VIF
lotsize 1.037
sqrft 1.419
bdrms 1.397 
## Grafico 
barplot(vif_valores,
        main = "Factores Inflacionarios de la Varianza",
        ylab = "Valor VIF",
        xlab = "Variables")

abline(h = 5, lty = 2)
abline(h = 10, lty = 2)