IEFCIC R Notebook 2

Éste es un R Markdown Notebook. Cuando ejecutes el código contenido, los resultados aparecerán debajo del código.

Los archivos que se van a usar fueron descargados de datos.gov.co. Luego fueron extraídos de forma local en formato .txt y .sav.

En el vídeo se explica paso a paso la obtención de datos, y en este vídeo se muestran algunas ideas de análisis exploratorio básico.

1. Cargando el set de datos (que puede descargar también desde aquí) Y revisamos el encabezado solo para estar seguros.

library(haven)
setwd("./")
df <- read_sav("./IEFIC_2015.sav")
head(df)

2. Extrayendo las variables por subgrupos. Así podremos explorarlas para quedarnos en cada caso solamente con las que son de nuestro interés.

## Dejo comentado los subconjuntos que no voy a usar por ahora
## dingresos <- df[, c(5:6)]
## dinstfinan <- df[, c(12:15)]
## delectrodom <- df[, c(43:54)]
## dgastoshog <- df[, c(55:68)]
## ddistinghog <- df[, c(69:95)]
## dmaqyequ <- df[, c(115:118)]
ddeudanohipotecaria <- df[, c(129:179)]
## dendeud <- df[, c(203:209)]
## dnegocio <- df[, c(210:214)]
## dcrednegocio <- df[, c(215:221)]
## dcredvehic <- df[, c(224:232)]
## dsex <- df[, 233]
## dcreditoytarj <- df[, c(234:255)]

3. Vamos a enfocarnos en el apartado “F. Deudas no hipotecarias”. Tenemos que limpiar el set de datos: convertimos todos los NaN a ceros (0), removemos columnas innecesarias y convertimos algunas a factor.

## Creamos la función que ajusta el formato del set de datos
limpia <- function(x){
        x <- sapply(x, FUN = function(x) {x <- as.numeric(x)})
        x[x == "NaN"] <- 0 ## Convertir todos los NaN a cero
        x[is.na(x)] <- 0
        return(x)
}
dt <- as.data.frame(limpia(ddeudanohipotecaria))
dt <- dt[, -c(2, 9, 18, 25, 32, 39, 47)] ## Columnas de ceros (son realmente encabezados de categorías)
dt <- dt[, -c(42:44)] ## Total de endeudamiento con capital e intereses
dt <- dt[dt$P2540 != 0,] ## Dejemos por fuera de la muestra a quienes no tienen tarjeta de crédito
cols <- c("P2540", "P2548", "P2584", "P2595", "P2602", "P2630", "P2633", "P2638", "P2692", "P2694", 
          "P2695", "P2731", "P2734")
dt[cols] <- lapply(dt[cols], factor)
l <- as.logical(lapply(dt, class)=="numeric") ## retenemos solamente los que son numéricos (dejamos los factores fuera)
dtCorr <- dt[, l]

4. Visualización de los datos: El analisis de los datos puede agilizarse gracias a la visualización de los mismos. Primero veamos todas las correlaciones de las variables entre sí, para luego pasar a ver la correlación con la variable que hemos definido como dependiente: endeudamiento total.

4.1. Correlaciones de todas las variables que no son factor entre sí:

library(qgraph)
qgraph(cor(dtCorr), shape="circle", posCol="darkgreen", negCol="darkred", layout="spring", vsize=8)

Tenemos: En primera instancia el hecho de que casi todas las correlaciones son positivas (verdes, mientras más gruesas mayor); lo cual parece indicar que mientras más endeudado se está más se tiende a endeudarse.

Sin embargo hay variables que tienen correlaciones negativas (rojas, mientras más delgadas menor), si bien poco significativas: la P2735 que se refiere al número total de hogares en la vivienda con las P2623_: a mayor número de hogares, el endeudamiento en créditos de libre inversión disminuye.

La P2560_3 con las P2623_: Cuando aumentan las cuotas de las compraventas, disminuyen las de crédito de libre inversión. Como si los créditos de libre inversión se vieran disminuidos cuando aumenta el número de hogares en la vivienda y cuando se recurre a las compraventas. Esto sin que entre el número de hogares en la vivienda y las cuotas en las compraventas haya correlación.

También se revela que el capital e intereses de las tarjetas de crédito tienen alta correlación positiva con el capital e intereses de los créditos de libre inversión.

Pero no se revela una variable determinante de la variable dependiente.

4.2. Correlaciones de las variables con la variable definida como dependiente:

corr <- as.data.frame(cor(dtCorr)[, ncol(dtCorr)])
names(corr) <- "coefcorr"
corr

Algunas variables tiene correlaciones fuertes entre sí, pero no con la variable dependiente

5. Aventuremos la construcción de un modelo con regresiones lineales:

5.1. Primero tomemos a todas las variables:

model1 <- lm(P2736_1 ~., data = dt)
summary(model1)

Call:
lm(formula = P2736_1 ~ ., data = dt)

Residuals:
    Min      1Q  Median      3Q     Max 
-228240     181     271     271 1563151 

Coefficients: (4 not defined because of singularities)
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  2.046e+02  2.715e+04   0.008  0.99399    
P25402      -1.251e+01  5.596e+02  -0.022  0.98217    
P2542_1      1.608e-04  2.000e-03   0.080  0.93593    
P2542_2      2.903e-02  1.069e-02   2.714  0.00665 ** 
P2542_3     -1.977e-04  6.933e-04  -0.285  0.77556    
P2542_4      3.643e-05  6.062e-05   0.601  0.54788    
P2545       -2.096e+01  3.335e+01  -0.628  0.52978    
P25481       3.021e+01  3.924e+04   0.001  0.99939    
P25482       1.251e+01  3.838e+04   0.000  0.99974    
P2560_1      8.903e-03  6.771e-02   0.131  0.89539    
P2560_2      2.497e-02  6.218e-02   0.402  0.68804    
P2560_3      1.602e-02  3.724e-02   0.430  0.66709    
P2560_4     -1.585e-04  1.065e-03  -0.149  0.88171    
P2579        4.494e-06  6.749e-04   0.007  0.99469    
P25841      -1.807e+02  2.714e+04  -0.007  0.99469    
P25842      -2.713e+02  2.714e+04  -0.010  0.99202    
P25848       3.136e-09  3.133e+04   0.000  1.00000    
P25849       4.148e+02  2.901e+04   0.014  0.98859    
P25951      -4.040e+03  9.826e+03  -0.411  0.68100    
P25952       1.345e+03  1.016e+04   0.132  0.89462    
P26021      -2.572e+02  1.748e+03  -0.147  0.88298    
P26022              NA         NA      NA       NA    
P2623_1      2.744e-03  2.135e-03   1.285  0.19871    
P2623_2      3.861e-02  9.387e-03   4.113 3.92e-05 ***
P2623_3     -1.019e-03  1.096e-03  -0.930  0.35246    
P2623_4     -1.128e-05  2.473e-05  -0.456  0.64820    
P26301       9.999e+02  1.918e+03   0.521  0.60221    
P26302       5.303e+02  2.423e+03   0.219  0.82675    
P26308      -1.050e+03  9.785e+03  -0.107  0.91452    
P26309       1.919e+05  1.068e+04  17.965  < 2e-16 ***
P26331      -4.164e+03  3.876e+04  -0.107  0.91445    
P26332      -2.569e-09  3.837e+04   0.000  1.00000    
P2637_1      1.143e-04  6.775e-03   0.017  0.98654    
P2637_2     -2.998e-03  7.613e-03  -0.394  0.69378    
P2637_3      6.007e-04  2.424e-03   0.248  0.80432    
P2637_4      1.197e-04  2.109e-04   0.568  0.57024    
P26381       1.418e+03  6.165e+03   0.230  0.81814    
P26382       7.179e+03  7.643e+03   0.939  0.34759    
P26388      -1.943e+02  2.885e+04  -0.007  0.99463    
P26389       4.435e+03  2.768e+04   0.160  0.87269    
P26921       1.031e+02  1.333e+03   0.077  0.93838    
P26922              NA         NA      NA       NA    
P2693_1      6.918e-04  2.253e-03   0.307  0.75874    
P2693_2      7.136e-03  8.360e-03   0.854  0.39335    
P2693_3      8.839e-04  2.204e-03   0.401  0.68839    
P2693_4     -7.931e-05  7.344e-05  -1.080  0.28018    
P26941       8.077e+02  1.296e+03   0.623  0.53302    
P26942       3.265e+03  1.713e+03   1.906  0.05661 .  
P26948       2.227e+01  1.109e+04   0.002  0.99840    
P26949      -6.345e+04  1.607e+04  -3.948 7.92e-05 ***
P26951      -3.121e+02  2.899e+03  -0.108  0.91428    
P26952              NA         NA      NA       NA    
P2696_1     -1.261e-02  1.011e-02  -1.248  0.21222    
P2696_2      4.396e-02  4.618e-02   0.952  0.34118    
P2696_3     -4.432e-03  4.122e-03  -1.075  0.28231    
P2696_4      3.912e-05  1.219e-04   0.321  0.74837    
P27311       3.740e+04  3.081e+03  12.140  < 2e-16 ***
P27312       1.919e+04  4.105e+03   4.676 2.95e-06 ***
P27319       6.594e+02  1.594e+04   0.041  0.96700    
P27341       2.155e+03  1.698e+03   1.269  0.20440    
P27342              NA         NA      NA       NA    
P2735       -2.046e+02  9.257e+02  -0.221  0.82510    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 27130 on 17860 degrees of freedom
Multiple R-squared:  0.08418,   Adjusted R-squared:  0.08126 
F-statistic:  28.8 on 57 and 17860 DF,  p-value: < 2.2e-16

5.2. Entonces intentemos un nuevo modelo con las variables que se mostraron significativas, las marcadas con asteriscos, pero teniendo en cuenta que algunas luego le restan precisión al modelo. En este caso, tener más variables no necesariamente implica que el modelo sea mejor. Un punto de partida puede ser tomar las variables que mayor correlación (positiva o negativa) tienen con la variable dependiente y a la vez las que menor correlación tienen con estas primeras. Luego, es necesario ir haciendo ajustes y probando.

model2 <- lm(P2736_1 ~ P2542_2 + P2623_2 * P2630, data = dt)
summary(model2)

Call:
lm(formula = P2736_1 ~ P2542_2 + P2623_2 * P2630, data = dt)

Residuals:
    Min      1Q  Median      3Q     Max 
-429139   -1099   -1099   -1099 1598898 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)     1.099e+03  2.207e+02   4.979 6.47e-07 ***
P2542_2         2.865e-02  9.374e-03   3.056  0.00225 ** 
P2623_2        -1.374e+02  2.454e+03  -0.056  0.95536    
P26301          1.558e+03  7.261e+02   2.146  0.03190 *  
P26302          5.116e+02  1.716e+03   0.298  0.76564    
P26308         -1.033e+03  1.055e+04  -0.098  0.92201    
P26309          2.572e+04  1.387e+04   1.855  0.06368 .  
P2623_2:P26301  1.374e+02  2.454e+03   0.056  0.95535    
P2623_2:P26302  1.374e+02  2.454e+03   0.056  0.95537    
P2623_2:P26308  1.364e+02  2.454e+03   0.056  0.95567    
P2623_2:P26309  4.484e+04  3.461e+03  12.955  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 27770 on 17907 degrees of freedom
Multiple R-squared:  0.03853,   Adjusted R-squared:  0.038 
F-statistic: 71.77 on 10 and 17907 DF,  p-value: < 2.2e-16

5.3. Grafiquemos los resultados del modelo obtenido:

newdata <- dt[, c("P2542_2", "P2623_2", "P2630")]
pred <- predict(model2, newdata = newdata)
p <- data.frame(pred = pred, real = dt[, 41], residuos = (pred - dt[, 41]))
names(p) <- c("pred", "real", "residuos")
library(ggplot2)
ggplot(p, aes(x=pred, y=real)) + geom_point() + geom_abline(intercept = 0, slope = 1, col="red") + ggtitle("Reales vs predicciones") + xlab("Predicciones")

ggplot(p, aes(x=1:nrow(p), y=residuos)) + geom_point() + geom_line() + ggtitle("Residuos") + xlab("caso n°")

5.4. Removiendo un outlier o descarrilador del modelo:

library(data.table)
dt <- as.data.table(dt)
dt <- setorder(dt, -P2736_1)
head(dt$P2736_1)

[1] 1600000 1350000 1000000  895000  800000  700000

5.5. Vemos que el valor outlier es el segundo. Entonces lo vamos a remover para ver si el modelo funciona mejor. Posteriormente se encuentra que los casos (filas) 1,2 y 3 también son outliers.

nrow(dt)

[1] 17918

dt <- dt[P2736_1!=1350000,]
dt <- dt[4:nrow(dt),]
nrow(dt)

[1] 17914

5.6. Y ahora corremo nuevamente el modelo desde el principio:

model3 <- lm(P2736_1 ~., data = dt)
summary(model3)

Call:
lm(formula = P2736_1 ~ ., data = dt)

Residuals:
   Min     1Q Median     3Q    Max 
-60419     34     95    259 782496 

Coefficients: (4 not defined because of singularities)
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  9.429e+01  2.056e+04   0.005  0.99634    
P25402       2.257e+02  4.237e+02   0.533  0.59430    
P2542_1      4.855e-04  1.514e-03   0.321  0.74852    
P2542_2      3.168e-02  8.096e-03   3.913 9.15e-05 ***
P2542_3     -5.471e-04  5.249e-04  -1.042  0.29729    
P2542_4     -9.129e-06  4.591e-05  -0.199  0.84239    
P2545        2.361e+00  2.525e+01   0.093  0.92552    
P25481       2.318e+02  2.971e+04   0.008  0.99378    
P25482      -2.257e+02  2.906e+04  -0.008  0.99380    
P2560_1      7.013e-03  5.126e-02   0.137  0.89119    
P2560_2      2.962e-02  4.708e-02   0.629  0.52918    
P2560_3      1.245e-02  2.820e-02   0.442  0.65878    
P2560_4     -1.539e-04  8.063e-04  -0.191  0.84864    
P2579       -2.966e-05  5.110e-04  -0.058  0.95371    
P25841      -3.366e+01  2.055e+04  -0.002  0.99869    
P25842      -9.547e+01  2.055e+04  -0.005  0.99629    
P25848       3.073e-05  2.372e+04   0.000  1.00000    
P25849       3.921e+02  2.196e+04   0.018  0.98576    
P25951      -3.449e+03  7.439e+03  -0.464  0.64291    
P25952       1.275e+03  7.688e+03   0.166  0.86830    
P26021      -1.458e+02  1.323e+03  -0.110  0.91227    
P26022              NA         NA      NA       NA    
P2623_1      2.179e-03  1.616e-03   1.348  0.17773    
P2623_2      4.108e-02  7.107e-03   5.781 7.55e-09 ***
P2623_3     -1.676e-04  8.295e-04  -0.202  0.83990    
P2623_4     -6.816e-06  1.872e-05  -0.364  0.71580    
P26301       3.603e+02  1.452e+03   0.248  0.80409    
P26302       4.036e+02  1.834e+03   0.220  0.82586    
P26308      -1.643e+03  7.408e+03  -0.222  0.82448    
P26309      -6.190e+03  8.754e+03  -0.707  0.47954    
P26331      -3.472e+03  2.935e+04  -0.118  0.90581    
P26332      -3.148e-05  2.905e+04   0.000  1.00000    
P2637_1      3.837e-04  5.130e-03   0.075  0.94037    
P2637_2     -2.556e-03  5.764e-03  -0.443  0.65742    
P2637_3      5.045e-04  1.836e-03   0.275  0.78341    
P2637_4      1.449e-04  1.596e-04   0.907  0.36421    
P26381       1.008e+03  4.668e+03   0.216  0.82897    
P26382       6.735e+03  5.787e+03   1.164  0.24451    
P26388      -2.056e+03  2.184e+04  -0.094  0.92503    
P26389       3.568e+03  2.095e+04   0.170  0.86480    
P26921       6.786e+02  1.009e+03   0.672  0.50137    
P26922              NA         NA      NA       NA    
P2693_1     -3.695e-04  1.706e-03  -0.217  0.82850    
P2693_2      3.394e-03  6.330e-03   0.536  0.59189    
P2693_3      3.690e-04  1.669e-03   0.221  0.82499    
P2693_4     -4.019e-05  5.561e-05  -0.723  0.46980    
P26941      -6.490e+02  9.815e+02  -0.661  0.50846    
P26942      -3.504e+01  1.299e+03  -0.027  0.97848    
P26948       8.086e+01  8.395e+03   0.010  0.99231    
P26949       2.193e+03  1.222e+04   0.179  0.85760    
P26951      -5.462e+02  2.195e+03  -0.249  0.80349    
P26952              NA         NA      NA       NA    
P2696_1     -1.225e-02  7.652e-03  -1.601  0.10944    
P2696_2      4.404e-02  3.496e-02   1.260  0.20785    
P2696_3     -6.165e-03  3.121e-03  -1.975  0.04827 *  
P2696_4      1.770e-05  9.233e-05   0.192  0.84799    
P27311       3.100e+04  2.333e+03  13.287  < 2e-16 ***
P27312       1.944e+04  3.108e+03   6.257 4.01e-10 ***
P27319       7.079e+02  1.207e+04   0.059  0.95322    
P27341       4.021e+03  1.286e+03   3.128  0.00176 ** 
P27342              NA         NA      NA       NA    
P2735       -9.429e+01  7.009e+02  -0.135  0.89298    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 20540 on 17856 degrees of freedom
Multiple R-squared:  0.07964,   Adjusted R-squared:  0.07671 
F-statistic: 27.11 on 57 and 17856 DF,  p-value: < 2.2e-16

5.7. Seleccionamos nuevamente las variables:

model4 <- lm(P2736_1 ~ P2542_2 + P2623_2 * P2731, data = dt)
summary(model4)

Call:
lm(formula = P2736_1 ~ P2542_2 + P2623_2 * P2731, data = dt)

Residuals:
    Min      1Q  Median      3Q     Max 
-309961      56      56      56  781466 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)    -5.629e+01  1.559e+02  -0.361    0.718    
P2542_2         2.900e-02  6.756e-03   4.292 1.78e-05 ***
P2623_2        -5.950e-03  6.871e-03  -0.866    0.387    
P27311          2.857e+04  8.161e+02  35.015  < 2e-16 ***
P27312          1.912e+04  2.257e+03   8.472  < 2e-16 ***
P27319          1.093e+02  1.435e+04   0.008    0.994    
P2623_2:P27311  4.080e-01  1.998e-02  20.416  < 2e-16 ***
P2623_2:P27312 -6.593e+01  1.060e+02  -0.622    0.534    
P2623_2:P27319 -5.648e+00  3.107e+03  -0.002    0.999    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 20300 on 17905 degrees of freedom
Multiple R-squared:  0.09907,   Adjusted R-squared:  0.09867 
F-statistic: 246.1 on 8 and 17905 DF,  p-value: < 2.2e-16

Y lo graficamos

newdata <- dt[, c("P2542_2", "P2623_2", "P2731")]
pred <- predict(model4, newdata = newdata)
p <- data.frame(pred = pred, real = dt[, 41], residuos = (pred - dt[, 41]))
names(p) <- c("pred", "real", "residuos")
library(ggplot2)
ggplot(p, aes(x=pred, y=real)) + geom_point() + geom_abline(intercept = 0, slope = 1, col="red") + ggtitle("Reales vs predicciones") + xlab("Predicciones")

ggplot(p, aes(x=1:nrow(p), y=residuos)) + geom_point() + geom_line() + ggtitle("Residuos") + xlab("caso n°")

ggplot(p, aes(x=pred, y=residuos)) + geom_point() + ggtitle("Residuos para cada predicción")

5.8. Comparando un modelo con el otro en cuanto a residuos:

summary(model2$residuals)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-429100   -1099   -1099       0   -1099 1599000 

summary(model4$residuals)

     Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
-310000.0      56.1      56.3       0.0      56.3  781500.0 

6. Conclusiones y líneas a seguir: Es un modelo que en tanto que predictor está muy lejos de ser bueno, a pesar de que su error standard promedio es de 2161.4708482, dado que los datos tienen una distribución no normal, desbalanceada, en la que la mayoría de los casos son (17195) son cero, y solamente 719 son distintos a cero. Esto hace que el modelo lineal haga lo posible por reducir el error standard promedio (el promedio de la raíz cuadrada del cuadrado de la diferencia), produciendo errores o residuos muy altos en algunas partes.

Sin embargo, en tanto que análisis exploratorio nos permite identificar variables sobre las cuales se debe hacer un estudio para verificar su relevancia en el estado total de endeudamiento.

Es así que de 51 variables nos quedamos con 3, por ahora:

• P2542_2: Intereses mensuales por tarjeta de crédito.
• P2623_2: Intereses mensuales por créditos de libre inversión.
• P2731: Si sabe, no sabe, no sabe si sabe o no responde cuándo termina de pagar estos créditos (P2696).