Taller 2 - Regresión Logística

Aprendizaje Estadístico - MINE

Librerias necesarias

library(ggplot2)
library(dplyr)
library(MASS)
library(readxl)
library(ggplot2)
library(dplyr)
library(readxl)
library(kableExtra)
library(paletteer)
library(plotly)

Cargar datos

datos <- read_excel("Base_Datos_Vivienda.xlsx")
kable(head(datos))

Ingreso	Educacion	Credito	Zona	Edad_Jefe	Tamano_Hogar	Vivienda
3745.071	3	1	Rural	42	5	1
2792.604	0	1	Urbana	35	2	0
3971.533	2	1	Rural	40	6	1
5284.545	4	0	Urbana	42	1	1
2648.770	2	1	Urbana	59	3	1
2648.795	2	1	Urbana	50	4	1

Análisis Descriptivo de las Variables

Variables Cuantitativas

attach(datos)
summary(datos)

##     Ingreso       Educacion        Credito          Zona          
##  Min.   : 500   Min.   :0.000   Min.   :0.000   Length:1000       
##  1st Qu.:2029   1st Qu.:1.000   1st Qu.:0.000   Class :character  
##  Median :3038   Median :3.000   Median :1.000   Mode  :character  
##  Mean   :3050   Mean   :2.556   Mean   :0.698                     
##  3rd Qu.:3972   3rd Qu.:4.000   3rd Qu.:1.000                     
##  Max.   :8779   Max.   :5.000   Max.   :1.000                     
##    Edad_Jefe      Tamano_Hogar      Vivienda    
##  Min.   :25.00   Min.   :1.000   Min.   :0.000  
##  1st Qu.:35.00   1st Qu.:2.000   1st Qu.:1.000  
##  Median :44.00   Median :4.000   Median :1.000  
##  Mean   :44.55   Mean   :3.465   Mean   :0.844  
##  3rd Qu.:54.00   3rd Qu.:5.000   3rd Qu.:1.000  
##  Max.   :64.00   Max.   :6.000   Max.   :1.000

Ingreso

El ingreso mensual de los hogares oscila entre 500 y 8779 unidades monetarias. El ingreso medio es de aproximadamente 3050, muy cercano a la mediana (3038), lo cual sugiere una distribución relativamente simétrica, aunque con presencia de valores altos que elevan el máximo. La mayoría de los hogares se concentran entre 2029 y 3972.

Nivel Educativo

El nivel educativo promedio del jefe del hogar es 2.56 (aprox. entre educación secundaria y técnica). La mediana igual a 3 indica que al menos el 50% de los jefes alcanzan ese nivel. Hay casos desde 0 (sin escolaridad) hasta 5 (educación superior completa).

Edad Jefe

El jefe del hogar tiene en promedio 44.6 años. La mitad tiene 44 años o menos. El rango va de 25 a 64 años, sin valores extremos anómalos.

Tamaño Hogar

Los hogares están conformados por un promedio de 3 a 4 miembros. La mitad de los hogares tiene 4 personas o menos, y los tamaños máximos observados no superan las 6 personas.

Variables Categóricas

Zona

table(Zona)

## Zona
##  Rural Urbana 
##    291    709

kable(prop.table(table(Zona)))

Zona	Freq
Rural	0.291
Urbana	0.709

El 70.9% de los hogares está ubicado en zona urbana, mientras que el 29.1% se encuentra en zona rural. Esto indica que la base de datos está conformada mayoritariamente por hogares urbanos.

Variables Binarias

Crédito

table(Credito)

## Credito
##   0   1 
## 302 698

kable(prop.table(table(Credito)))

Credito	Freq
0	0.302
1	0.698

Aproximadamente el 69.8% de los hogares reporta tener acceso a crédito, frente a un 30.2% que no cuenta con él. El acceso al crédito es alto en la muestra, lo cual puede facilitar la adquisición de vivienda o bienes durables.

Vivienda

table(Vivienda)

## Vivienda
##   0   1 
## 156 844

kable(prop.table(table(Vivienda)))

Vivienda	Freq
0	0.156
1	0.844

El 84.4% de los hogares reporta tener vivienda propia, mientras que el 15.6% no la tiene. Esto muestra una elevada proporción de hogares propietarios dentro de la base, lo cual se relaciona posteriormente con los análisis del modelo logístico.

Análisis Exploratorio

Ingreso

p_ingreso <- ggplot(datos, aes(x = Ingreso)) +
  geom_histogram(
    bins = 30,
    fill  = "red",
    color = "white"
  ) +
  theme_minimal()

ggplotly(p_ingreso)

La distribución del ingreso de los hogares presenta una forma asimétrica hacia la derecha, lo cual indica que la mayoría de los hogares se concentra en niveles de ingreso medio-bajo, mientras que existe un grupo reducido de hogares con ingresos altos que extienden la cola derecha de la distribución.

Ingreso según Vivienda

Ingreso_v <- ggplot(datos, aes(x = factor(Vivienda), y = Ingreso)) +
  geom_boxplot(fill = "#4c72b0", alpha = 0.7, color = "black") +
  labs(
    x = "Vivienda (0 = No, 1 = Sí)",
    y = "Ingreso"
  ) +
  theme_minimal()

ggplotly(Ingreso_v)

Se observa que los hogares que poseen vivienda presentan niveles de ingreso significativamente mayores que aquellos que no poseen vivienda.

La mediana de ingreso es más alta en el grupo con vivienda, y además la dispersión es mayor, indicando que dentro de los propietarios existen hogares con ingresos altos. Por el contrario, el grupo sin vivienda muestra medianas más bajas y menor dispersión, concentrándose en rangos de ingreso más modestos.

También se observan algunos outliers, especialmente entre los hogares con vivienda, posiblemente asociados a ingresos altos que facilitan la adquisición de vivienda o corresponden a hogares con mayor capacidad financiera.

Vivienda por Zona

Vivienda_zona <- ggplot(datos, aes(x = Zona, fill = factor(Vivienda))) +
  geom_bar(position = "fill") +
  labs(
    y = "Proporción",
    fill = "Vivienda"
  ) +
  theme_minimal()

ggplotly(Vivienda_zona)

En ambas zonas (rural y urbana) la proporción de hogares con vivienda propia es mayor que la proporción de hogares sin vivienda. Sin embargo, la proporción de hogares propietarios es ligeramente mayor en la zona urbana que en la zona rural.

En la zona urbana el 85,89% de los hogares reporta tener vivienda propia, mientras que en la zona rural dicha proporción es de 80,75%, lo cual sugiere que la tenencia de vivienda es más frecuente entre hogares urbanos.

Vivienda por acceso a Crédito

Vivienda_credito <- ggplot(datos, aes(x = factor(Credito), fill = factor(Vivienda))) +
  geom_bar(position = "fill") +
  labs(
    x = "Crédito (0 = No, 1 = Sí)",
    y = "Proporción",
    fill = "Vivienda"
  ) +
  theme_minimal()
ggplotly(Vivienda_credito)

Se observa que la proporción de hogares con vivienda propia es mayor entre quienes tienen acceso a crédito que entre quienes no lo tienen.

En el grupo sin crédito, aproximadamente 78,14% de los hogares reporta tener vivienda, mientras que en el grupo con crédito esta proporción aumenta 87,1%.

Esto sugiere que el acceso al crédito está positivamente asociado con la posesión de vivienda, lo cual es coherente con el rol del crédito como mecanismo de financiación para adquisición de vivienda en muchos hogares.

Modelo de regresión logística para probabilidad de acceso a vivienda propia.

modelo <- glm(Vivienda ~ Ingreso + Educacion + Credito + Zona + Edad_Jefe + 
                Tamano_Hogar, data = datos, family = binomial)

summary(modelo)

## 
## Call:
## glm(formula = Vivienda ~ Ingreso + Educacion + Credito + Zona + 
##     Edad_Jefe + Tamano_Hogar, family = binomial, data = datos)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -3.545e+00  5.793e-01  -6.119 9.40e-10 ***
## Ingreso       8.698e-04  8.783e-05   9.903  < 2e-16 ***
## Educacion     3.127e-01  6.151e-02   5.084 3.70e-07 ***
## Credito       7.941e-01  2.038e-01   3.897 9.75e-05 ***
## ZonaUrbana    5.374e-01  2.096e-01   2.564   0.0103 *  
## Edad_Jefe     3.545e-02  8.945e-03   3.963 7.39e-05 ***
## Tamano_Hogar -3.142e-02  5.689e-02  -0.552   0.5807    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 865.95  on 999  degrees of freedom
## Residual deviance: 673.93  on 993  degrees of freedom
## AIC: 687.93
## 
## Number of Fisher Scoring iterations: 6

Componentes aleatoria y sistemática del modelo.

La variable a explicar es: Vivienda = 1 si el hogar tiene vivienda propia, 0 si no Entonces es una variable binaria (0,1). Eso significa que cada hogar tiene una probabilidad \(p\) de tener vivienda y \(1-p\) de no tenerla.

Componente aleatoria:

\[Vivienda_i ∼ Bernoulli(p_i)\] Cada hogar tiene una probabilidad \(p_i\) de tener vivienda propia y esa probabilidad está entre 0 y 1.

Componente sistemática:

\[η_i = β_0 + β_1Ingreso + β_2Educación + β_3Credito + β_4Zonaurbana + β_5Edadjefe + β_6Tamañohogar\]

Interprete los coeficientes estimados.

Ingreso

exp(0.000869)

## [1] 1.000869

Un incremento de 1000 dólares en el ingreso aumenta las oddsde tener vivienda propia en aproximadamente un 87%, manteniendo constantes las demás variables.

Educación

exp(0.3127)

## [1] 1.367111

Cada aumento de un nivel educativo incrementa las odds de tener vivienda propia en un 37%, manteniendo todo lo demás constante.

Crédito

exp(0.7941)

## [1] 2.212449

Los hogares con acceso a crédito tienen odds de tener vivienda propia 2.21 veces mayores que los hogares sin acceso a crédito, ceteris paribus.

Zona urbana

exp(0.5374)

## [1] 1.711551

Los hogares ubicados en zona urbana tienen odds de tener vivienda propia 1.71 veces mayores que los de zona rural, ceteris paribus.

Edad jefe

exp(0.03545)

## [1] 1.036086

Por cada año adicional de edad del jefe del hogar, las odds de poseer vivienda aumentan un 3.6%.

Evalúe la significancia estadística de cada variable.

summary(modelo)$coefficients

##                   Estimate   Std. Error    z value     Pr(>|z|)
## (Intercept)  -3.5450529544 5.793256e-01 -6.1192750 9.400206e-10
## Ingreso       0.0008698307 8.783257e-05  9.9032818 4.028348e-23
## Educacion     0.3126812575 6.150559e-02  5.0837856 3.699855e-07
## Credito       0.7941097989 2.037884e-01  3.8967362 9.749772e-05
## ZonaUrbana    0.5374387740 2.095747e-01  2.5644253 1.033468e-02
## Edad_Jefe     0.0354527118 8.945070e-03  3.9633802 7.389596e-05
## Tamano_Hogar -0.0314249280 5.689290e-02 -0.5523523 5.807070e-01

No se encuentra evidencia estadística de que el tamaño del hogar influya en la probabilidad de tener vivienda propia, una vez controlamos por ingreso, educación, acceso a crédito, edad y zona.

Evalúe la bondad de ajuste utilizando métricas como AIC, pseudo \(R^2\) y curva ROC.

dato<- as.data.frame(datos)
datos$Vivienda <- as.factor(datos$Vivienda)
datos$Credito  <- as.factor(datos$Credito)
datos$Zona     <- as.factor(datos$Zona)

modelo_logit <- glm(
  Vivienda ~ Ingreso + Educacion + Credito + Zona + Edad_Jefe + Tamano_Hogar,
  data = datos,
  family = binomial(link = "logit"))

summary(modelo_logit)

## 
## Call:
## glm(formula = Vivienda ~ Ingreso + Educacion + Credito + Zona + 
##     Edad_Jefe + Tamano_Hogar, family = binomial(link = "logit"), 
##     data = datos)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -3.545e+00  5.793e-01  -6.119 9.40e-10 ***
## Ingreso       8.698e-04  8.783e-05   9.903  < 2e-16 ***
## Educacion     3.127e-01  6.151e-02   5.084 3.70e-07 ***
## Credito1      7.941e-01  2.038e-01   3.897 9.75e-05 ***
## ZonaUrbana    5.374e-01  2.096e-01   2.564   0.0103 *  
## Edad_Jefe     3.545e-02  8.945e-03   3.963 7.39e-05 ***
## Tamano_Hogar -3.142e-02  5.689e-02  -0.552   0.5807    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 865.95  on 999  degrees of freedom
## Residual deviance: 673.93  on 993  degrees of freedom
## AIC: 687.93
## 
## Number of Fisher Scoring iterations: 6

AIC

AIC(modelo_logit)

## [1] 687.9322

\(R^2\)

library(pscl)
pR2(modelo_logit)

## fitting null model for pseudo-r2

##          llh      llhNull           G2     McFadden         r2ML         r2CU 
## -336.9660972 -432.9770364  192.0218785    0.2217460    0.1747112    0.3015642

ROC

library(pROC) 
datos$prob_pred <- predict(modelo_logit, newdata = datos, type = "response")
roc_obj <- roc(
  response = as.numeric(as.character(datos$Vivienda)),
  predictor = datos$prob_pred)

plot(roc_obj, col = "blue", lwd = 2)

El modelo logístico muestra un desempeño sólido. El \(R^2\) (0.222) sugiere una buena capacidad explicativa para un modelo binario, es decir, las covariables aportan información relevante. La curva ROC se ubica claramente por encima de la diagonal,lo que indica una capacidad de discriminación superior al azar entre hogares con y sin vivienda propia.El valor del AIC obtenido (687.93) refleja que el modelo logra explicar la probabilidad de acceso a vivienda propia sin incorporar un número excesivo de parámetros, manteniendo un equilibrio adecuado entre ajuste a los datos y simplicidad.

Estime la probabilidad de acceso a vivienda propia para un hogar con características específicas.

levels(datos$Zona)

## [1] "Rural"  "Urbana"

levels(datos$Credito)

## [1] "0" "1"

hogar_nuevo <- data.frame(
  Ingreso = 3000,
  Educacion = 3,
  Credito = factor(1, levels = levels(datos$Credito)),
  Zona = factor(levels(datos$Zona)[1], levels = levels(datos$Zona)),
  Edad_Jefe = 45,
  Tamano_Hogar = 4)

prob_vivienda <- predict(
  modelo_logit,
  newdata = hogar_nuevo,
  type = "response")

prob_vivienda

##         1 
## 0.9060443

Utilizando los coeficientes estimados del modelo de regresión logística, se calculó la probabilidad de acceso a vivienda propia para un hogar con características específicas, las cuales fueron un hogar con ingreso de 3000, nivel de educación 3, edad del jefe de hogar 45 y el tamaño del hogar de 4 personas.Para este hogar, el modelo estima una probabilidad de acceso a vivienda propia del 90,6 %. Este valor sugiere que, dadas sus características socioeconómicas, el hogar presenta una alta probabilidad de poseer vivienda propia.

¿El efecto de los ingresos sobre la probabilidad de acceso a vivienda propia varía según la zona geográfica?

modelo_interaccion <- glm(
  Vivienda ~ Ingreso * Zona + Educacion + Credito + Edad_Jefe + Tamano_Hogar,
  data = datos,
  family = binomial(link = "logit"))

summary(modelo_interaccion)

## 
## Call:
## glm(formula = Vivienda ~ Ingreso * Zona + Educacion + Credito + 
##     Edad_Jefe + Tamano_Hogar, family = binomial(link = "logit"), 
##     data = datos)
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -3.1326029  0.6371496  -4.917 8.81e-07 ***
## Ingreso             0.0007042  0.0001370   5.141 2.74e-07 ***
## ZonaUrbana         -0.0616787  0.4520705  -0.136    0.891    
## Educacion           0.3074222  0.0614382   5.004 5.62e-07 ***
## Credito1            0.8013901  0.2039674   3.929 8.53e-05 ***
## Edad_Jefe           0.0350996  0.0089444   3.924 8.70e-05 ***
## Tamano_Hogar       -0.0322157  0.0568948  -0.566    0.571    
## Ingreso:ZonaUrbana  0.0002642  0.0001762   1.500    0.134    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 865.95  on 999  degrees of freedom
## Residual deviance: 671.72  on 992  degrees of freedom
## AIC: 687.72
## 
## Number of Fisher Scoring iterations: 6

Los resultados muestran que el término de interacción no es estadísticamente significativo, lo que indica que no existe evidencia suficiente para afirmar que el impacto del ingreso sobre la probabilidad de poseer vivienda propia difiera entre zonas urbanas y rurales.El ingreso aumenta la probabilidad de acceso a vivienda de manera similar en ambos contextos geográficos.

Gráfico de las probabilidades predichas en función del nivel de ingresos.

ingresos_seq <- seq(
  min(datos$Ingreso, na.rm = TRUE),
  max(datos$Ingreso, na.rm = TRUE),
  length.out = 100)

escenario <- data.frame(
  Ingreso = ingresos_seq,
  Zona = factor("Urbana", levels = levels(datos$Zona)),  # puedes cambiar a "Rural"
  Educacion = mean(datos$Educacion, na.rm = TRUE),
  Credito = factor(1, levels = levels(datos$Credito)),
  Edad_Jefe = mean(datos$Edad_Jefe, na.rm = TRUE),
  Tamano_Hogar = mean(datos$Tamano_Hogar, na.rm = TRUE))

escenario$prob_predicha <- predict(
  modelo_logit,   
  newdata = escenario,
  type = "response")

library(ggplot2)

ggplot(escenario, aes(x = Ingreso, y = prob_predicha)) +
  geom_line(color = "blue", linewidth = 1.2) +
  labs(
    x = "Ingreso mensual del hogar",
    y = "Probabilidad predicha de vivienda propia",
    title = "Probabilidad predicha de acceso a vivienda propia según el ingreso"
  ) +
  theme_minimal()

El gráfico de probabilidades predichas muestra una relación positiva y no lineal entre el ingreso mensual del hogar y la probabilidad de acceso a vivienda propia. A medida que el ingreso aumenta, la probabilidad estimada de poseer vivienda se incrementa, aunque dicho efecto presenta rendimientos decrecientes a niveles altos de ingreso, donde la probabilidad se aproxima a uno.