Análisis de Clientes en Condiciones Vulnerables para una Financiera

Author

Erick Elí Gonzales Serrano

Published

December 26, 2024

EXPLORACIÓN DE DATOS

1. Instalación de paquetes y cargado de librerias

A continuación, se realizará un listado y se explicará brevemente las librerias que serán utilizadas.

  • skimr: Resumen rápido y estadístico de datos en un formato limpio.

  • tidyverse: Conjunto de paquetes para manipulación y visualización de datos.

  • readr: Lectura rápida y eficiente de archivos de datos.

  • plotly: Creación de gráficos interactivos y visualizaciones dinámicas.

  • ggplot2: Visualización de datos basada en la gramática de gráficos.

  • scales: Funciones para modificar escalas y ejes en gráficos.

  • DT: Mostrar y editar tablas interactivas en R.

  • knitr: Generación de documentos dinámicos y reportes reproducibles.

  • broom: Limpieza y transformación de resultados de modelos estadísticos.

2. Cargar las bases de datos

Es preciso tener en cuenta que en muchas ocasiones nuestras fuentes de datos pueden estar conformadas por caracteres que no son reconocidos automaticamente por R. Es por ello que se debe especificar el fileEncoding = "latin1", el cual contiene varios idiomas, entre ellos el español.

clientes <- read.csv("Clientes.csv", fileEncoding = "latin1", header = TRUE)
Ubigeo <- read.csv("Ubigeo.csv", fileEncoding = "latin1", header = TRUE)

3. Factorización con asignación de niveles

Al convertir una variable en un factor, R gestiona de manera más eficiente los cálculos relacionados con esa variable en modelos estadísticos o gráficos. Las variables categóricas se almacenan de forma más compacta y eficiente.

BD <- clientes 

BD$Género <- factor(BD$Género,levels = c("Masculino", "Femenino"),labels = c("Masculino", "Femenino"))

BD$EstadoCivil <- factor(BD$EstadoCivil,levels = c("Soltero","Casado","Divorciado","Viudo"),labels = c("Soltero","Casado","Divorciado","Viudo"))

BD$NivelEducacion <- factor(BD$NivelEducacion,levels = c("Terciaria","Primaria","Secundaria","Universitaria"),labels = c("Terciaria","Primaria","Secundaria","Universitaria"))

BD$Empleo <- factor(BD$Empleo, levels = c("Empleado","Desempleado","Otro"),labels = c("Empleado","Desempleado","Otro"))

BD$TipoContrato <- factor(BD$TipoContrato, levels = c("Freelance","Permanente","Temporal"),labels = c("Freelance","Permanente","Temporal"))

BD$Salud <- factor(BD$Salud,levels = c("Regular","Buena","Mala"),labels = c("Regular","Buena","Mala"))

BD$ViviendaPropia <- factor(BD$ViviendaPropia, levels = c("False", "True"), labels = c("No", "Sí"))

BD$CondicionVulnerable <- factor(BD$CondicionVulnerable,levels = c("False", "True"),labels = c("No vulnerable", "Sí vulnerable"))

BD$HistorialCrediticio <- factor(BD$HistorialCrediticio,levels = c("Malo","Regular","Bueno"),labels = c("Malo","Regular","Bueno"))

4. Exploración rápida de las variables

Dado que nuestras variables de interés sólo son aquellas que son cualitativas y cuantitativas, vamos filtrar nuestro procedimiento para que nos muestre información de variables tipo numéricas y tipo factor.

skim(BD[, sapply(BD, function(x) is.numeric(x) || is.factor(x))])
Data summary
Name BD[, sapply(BD, function(…
Number of rows 10000
Number of columns 16
_______________________
Column type frequency:
factor 9
numeric 7
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
Género 419 0.96 FALSE 2 Mas: 4823, Fem: 4758
EstadoCivil 0 1.00 FALSE 4 Cas: 3982, Sol: 3975, Div: 1551, Viu: 492
NivelEducacion 0 1.00 FALSE 4 Sec: 2976, Ter: 2922, Uni: 2081, Pri: 2021
Empleo 0 1.00 FALSE 3 Emp: 7051, Des: 1985, Otr: 964
TipoContrato 0 1.00 FALSE 3 Per: 6019, Tem: 2945, Fre: 1036
Salud 0 1.00 FALSE 3 Bue: 6019, Reg: 2985, Mal: 996
ViviendaPropia 0 1.00 FALSE 2 Sí: 5032, No: 4968
HistorialCrediticio 0 1.00 FALSE 3 Bue: 6019, Reg: 2941, Mal: 1040
CondicionVulnerable 0 1.00 FALSE 2 No : 8493, Sí : 1507

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
ClienteID 0 1 5000.50 2886.90 1.0 2500.75 5000.50 7500.25 10000.00 ▇▇▇▇▇
Edad 0 1 49.30 18.31 18.0 33.00 49.00 65.00 80.00 ▇▇▇▇▇
IngresosMensuales 0 1 2995.58 1433.85 1.1 1966.06 2959.39 3969.14 8702.49 ▃▇▆▁▁
SituacionFamiliar 0 1 2.48 1.69 0.0 1.00 2.00 4.00 5.00 ▇▅▅▃▃
DeudasActivas 0 1 5.03 3.16 0.0 2.00 5.00 8.00 10.00 ▇▆▆▆▆
SucursalID 0 1 25.35 14.46 1.0 13.00 25.00 38.00 50.00 ▇▇▇▇▇
UbigeoID 0 1 50.74 29.04 1.0 25.00 51.00 76.00 100.00 ▇▇▇▇▇

5. Clientes vulnerables

Se realizó un gráfico interactivo en el cual podemos observar tanto el total de clientes vulnerables como el porcentaje que representa en nuestra base de datos.

BD %>%
  count(CondicionVulnerable) %>%
  mutate(percentage = n / sum(n) * 100) -> data_plot

# Crear el gráfico de barras con ggplot2
grafico <- ggplot(data_plot, aes(x = CondicionVulnerable, y = n, fill = CondicionVulnerable)) +
  geom_bar(stat = "identity") +  # Cada barra tendrá un color distinto
  labs(title = "Distribución de Condición Vulnerable", x = "Condición Vulnerable", y = "Cantidad de Personas") +
  theme_minimal() +
  # Agregar el porcentaje centrado en el medio de cada barra
  geom_text(aes(label = paste0(round(percentage, 1), "%"), y = n / 2),  # Ubicamos el texto a la mitad de cada barra
            hjust = 0.5, color = "white", size = 5) +  # Centrar horizontalmente el texto
  scale_fill_manual(values = c("skyblue", "lightgreen", "lightcoral", "gold"))  # Colores distintos para las barras

# Convertir el gráfico ggplot a un gráfico interactivo con plotly
grafico_interactivo <- ggplotly(grafico)

# Mostrar el gráfico interactivo
grafico_interactivo

6. Distribución de ingresos

6.1 Gráfico de Histograma

ggplot(BD, aes(x = IngresosMensuales, fill = CondicionVulnerable)) +
  # Histograma con color de barras (con relleno)
  geom_histogram(binwidth = 200, alpha = 0.4, position = "identity", color = "black", aes(y = after_stat(count))) +  # Usamos after_stat(count) para mostrar frecuencias
  labs(title = "Distribución de Ingresos Mensuales: Vulnerables vs. No Vulnerables",
       x = "Ingreso Mensual",
       y = "Frecuencia (Histograma)") +
  scale_fill_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Color para el histograma
  scale_color_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Color para la curva de densidad
  theme_minimal() +
  facet_wrap(~ CondicionVulnerable, scales = "free_y") +  # Divide en paneles según la condición
  guides(fill = "none", color = "none")  # Eliminar la leyenda

6.2 Gráfico de Cajas

p <- ggplot(BD, aes(x = CondicionVulnerable, y = IngresosMensuales, fill = CondicionVulnerable)) +
  # Crear el gráfico de cajas
  geom_boxplot(alpha = 0.6, color = "black", outlier.color = "red", outlier.size = 3) +  
  labs(title = "Distribución de Ingresos Mensuales: Vulnerables vs. No Vulnerables",
       x = "Condición Vulnerable",
       y = "Ingreso Mensual") +
  scale_fill_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Colores para las cajas
  scale_color_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Colores para la línea de las cajas
  theme_minimal() +
  guides(fill = "none", color = "none")  # Eliminar la leyenda

# Convertir el gráfico ggplot a un gráfico interactivo con plotly
p_interactivo <- ggplotly(p)

# Mostrar el gráfico interactivo
p_interactivo

6.2 Gráfico de Violín

p <- ggplot(BD, aes(x = CondicionVulnerable, y = IngresosMensuales, fill = CondicionVulnerable)) +
  # Crear el gráfico de violín
  geom_violin(alpha = 0.6, color = "black") +  
  labs(title = "Distribución de Ingresos Mensuales: Vulnerables vs. No Vulnerables",
       x = "Condición Vulnerable",
       y = "Ingreso Mensual") +
  scale_fill_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Colores para los violines
  scale_color_manual(values = c("Vulnerable" = "red", "No vulnerable" = "blue")) +  # Colores para las líneas de los violines
  theme_minimal() +
  guides(fill = "none", color = "none")  # Eliminar la leyenda

# Convertir el gráfico ggplot a un gráfico interactivo con plotly
p_interactivo <- ggplotly(p)

# Mostrar el gráfico interactivo
p_interactivo

7. Rankings

7.1 Las 5 sucursales con mayor número de clientes vulnerables

top_5_sucursales <- BD %>%
  filter(CondicionVulnerable == "Sí vulnerable") %>%  # Filtrar los clientes vulnerables
  group_by(SucursalID) %>%  # Agrupar por SucursalID
  summarize(n_vulnerables = n(), .groups = "drop") %>%
  mutate(percentage = (n_vulnerables / sum(n_vulnerables)) * 100) %>%
  top_n(5, n_vulnerables)
gg_plot <- ggplot(top_5_sucursales, aes(x = n_vulnerables, y = reorder(SucursalID, n_vulnerables))) +
  geom_bar(stat = "identity", fill = "steelblue") +  # Barra horizontal
  labs(title = "Top 5 Sucursales con Más Clientes Vulnerables",
       x = "Número de Clientes Vulnerables",
       y = "Sucursal") +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 12),  # Ajustar tamaño de texto en el eje y
        plot.title = element_text(hjust = 0.5)) +  # Centrar título
  geom_text(aes(label = paste0(round(percentage, 1), "%")),  # Agregar etiquetas de porcentaje
            position = position_stack(vjust = 0.5),  # Posicionar las etiquetas en el centro de las barras
            size = 4, color = "white")  # Tamaño y color de las etiquetas
   

gg_plotly <- ggplotly(gg_plot)

# Mostrar el gráfico interactivo
gg_plotly

7.2 Clientes vulnerables por departamento

top_5_dept <- BD %>%
  filter(CondicionVulnerable == "Sí vulnerable") %>%  # Filtrar los clientes vulnerables
  left_join(Ubigeo, by = "UbigeoID") %>%  # Hacer el join con la base 'Ubigeo' por 'SucursalID'
  group_by(Departamento)%>%  # Agrupar por SucursalID
  summarize(n_vulnerables = n(), .groups = "drop") %>%  # Calcular el número de clientes vulnerables por sucursal
  mutate(percentage = (n_vulnerables / sum(n_vulnerables)) * 100) %>%  # Calcular el porcentaje
  arrange(desc(n_vulnerables)) 
gg_plot <- ggplot(top_5_dept, aes(x = n_vulnerables, y = reorder(Departamento, n_vulnerables))) +
  geom_bar(stat = "identity", fill = "steelblue") +  # Barra horizontal
  labs(title = "Clientes Vulnerables por Departamento",
       x = "Número de Clientes Vulnerables",
       y = "Departamentos") +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 12),  # Ajustar tamaño de texto en el eje y
        plot.title = element_text(hjust = 0.5)) +  # Centrar título
  geom_text(aes(label = paste0(round(percentage, 1), "%")),  # Agregar etiquetas de porcentaje
            position = position_stack(vjust = 0.5),  # Posicionar las etiquetas en el centro de las barras
            size = 4, color = "white")  # Tamaño y color de las etiquetas
   

gg_plotly <- ggplotly(gg_plot)

# Mostrar el gráfico interactivo
gg_plotly

8. Variables asociadas a la condición vulnerable

8.1 Filtrar variables

Solo vamos a considerar nuestras variables de interés para poder realizar una regresión logística y averiguar que variables son las que afectan la probabilidad de que un cliente se encuentre en condición de vulnerabilidad.

reg_log <- BD %>%
  select(-c(ClienteID, Nombre,SucursalID,UbigeoID))

8.2 One Hot Encoding

categorical_vars <- c("EstadoCivil", "NivelEducacion", "Empleo", "TipoContrato", "Salud", "HistorialCrediticio")
BD_encoded <- model.matrix(~ EstadoCivil + NivelEducacion + Empleo + TipoContrato + Salud + HistorialCrediticio - 1, data = reg_log)

reg_log <- reg_log[, !(names(reg_log) %in% categorical_vars)]
reg_log <- cbind(reg_log, BD_encoded)

8.3 Estandarización de las variables

# Estandarizar las variables 
reg_log$Edad <- scale(reg_log$Edad)[, 1] 
reg_log$IngresosMensuales <- scale(reg_log$IngresosMensuales)[, 1]
reg_log$DeudasActivas <- scale(reg_log$DeudasActivas)[, 1] 
reg_log$SituacionFamiliar <- scale(reg_log$SituacionFamiliar)[, 1]

8.4 Regresión Logística

predictoras <- setdiff(names(reg_log), c("CondicionVulnerable", "HistorialCrediticioRegular"))

# Ajustar el modelo de regresión logística usando todas las demás variables
modelo_log <- glm(as.formula(paste("CondicionVulnerable ~", paste(predictoras, collapse = " + "))),
                  data = reg_log, 
                  family = binomial)
modelo_tidy <- tidy(modelo_log)
kable(modelo_tidy, caption = "Resumen de la regresión logística")
Resumen de la regresión logística
term estimate std.error statistic p.value
(Intercept) -1.2714116 0.1984359 -6.4071660 0.0000000
Edad 0.0014330 0.0329537 0.0434845 0.9653153
GéneroFemenino 0.0656902 0.0657801 0.9986333 0.3179724
IngresosMensuales -0.5721469 0.0352413 -16.2351409 0.0000000
SituacionFamiliar -0.0368213 0.0330612 -1.1137301 0.2653950
ViviendaPropiaSí -0.0345663 0.0657660 -0.5255956 0.5991692
DeudasActivas 0.0222329 0.0330638 0.6724239 0.5013139
EstadoCivilSoltero 0.1063445 0.1618723 0.6569656 0.5112030
EstadoCivilCasado 0.1239406 0.1619041 0.7655186 0.4439628
EstadoCivilDivorciado 0.1463877 0.1746101 0.8383690 0.4018235
EstadoCivilViudo NA NA NA NA
NivelEducacionPrimaria -0.1809634 0.0954321 -1.8962527 0.0579266
NivelEducacionSecundaria 0.0168995 0.0838594 0.2015222 0.8402902
NivelEducacionUniversitaria -0.1765670 0.0962789 -1.8339112 0.0666672
EmpleoDesempleado 1.9025512 0.0754169 25.2271292 0.0000000
EmpleoOtro 0.0814158 0.1206820 0.6746308 0.4999103
TipoContratoPermanente -0.1925302 0.1079893 -1.7828631 0.0746086
TipoContratoTemporal -0.1751408 0.1162388 -1.5067322 0.1318793
SaludBuena 0.0562509 0.0734992 0.7653271 0.4440768
SaludMala 0.0153250 0.1211811 0.1264639 0.8993647
HistorialCrediticioBueno -2.4105035 0.0772130 -31.2188907 0.0000000

9. Análisis de la variable ubigeo

La variable ubigeo es una variable cualitativa. A continuación, vamos a listar la cantidad de valores únicos de dicha variable en nuestra base de datos

# Contar la cantidad total de valores únicos de la variable 'UbigeoID'
length(unique(BD$UbigeoID))
[1] 100
BD$UbigeoID <- as.factor(BD$UbigeoID)

9.1 Prueba Chi 2 ( CondicionVulnerable & UbigeoID)

Con un valor p de 0.4081, que es mayor que 0.05, no rechazamos la hipótesis nula.. Esto sugiere que no existe una relación significativa entre las dos variables cualitativas.

tabla_contingencia <- table(BD$UbigeoID, BD$CondicionVulnerable)
# Realizar la prueba de Chi-cuadrado
resultado_chi2 <- chisq.test(tabla_contingencia)

# Crear una tabla bien formateada con knitr
resultados_tabla <- data.frame(
  Estadístico = c("X-squared", "Grados de libertad", "Valor p"),
  Valor = c(resultado_chi2$statistic, resultado_chi2$parameter, resultado_chi2$p.value)
)

# Mostrar la tabla
kable(resultados_tabla, caption = "Resultado de la prueba Chi-cuadrado de Pearson", align = "c")
Resultado de la prueba Chi-cuadrado de Pearson
Estadístico Valor
X-squared X-squared 101.6290415
df Grados de libertad 99.0000000
Valor p 0.4080725

9.2 Prueba Chi 2 ( CondicionVulnerable & HistorialCrediticio)

Con un valor p de 0.000 (mucho menor que 0.05), podemos rechazar la hipótesis nula de que no hay relación entre las dos variables. Esto significa que existe una relación significativa entre las dos variables cualitativas que estás analizando.

tabla_contingencia <- table(BD$HistorialCrediticio, BD$CondicionVulnerable)
# Realizar la prueba de Chi-cuadrado
resultado_chi2 <- chisq.test(tabla_contingencia)

# Crear una tabla bien formateada con knitr
resultados_tabla <- data.frame(
  Estadístico = c("X-squared", "Grados de libertad", "Valor p"),
  Valor = c(resultado_chi2$statistic, resultado_chi2$parameter, resultado_chi2$p.value)
)

# Mostrar la tabla
kable(resultados_tabla, caption = "Resultado de la prueba Chi-cuadrado de Pearson", align = "c")
Resultado de la prueba Chi-cuadrado de Pearson
Estadístico Valor
X-squared X-squared 6541.492
df Grados de libertad 2.000
Valor p 0.000

9.3 Prueba Chi 2 ( CondicionVulnerable & Empleo)

tabla_contingencia <- table(BD$Empleo, BD$CondicionVulnerable)
# Realizar la prueba de Chi-cuadrado
resultado_chi2 <- chisq.test(tabla_contingencia)

# Crear una tabla bien formateada con knitr
resultados_tabla <- data.frame(
  Estadístico = c("X-squared", "Grados de libertad", "Valor p"),
  Valor = c(resultado_chi2$statistic, resultado_chi2$parameter, resultado_chi2$p.value)
)

# Mostrar la tabla
kable(resultados_tabla, caption = "Resultado de la prueba Chi-cuadrado de Pearson", align = "c")
Resultado de la prueba Chi-cuadrado de Pearson
Estadístico Valor
X-squared X-squared 672.1514
df Grados de libertad 2.0000
Valor p 0.0000

9.4 Prueba T-Student ( CondicionVulnerable & IngresosMensuales)

Dado que el valor p es extremadamente pequeño y el intervalo de confianza para la diferencia de medias no incluye 0, podemos concluir que hay una diferencia significativa en los ingresos mensuales entre los grupos No vulnerable y Sí vulnerable. En promedio, los individuos en el grupo No vulnerable tienen ingresos mensuales más altos que los del grupo Sí vulnerable.

# Realizar la prueba t de Student (si CondicionVulnerable tiene dos categorías)
resultado_t <- t.test(IngresosMensuales ~ CondicionVulnerable, data = BD)

# Ver los resultados
resultado_t

    Welch Two Sample t-test

data:  IngresosMensuales by CondicionVulnerable
t = 14.571, df = 2003.1, p-value < 2.2e-16
alternative hypothesis: true difference in means between group No vulnerable and group Sí vulnerable is not equal to 0
95 percent confidence interval:
 522.8836 685.5276
sample estimates:
mean in group No vulnerable mean in group Sí vulnerable 
                   3086.635                    2482.429