Parcial 2 - Aprendizaje Estadísitico - MINE 8
Introducción.
El análisis de datos financieros desempeña un papel fundamental en la toma de decisiones estratégicas dentro del sector bancario, en particular, comprender la distribución de los ingresos de los clientes y los factores que influyen en la concesión de créditos permite a las entidades financieras optimizar sus políticas de riesgo, segmentar mejor a sus clientes y diseñar productos adecuados para cada perfil.
En este estudio, se analizará una base de datos anonimizada que contiene información personal y financiera de individuos y empresas que obtuvieron algún tipo de crédito en Colombia durante el año 2017, a partir de esta información, se buscará explorar la distribución del ingreso de los clientes, así como evaluar posibles diferencias en variables clave como el nivel educativo y el estrato socioeconómico entre hombres y mujeres.
Para ello, se emplearán diversas herramientas estadísticas, como análisis exploratorio de datos, técnicas de correlación, análisis de componentes principales y modelamiento predictivo, con el objetivo de identificar patrones y relaciones relevantes, además, se llevará a cabo una segmentación de clientes mediante métodos de clasificación para agruparlos según características comunes.
Los resultados de este análisis permitirán no solo comprender mejor el comportamiento financiero de los clientes del banco, sino también evaluar posibles brechas salariales de género y diseñar estrategias más efectivas para la concesión de créditos.
Limpieza y estructuración de la base de datos.
Para llevar a cabo un análisis preciso del monto total otorgado, es fundamental contar con una base de datos limpia y estructurada, el primer paso consiste en filtrar los registros para conservar únicamente aquellos que contienen información completa en las variables más relevantes para explicar el comportamiento de esta variable objetivo, esto permitirá evitar sesgos en el análisis y garantizar la validez de los resultados, además, dado que la base de datos original ha sido anonimizada, se asignará un identificador único a cada cliente, lo que facilitará la organización y posterior análisis de los datos sin comprometer la confidencialidad de la información.
path <- "C:/Users/nicor/OneDrive/Escritorio/Aprendizaje Estadistico/Parcial 2"
setwd(path)
creditos <- read.delim("creditos.txt")
creditos## AAAAMM_SOL ESTRATOS PRODS_SOLIC MONTO_TOTAL_OTORGADO
## Min. :201701 Min. : 1.000 Length:81536 Min. :1.000e+06
## 1st Qu.:201703 1st Qu.: 1.000 Class :character 1st Qu.:1.100e+07
## Median :201706 Median : 2.000 Mode :character Median :3.050e+07
## Mean :201706 Mean : 3.966 Mean :7.813e+07
## 3rd Qu.:201709 3rd Qu.: 5.000 3rd Qu.:7.550e+07
## Max. :201712 Max. :21.000 Max. :1.120e+11
##
## INGRESOS_DECLARADOS_TOTA EGRESOS_DECLARADOS_TOTAL SEXO
## Min. :3.283e+03 Min. :0.000e+00 Length:81536
## 1st Qu.:1.689e+06 1st Qu.:2.000e+05 Class :character
## Median :3.500e+06 Median :5.000e+05 Mode :character
## Mean :1.337e+07 Mean :1.778e+06
## 3rd Qu.:1.164e+07 3rd Qu.:1.500e+06
## Max. :3.300e+10 Max. :3.000e+09
##
## EDAD NIVEL_ESTUDIOS NUM_DE_PERSONAS_A_CARGO TIPO_VIVI
## Min. : 2.0 Length:81536 Min. : 0.0000 Length:81536
## 1st Qu.: 32.0 Class :character 1st Qu.: 0.0000 Class :character
## Median : 41.0 Mode :character Median : 0.0000 Mode :character
## Mean : 43.4 Mean : 0.8012
## 3rd Qu.: 53.0 3rd Qu.: 1.0000
## Max. :219.0 Max. :45.0000
##
## ESTRATO PORC_ENDTOT_CON_NUEVO_CRED SCORE_ACIERTA
## Min. :0.000 Min. :-1788.74 Min. : 0.0
## 1st Qu.:3.000 1st Qu.: 54.70 1st Qu.:718.0
## Median :3.000 Median : 70.21 Median :778.0
## Mean :3.622 Mean : 82.44 Mean :753.2
## 3rd Qu.:5.000 3rd Qu.: 85.36 3rd Qu.:833.0
## Max. :6.000 Max. :75002.97 Max. :950.0
## NA's :9 NA's :21539
## VALOR_CUOTAS_CARTBANC PORC_DEUDA_SEC_FINANCIERO SALDO_ACTUAL_SEC_FINANCIERO
## Min. :0.000e+00 Min. : 0.00 Min. :0.000e+00
## 1st Qu.:4.070e+05 1st Qu.: 38.40 1st Qu.:5.208e+06
## Median :1.357e+06 Median : 65.10 Median :2.570e+07
## Mean :4.822e+06 Mean : 59.85 Mean :1.112e+08
## 3rd Qu.:4.418e+06 3rd Qu.: 83.45 3rd Qu.:1.072e+08
## Max. :2.941e+09 Max. :2200.00 Max. :1.259e+10
## NA's :27738 NA's :31747 NA's :27738
## SALDO_TODOS_SECTORES VALOR_CUOTA_TODOS_SECTORES CUOTA_NUEVO_CREDITO
## Min. :0.000e+00 Min. :0.000e+00 Min. :0.000e+00
## 1st Qu.:5.128e+06 1st Qu.:4.160e+05 1st Qu.:2.883e+05
## Median :2.566e+07 Median :1.341e+06 Median :6.803e+05
## Mean :1.078e+08 Mean :4.806e+06 Mean :1.932e+06
## 3rd Qu.:1.018e+08 3rd Qu.:4.342e+06 3rd Qu.:1.563e+06
## Max. :1.259e+10 Max. :2.941e+09 Max. :4.758e+09
## NA's :24023 NA's :24023
## ENDEUD_NUEVO_CREDITO
## Min. : 0.01
## 1st Qu.: 6.98
## Median : 14.13
## Mean : 16.80
## 3rd Qu.: 22.27
## Max. :20119.03
## variables_seleccionadas <- c("MONTO_TOTAL_OTORGADO", "INGRESOS_DECLARADOS_TOTA",
"EGRESOS_DECLARADOS_TOTAL", "EDAD", "NIVEL_ESTUDIOS",
"SCORE_ACIERTA", "ESTRATO", "NUM_DE_PERSONAS_A_CARGO",
"PORC_ENDTOT_CON_NUEVO_CRED", "SEXO")
creditos_limpio <- creditos[, variables_seleccionadas]
creditos_limpio <- na.omit(creditos_limpio)
creditos_limpio$id <- sprintf("%03dA", seq(1, nrow(creditos_limpio)))
rownames(creditos_limpio) <- creditos_limpio$id
creditos_limpio$id <- NULL # porque ya está en los nombres de filaAnálisis exploratorio de la nueva base de datos.
Antes de realizar cualquier modelamiento o inferencia estadística, es esencial llevar a cabo un análisis exploratorio de los datos con el fin de comprender su distribución y principales características, para ello, se presentarán diversas visualizaciones y estadísticas descriptivas que permitirán identificar patrones, posibles anomalías y relaciones entre variables.
## ------------------------------------------------------------------------------
## Describe creditos_limpio (data.frame):
##
## data frame: 59993 obs. of 10 variables
## 59993 complete cases (100.0%)
##
## Nr ColName Class NAs Levels
## 1 MONTO_TOTAL_OTORGADO numeric .
## 2 INGRESOS_DECLARADOS_TOTA numeric .
## 3 EGRESOS_DECLARADOS_TOTAL numeric .
## 4 EDAD integer .
## 5 NIVEL_ESTUDIOS character .
## 6 SCORE_ACIERTA integer .
## 7 ESTRATO integer .
## 8 NUM_DE_PERSONAS_A_CARGO integer .
## 9 PORC_ENDTOT_CON_NUEVO_CRED numeric .
## 10 SEXO character .
##
##
## ------------------------------------------------------------------------------
## 1 - MONTO_TOTAL_OTORGADO (numeric)
##
## length n NAs'
## 59'993 59'993 0
## 100.0% 0.0%
##
## .05 .10 .25
## 2'000'000.000000000 3'000'000.000000000 9'000'000.000000000
##
## range sd vcoef
## 1.120170000e+11 5.000918692e+08 5.437186214
##
## unique 0s mean meanCI
## 5'893 0 9.197622622e+07 8.797441722e+07
## 0.0% 9.597803523e+07
##
## median .75 .90 .95
## 3.000000000e+07 1.000000000e+08 2.240000000e+08 3.500000000e+08
##
## mad IQR skew kurt
## 3.854760000e+07 9.100000000e+07 187.983225725 41'838.145180634
##
## lowest : 1'000'000.0 (1'483), 1'000'001.0 (66), 1'000'002.0, 1'032'000.0, 1'040'000.0 (3)
## highest: 4.500000000e+09, 6.253000000e+09, 1.000000000e+10 (5), 1.007600000e+10, 1.120180000e+11
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 2 - INGRESOS_DECLARADOS_TOTA (numeric)
##
## length n NAs unique 0s mean'
## 59'993 59'993 0 22'592 0 1.72e+07
## 100.0% 0.0% 0.0%
##
## .05 .10 .25 median .75 .90
## 935'206.00 1'180'000.00 2'020'423.00 5'850'644.00 1.70e+07 3.70e+07
##
## range sd vcoef mad IQR skew
## 3.30e+10 2.11e+08 12.26 6'623'521.43 1.50e+07 120.15
##
## meanCI
## 1.55e+07
## 1.89e+07
##
## .95
## 5.53e+07
##
## kurt
## 15'742.09
##
## lowest : 100'000.0, 101'001.0, 150'000.0, 151'200.0, 155'830.0
## highest: 7.21e+09, 2.10e+10, 2.11e+10, 2.35e+10, 3.30e+10
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 3 - EGRESOS_DECLARADOS_TOTAL (numeric)
##
## length n NAs unique'
## 59'993 59'993 0 1'081
## 100.0% 0.0%
##
## .05 .10 .25 median
## 101'000.000000 160'000.000000 300'000.000000 800'000.000000
##
## range sd vcoef mad
## 3.000000e+09 2.333285e+07 10.592414 889'560.000000
##
## 0s mean meanCI
## 226 2'202'788.506742 2'016'075.614265
## 0.4% 2'389'501.399220
##
## .75 .90 .95
## 2'000'000.000000 4'000'000.000000 5'500'000.000000
##
## IQR skew kurt
## 1'700'000.000000 75.365363 7'255.139810
##
## lowest : 0.0 (226), 1.0, 1'000.0 (4), 3'200.0, 5'125.0
## highest: 1.000000e+09 (2), 1.300000e+09, 1.710000e+09 (3), 2.000000e+09, 3.000000e+09
##
## heap(?): remarkable frequency (11.7%) for the mode(s) (= 1e+06)
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 4 - EDAD (integer)
##
## length n NAs unique 0s mean meanCI'
## 59'993 59'993 0 83 0 41.51 41.41
## 100.0% 0.0% 0.0% 41.60
##
## .05 .10 .25 median .75 .90 .95
## 25.00 27.00 32.00 40.00 50.00 59.00 63.00
##
## range sd vcoef mad IQR skew kurt
## 217.00 12.06 0.29 13.34 18.00 0.51 0.32
##
## lowest : 2 (2), 4 (2), 6, 8, 9 (2)
## highest: 87 (3), 89 (3), 91, 109 (8), 219
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 5 - NIVEL_ESTUDIOS (character)
##
## length n NAs unique levels dupes
## 59'993 59'993 0 8 8 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 UNV 18'585 31.0% 18'585 31.0%
## 2 PRF 17'899 29.8% 36'484 60.8%
## 3 TEC 6'887 11.5% 43'371 72.3%
## 4 POS 6'493 10.8% 49'864 83.1%
## 5 BAS 5'653 9.4% 55'517 92.5%
## 6 NOG 2'321 3.9% 57'838 96.4%
## 7 MED 1'486 2.5% 59'324 98.9%
## 8 DOC 669 1.1% 59'993 100.0%
## ------------------------------------------------------------------------------
## 6 - SCORE_ACIERTA (integer)
##
## length n NAs unique 0s mean meanCI'
## 59'993 59'993 0 599 1'144 753.23 752.07
## 100.0% 0.0% 1.9% 754.40
##
## .05 .10 .25 median .75 .90 .95
## 586.00 652.00 718.00 778.00 833.00 869.00 886.00
##
## range sd vcoef mad IQR skew kurt
## 950.00 145.45 0.19 84.51 115.00 -3.47 15.19
##
## lowest : 0 (1'144), 1 (5), 3 (15), 4 (87), 7 (242)
## highest: 943 (3), 944 (4), 945, 949, 950 (5)
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 7 - ESTRATO (integer)
##
## length n NAs unique 0s mean meanCI'
## 59'993 59'993 0 7 253 3.95 3.94
## 100.0% 0.0% 0.4% 3.96
##
## .05 .10 .25 median .75 .90 .95
## 2.00 2.00 3.00 4.00 5.00 6.00 6.00
##
## range sd vcoef mad IQR skew kurt
## 6.00 1.37 0.35 1.48 2.00 0.01 -0.80
##
##
## value freq perc cumfreq cumperc
## 1 0 253 0.4% 253 0.4%
## 2 1 1'089 1.8% 1'342 2.2%
## 3 2 6'505 10.8% 7'847 13.1%
## 4 3 17'865 29.8% 25'712 42.9%
## 5 4 13'282 22.1% 38'994 65.0%
## 6 5 9'609 16.0% 48'603 81.0%
## 7 6 11'390 19.0% 59'993 100.0%
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 8 - NUM_DE_PERSONAS_A_CARGO (integer)
##
## length n NAs unique 0s mean meanCI'
## 59'993 59'993 0 9 32'178 0.72 0.71
## 100.0% 0.0% 53.6% 0.73
##
## .05 .10 .25 median .75 .90 .95
## 0.00 0.00 0.00 0.00 1.00 2.00 3.00
##
## range sd vcoef mad IQR skew kurt
## 10.00 0.95 1.31 0.00 1.00 1.41 2.29
##
##
## value freq perc cumfreq cumperc
## 1 0 32'178 53.6% 32'178 53.6%
## 2 1 16'355 27.3% 48'533 80.9%
## 3 2 8'339 13.9% 56'872 94.8%
## 4 3 2'390 4.0% 59'262 98.8%
## 5 4 563 0.9% 59'825 99.7%
## 6 5 130 0.2% 59'955 99.9%
## 7 6 33 0.1% 59'988 100.0%
## 8 7 2 0.0% 59'990 100.0%
## 9 10 3 0.0% 59'993 100.0%
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 9 - PORC_ENDTOT_CON_NUEVO_CRED (numeric)
##
## length n NAs unique 0s mean meanCI'
## 59'993 59'993 0 10'286 0 82.163 79.839
## 100.0% 0.0% 0.0% 84.486
##
## .05 .10 .25 median .75 .90 .95
## 44.300 48.030 58.570 71.870 85.020 101.270 118.638
##
## range sd vcoef mad IQR skew kurt
## 32'581.350 290.351 3.534 19.630 26.450 72.654 6'316.243
##
## lowest : -56.570, 4.61, 5.0, 6.26, 9.51
## highest: 15'949.060, 23'398.660, 26'206.410, 27'165.140, 32'524.780
##
## ' 95%-CI (classic)
## ------------------------------------------------------------------------------
## 10 - SEXO (character - dichotomous)
##
## length n NAs unique
## 59'993 59'993 0 2
## 100.0% 0.0%
##
## freq perc lci.95 uci.95'
## H 35'399 59.0% 58.6% 59.4%
## M 24'594 41.0% 40.6% 41.4%
##
## ' 95%-CI (Wilson)
En primer lugar, se construirá una tabla de frecuencias relativas para la variable género, lo que permitirá conocer la proporción de hombres y mujeres en la base de datos.
Luego, se analizará el nivel educativo de los clientes mediante una tabla de frecuencias y un gráfico de barras, diferenciando entre hombres y mujeres para evaluar posibles disparidades en la educación.
creditos_limpio$NIVEL_ESTUDIOS <- factor(creditos_limpio$NIVEL_ESTUDIOS,
levels = c("BAS", "MED", "TEC", "PRF", "NOG", "UNV", "POS", "DOC"),
labels = c("Primaria", "Bachillerato", "Técnico", "Otros Oficios",
"Pregrado incompleto", "Pregrado completo",
"Especialización/Maestría", "Doctorado"))
kableExtra::kable(table(creditos_limpio$NIVEL_ESTUDIOS),col.names = c("Nivel Educativo","Freq"))| Nivel Educativo | Freq |
|---|---|
| Primaria | 5653 |
| Bachillerato | 1486 |
| Técnico | 6887 |
| Otros Oficios | 17899 |
| Pregrado incompleto | 2321 |
| Pregrado completo | 18585 |
| Especialización/Maestría | 6493 |
| Doctorado | 669 |
tabla_genero <- prop.table(table(creditos_limpio$SEXO))
tabla_genero <- round(tabla_genero, 3) * 100
tabla_genero_df <- data.frame(
Sexo = names(tabla_genero),
Porcentaje = paste0(tabla_genero, "%")
)
kableExtra::kable(tabla_genero_df, col.names = c("Sexo", "Porcentaje"))| Sexo | Porcentaje |
|---|---|
| H | 59% |
| M | 41% |
tabla_nivel_educativo <- prop.table(table(creditos_limpio$NIVEL_ESTUDIOS, creditos_limpio$SEXO), margin = 1)
tabla_nivel_educativo <- round(tabla_nivel_educativo, 3) * 100
kableExtra::kable(tabla_nivel_educativo) |>
kableExtra::add_header_above(c("Cantidad porcentual según nivel Educactivo y Séxo" = 3))| H | M | |
|---|---|---|
| Primaria | 71.5 | 28.5 |
| Bachillerato | 65.0 | 35.0 |
| Técnico | 50.3 | 49.7 |
| Otros Oficios | 60.4 | 39.6 |
| Pregrado incompleto | 56.4 | 43.6 |
| Pregrado completo | 54.2 | 45.8 |
| Especialización/Maestría | 65.7 | 34.3 |
| Doctorado | 71.7 | 28.3 |
ggplot(creditos_limpio, aes(x = NIVEL_ESTUDIOS, fill = SEXO)) +
geom_bar(position = "dodge") +
labs(title = "Distribución del Nivel Educativo por Género",
x = "Nivel Educativo",
y = "Frecuencia") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Posteriormente, se examinará la distribución del ingreso mediante histogramas y diagramas de caja, desagregados por género, con el objetivo de detectar diferencias en la dispersión y tendencia central de esta variable, a partir de estos análisis, se discutirá si existen diferencias significativas en el nivel educativo y el estrato socioeconómico entre hombres y mujeres, y se evaluará la posible presencia de una brecha salarial utilizando pruebas de hipótesis estadísticas.
Sin embargo, se observan datos atipicos que no permiten visualizar dicho grafico de una manera ideonea por lo cual se intentan separar dichos datos.
Q1 <- quantile(creditos_limpio$INGRESOS_DECLARADOS_TOTA, 0.25, na.rm = TRUE)
Q3 <- quantile(creditos_limpio$INGRESOS_DECLARADOS_TOTA, 0.75, na.rm = TRUE)
IQR_valor <- Q3 - Q1
limite_inferior <- Q1 - 1.5 * IQR_valor
limite_superior <- Q3 + 1.5 * IQR_valor
creditos_filtrado <- subset(creditos_limpio,
INGRESOS_DECLARADOS_TOTA >= limite_inferior &
INGRESOS_DECLARADOS_TOTA <= limite_superior)
ggplot(creditos_filtrado, aes(x = INGRESOS_DECLARADOS_TOTA, fill = SEXO)) +
geom_histogram(alpha = 0.5, bins = 30, position = "identity") +
labs(title = "Distribución de Ingresos por Género (Sin Atípicos)",
x = "Ingresos Declarados",
y = "Frecuencia") +
theme_minimal()
ggplot(creditos_filtrado, aes(x = SEXO, y = INGRESOS_DECLARADOS_TOTA, fill = SEXO)) +
geom_boxplot(outlier.shape = NA) + # Evita mostrar los atípicos en el gráfico
labs(title = "Comparación de Ingresos por Género (Sin Atípicos)",
x = "Género",
y = "Ingresos Declarados") +
theme_minimal()
##
## Welch Two Sample t-test
##
## data: INGRESOS_DECLARADOS_TOTA by SEXO
## t = 5.3375, df = 53948, p-value = 9.46e-08
## alternative hypothesis: true difference in means between group H and group M is not equal to 0
## 95 percent confidence interval:
## 5889439 12724828
## sample estimates:
## mean in group H mean in group M
## 21048196 11741062Los resultados obtenidos muestran diferencias notables en el nivel educativo entre hombres y mujeres, en los niveles de educación básica y bachillerato, la proporción de hombres es significativamente mayor que la de mujeres, sin embargo, a medida que se avanza en niveles de educación técnica y universitaria, la distribución se vuelve más equitativa, apesar de esto, en niveles de posgrado como especialización, maestría y doctorado, se observa nuevamente una predominancia masculina.
En cuanto a los ingresos, el diagrama de caja revela que la mediana de ingresos es mayor para los hombres en comparación con las mujeres, además, la dispersión de los ingresos también es más amplia en el caso de los hombres, lo que sugiere una mayor variabilidad en los montos percibidos.
Para evaluar si estas diferencias son estadísticamente significativas, se realizó una prueba t para comparar las medias de ingresos entre hombres y mujeres, los resultados obtenidos (t = 5.3375, df = 53948, p-value = 9.46e-08) indican que la diferencia entre los ingresos medios de ambos grupos es significativa, con una diferencia de medias estimada entre 5,889,439 y 12,724,828, en promedio, los hombres reportan un ingreso de 21,048,196, mientras que las mujeres tienen un ingreso promedio de 11,741,062.
Dado que el p-valor es extremadamente pequeño (p < 0.05), podemos rechazar la hipótesis nula de igualdad de medias y concluir que existe una diferencia significativa en los ingresos entre hombres y mujeres, esto sugiere la presencia de una brecha salarial en este grupo de clientes del banco.
Por último, se calculará la matriz de correlación y se graficarán dispersogramas para explorar las relaciones entre las variables seleccionadas, esto permitirá identificar patrones de asociación y determinar la relevancia de las diferentes variables en la explicación del monto total otorgado, lo que será clave para el modelamiento posterior.
# Variables numéricas relevantes
vars_numericas <- creditos_limpio[, c("MONTO_TOTAL_OTORGADO", "INGRESOS_DECLARADOS_TOTA",
"EGRESOS_DECLARADOS_TOTAL", "SCORE_ACIERTA")]
cor_matrix <- cor(vars_numericas, use = "complete.obs")
cor_table <- cor_matrix |>
kable(format = "html", caption = "Matriz de Correlación") |>
kable_styling(full_width = FALSE, position = "center")
cor_table| MONTO_TOTAL_OTORGADO | INGRESOS_DECLARADOS_TOTA | EGRESOS_DECLARADOS_TOTAL | SCORE_ACIERTA | |
|---|---|---|---|---|
| MONTO_TOTAL_OTORGADO | 1.0000000 | 0.0339827 | 0.0210022 | 0.0435401 |
| INGRESOS_DECLARADOS_TOTA | 0.0339827 | 1.0000000 | 0.0346048 | 0.0213684 |
| EGRESOS_DECLARADOS_TOTAL | 0.0210022 | 0.0346048 | 1.0000000 | 0.0118670 |
| SCORE_ACIERTA | 0.0435401 | 0.0213684 | 0.0118670 | 1.0000000 |
ggpairs(vars_numericas,
title = "Matriz de Dispersión de Variables Seleccionadas",
mapping = aes(color = creditos_limpio$SEXO))
La matriz de dispersión revela correlaciones bajas pero significativas entre las variables analizadas, la relación entre monto total otorgado e ingresos declarados es débil (0.034), sugiriendo que otros factores influyen en la asignación del crédito.
Se observan diferencias por género: la correlación entre ingresos y monto otorgado es mayor en mujeres (0.044 vs. 0.035 en hombres), lo que indica que sus ingresos pueden tener mayor peso en la decisión crediticia, asimismo, la relación entre ingresos declarados y score_acierta es más fuerte en mujeres (0.093 vs. 0.038 en hombres), lo que sugiere diferencias en patrones financieros.
Los gráficos muestran una alta concentración de valores bajos y algunos casos extremos, lo que puede estar afectando las correlaciones observadas, en general, los ingresos no parecen ser el principal determinante del crédito o desempeño en score_acierta, lo que resalta la necesidad de considerar otros factores como historial financiero o estabilidad laboral.
Análisis de Componentes Principales.
El análisis de componentes principales (PCA) es una técnica estadística utilizada para reducir la dimensionalidad de un conjunto de datos mientras se conserva la mayor cantidad de información posible, en este caso, aplicaremos PCA a las variables seleccionadas para identificar cuántos componentes son suficientes para explicar más del 80% y 90% de la variabilidad de los datos, además, examinaremos las cargas de las dos primeras componentes principales para determinar qué variables tienen un mayor impacto en cada una, finalmente, presentaremos un bi-plot que permitirá visualizar simultáneamente la relación entre las variables y los clientes, facilitando la interpretación de los patrones subyacentes en los datos.
creditos_numerico <- creditos[, sapply(creditos, is.numeric)]
creditos_numerico <- na.omit(creditos_numerico)
creditos_scaled <- scale(creditos_numerico)
pca_model <- princomp(creditos_scaled, cor = TRUE, scores = TRUE)
summary(pca_model)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.8199832 1.5894831 1.3154861 1.12263202 1.04239383
## Proportion of Variance 0.1948435 0.1486151 0.1017943 0.07413545 0.06391676
## Cumulative Proportion 0.1948435 0.3434586 0.4452529 0.51938835 0.58330511
## Comp.6 Comp.7 Comp.8 Comp.9 Comp.10
## Standard deviation 1.03270100 0.99660853 0.98584515 0.94777699 0.84669611
## Proportion of Variance 0.06273361 0.05842521 0.05717004 0.05284007 0.04217025
## Cumulative Proportion 0.64603872 0.70446392 0.76163396 0.81447403 0.85664429
## Comp.11 Comp.12 Comp.13 Comp.14 Comp.15
## Standard deviation 0.82954743 0.81636728 0.73544931 0.63446500 0.360114879
## Proportion of Variance 0.04047935 0.03920327 0.03181681 0.02367917 0.007628396
## Cumulative Proportion 0.89712364 0.93632690 0.96814371 0.99182288 0.999451271
## Comp.16 Comp.17
## Standard deviation 0.083018812 0.0493586218
## Proportion of Variance 0.000405419 0.0001433102
## Cumulative Proportion 0.999856690 1.0000000000screeplot(pca_model, col = "blue", pch = 16, type = "lines", cex = 2, lwd = 2,
cex.axis = 0.8, cex.lab = 0.8, main = " ")
## Warning: ggrepel: 5 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
biplot(pca_model,
col = c("red", "blue"),
cex = c(0.6, 0.5),
scale = 1,
xlab = "Primera componente",
ylab = "Segunda componente",
main = "Plano factorial")
grid()
## Comp.1 Comp.2
## AAAAMM_SOL 0.005 0.010
## ESTRATOS 0.082 0.001
## MONTO_TOTAL_OTORGADO 0.210 0.428
## INGRESOS_DECLARADOS_TOTA 0.098 -0.039
## EGRESOS_DECLARADOS_TOTAL 0.147 0.064
## EDAD 0.203 -0.072
## NUM_DE_PERSONAS_A_CARGO 0.099 -0.037
## ESTRATO 0.244 -0.072
## PORC_ENDTOT_CON_NUEVO_CRED 0.164 0.508
## SCORE_ACIERTA 0.080 -0.041
## VALOR_CUOTAS_CARTBANC 0.395 -0.173
## PORC_DEUDA_SEC_FINANCIERO 0.047 -0.016
## SALDO_ACTUAL_SEC_FINANCIERO 0.451 -0.164
## SALDO_TODOS_SECTORES 0.451 -0.164
## VALOR_CUOTA_TODOS_SECTORES 0.396 -0.173
## CUOTA_NUEVO_CREDITO 0.167 0.366
## ENDEUD_NUEVO_CREDITO 0.156 0.541boxplot(pca_model$scores[ , 1], pca_model$scores[ , 2], horizontal = T, boxwex = 0.5,
names = c("Comp. 1", "Comp. 2"), xlab = "Puntaje")
El análisis de componentes principales revela que los primeros cinco componentes explican aproximadamente el 58.3% de la variabilidad de los datos, mientras que los primeros diez alcanzan un 85.7%, lo que sugiere que una cantidad relativamente pequeña de componentes es suficiente para representar la mayor parte de la información del conjunto de datos,para explicar más del 90%, se requieren al menos 12 componentes, lo que implica una reducción significativa en la dimensionalidad original sin perder demasiada información.
La rápida acumulación de varianza en los primeros componentes sugiere que ciertas variables tienen una alta correlación y pueden condensarse en unas pocas dimensiones principales, dado que el primer componente explica el 19.5%, seguido del segundo con 14.9%, es probable que estas dimensiones estén capturando las principales diferencias entre los clientes en términos de ingresos, nivel educativo u otros factores determinantes del crédito.
Modelamiento.
Con el fin de entender los factores que afectan el MONTO TOTAL OTORGADO, se construye un modelo predictivo que permite explicar esta variable en función de otras variables.
Se aplica el modelo de REGRESIÓN LASSO, la cual es útil en contextos donde se busca realizar selección automática de variables y mejorar la precisión del modelo. Este tipo de regresión ayuda a reducir el sobreajuste aplicando una penalización a los coeficientes grandes, y selecciona variables automáticamente, eliminando aquellas irrelevantes.
set.seed(123)
n <- nrow(creditos_limpio)
indices <- sample(1:n, size = 0.7 * n)
Data_train <- creditos_limpio[indices, ]
Data_test <- creditos_limpio[-indices, ]
###### MODELO LASSO ########
# [-1] Para quitar el intercepto
x <- model.matrix(MONTO_TOTAL_OTORGADO ~ ., data = Data_train)[, -1]
y <- Data_train$MONTO_TOTAL_OTORGADO
fit.lasso <- glmnet(x, y, alpha = 1, nlambda = 100)
Coeflasso <- coef(fit.lasso)
dim(Coeflasso)## [1] 16 69plot(fit.lasso, xvar = "lambda", label = TRUE)
# Para saber el lambda modelo 60
fit.lasso$lambda[60]## [1] 1226601## [1] 14.01976## (Intercept) INGRESOS_DECLARADOS_TOTA
## -2.110418e+08 2.355537e-01
## EGRESOS_DECLARADOS_TOTAL EDAD
## -5.497094e+00 1.286582e+06
## NIVEL_ESTUDIOSBachillerato NIVEL_ESTUDIOSTécnico
## 0.000000e+00 0.000000e+00
## NIVEL_ESTUDIOSOtros Oficios NIVEL_ESTUDIOSPregrado incompleto
## 3.286891e+06 -5.551565e+06
## NIVEL_ESTUDIOSPregrado completo NIVEL_ESTUDIOSEspecialización/Maestría
## 0.000000e+00 2.332529e+07
## NIVEL_ESTUDIOSDoctorado SCORE_ACIERTA
## 6.133673e+06 2.052683e+04
## ESTRATO NUM_DE_PERSONAS_A_CARGO
## 3.893739e+07 9.166492e+06
## PORC_ENDTOT_CON_NUEVO_CRED SEXOM
## 1.121122e+06 -3.121159e+07plot(fit.lasso, xvar = "lambda", label = TRUE)
abline(v = log(fit.lasso$lambda[60]), col = "blue", lwd = 4, lty = 3)
## [1] 80702175## [1] 18.20628## (Intercept) INGRESOS_DECLARADOS_TOTA
## 35479706.1 0.0
## EGRESOS_DECLARADOS_TOTAL EDAD
## 0.0 0.0
## NIVEL_ESTUDIOSBachillerato NIVEL_ESTUDIOSTécnico
## 0.0 0.0
## NIVEL_ESTUDIOSOtros Oficios NIVEL_ESTUDIOSPregrado incompleto
## 0.0 0.0
## NIVEL_ESTUDIOSPregrado completo NIVEL_ESTUDIOSEspecialización/Maestría
## 0.0 0.0
## NIVEL_ESTUDIOSDoctorado SCORE_ACIERTA
## 0.0 0.0
## ESTRATO NUM_DE_PERSONAS_A_CARGO
## 0.0 0.0
## PORC_ENDTOT_CON_NUEVO_CRED SEXOM
## 696958.1 0.0plot(fit.lasso, xvar = "lambda", label = TRUE)
abline(v = log(fit.lasso$lambda[15]), col = "blue", lwd = 4, lty = 3)
# Hacer predicción con un modelo en particular
x.test <- model.matrix(MONTO_TOTAL_OTORGADO ~ ., Data_test)[, -1]
pred2 <- predict(fit.lasso, s = fit.lasso$lambda[15], newx = x.test)
pred2_df <- as.data.frame(pred2)
pred2_df
## [1] 270481622## [1] 19.41571## (Intercept) INGRESOS_DECLARADOS_TOTA
## 85964728.56 0.00
## EGRESOS_DECLARADOS_TOTAL EDAD
## 0.00 0.00
## NIVEL_ESTUDIOSBachillerato NIVEL_ESTUDIOSTécnico
## 0.00 0.00
## NIVEL_ESTUDIOSOtros Oficios NIVEL_ESTUDIOSPregrado incompleto
## 0.00 0.00
## NIVEL_ESTUDIOSPregrado completo NIVEL_ESTUDIOSEspecialización/Maestría
## 0.00 0.00
## NIVEL_ESTUDIOSDoctorado SCORE_ACIERTA
## 0.00 0.00
## ESTRATO NUM_DE_PERSONAS_A_CARGO
## 0.00 0.00
## PORC_ENDTOT_CON_NUEVO_CRED SEXOM
## 85032.74 0.00pred2 <- predict(fit.lasso, s = mejor.lambda, newx = x.test)
pred2_df <- as.data.frame(pred2)
pred2_df# Definir la función R2 manualmente
R2 <- function(y_predict, y_actual)
{cor(y_predict, y_actual)^2}
# Root Mean Square Error -- Error de predicción del modelo
data.frame(
SCE = sum((pred2 - Data_test$MONTO_TOTAL_OTORGADO)^2),
ECM = mse(Data_test$MONTO_TOTAL_OTORGADO, pred2),
ECMR = rmse(Data_test$MONTO_TOTAL_OTORGADO, pred2),
Rsquare = R2(pred2, Data_test$MONTO_TOTAL_OTORGADO)
)El modelo aplicado fue una regresión LASSO, útil para eliminar variables irrelevantes y mejorar la precisión del modelo mediante penalización. Sin embargo en este caso, el modelo no logró una buena predicción, lo que indica que las variables incluidas no tienen suficiente poder explicativo sobre la variable MONTO TOTAL OTORGADO.
La Suma de los Cuadrados del Error (SCE) fue extremadamente alta, lo que indica que el modelo predice valores muy alejados de los reales.
Tanto el Error Cuadrático Medio (ECM) como la Raíz del ECM (ECMR) fueron también elevados, lo que confirma que las predicciones no se ajustan bien a los datos observados. Esto puede deberse a la presencia de datos atípicos, escalas muy distintas entre variables, o a una distribución sesgada de la variable objetivo.
El coeficiente de determinación \(R^2\) fue de apenas 0.017, es decir, el modelo solo logra explicar el 1.7% de la variabilidad del monto otorgado, lo cual indica una capacidad explicativa muy baja.
En conclusión, aunque el modelo fue correctamente aplicado, no resulta útil para explicar ni predecir adecuadamente el MONTO TOTAL OTORGADO en este caso. Se recomienda revisar posibles transformaciones de la variable dependiente o considerar modelos alternativos.
Clasificación.
Con el fin de agrupar individuos con caracteristicas similares y facilitar la segmentación, se aplicó un analisis de clusterin jerárquico, usando las variables seleccionadas de:
• INGRESOS_DECLARADOS_TOTA
• EGRESOS_DECLARADOS_TOTAL
• EDAD
• SCORE_ACIERTA
• PORC_ENDTOT_CON_NUEVO_CRED
Se limpia la base de datos eliminando observaciones con valores faltantes, se estandarizan las variables para asegurar comparabilidad.
Con la construcción de la matriz de distancias ecludiana se aplica posteriormente el metodo de enlace Ward.D2 el cual ayuda a minizar la varianza dentro de los grupos.
## [1] FALSE# Selección y limpieza de variables
X <- creditos_limpio[, c("INGRESOS_DECLARADOS_TOTA",
"EGRESOS_DECLARADOS_TOTAL",
"EDAD",
"SCORE_ACIERTA",
"PORC_ENDTOT_CON_NUEVO_CRED")]
X <- as.data.frame(lapply(X, function(col) as.numeric(as.character(col))))
X <- X[complete.cases(X), ]
rownames(X) <- paste0("obs", 1:nrow(X))
summary(X)## INGRESOS_DECLARADOS_TOTA EGRESOS_DECLARADOS_TOTAL EDAD
## Min. :1.000e+05 Min. :0.000e+00 Min. : 2.00
## 1st Qu.:2.020e+06 1st Qu.:3.000e+05 1st Qu.: 32.00
## Median :5.851e+06 Median :8.000e+05 Median : 40.00
## Mean :1.723e+07 Mean :2.203e+06 Mean : 41.51
## 3rd Qu.:1.698e+07 3rd Qu.:2.000e+06 3rd Qu.: 50.00
## Max. :3.300e+10 Max. :3.000e+09 Max. :219.00
## SCORE_ACIERTA PORC_ENDTOT_CON_NUEVO_CRED
## Min. : 0.0 Min. : -56.57
## 1st Qu.:718.0 1st Qu.: 58.57
## Median :778.0 Median : 71.87
## Mean :753.2 Mean : 82.16
## 3rd Qu.:833.0 3rd Qu.: 85.02
## Max. :950.0 Max. :32524.78# Ajuste del algoritmo
set.seed(123)
idx_sample <- sample(1:nrow(X_esc), 300)
X_esc_muestra <- X_esc[idx_sample, ]
dm_muestra <- dist(X_esc_muestra, method = "euclidean")
fit_ward_muestra <- hclust(dm_muestra, method = "ward.D2")# Dendograma muestra rápida 300 obs
set.seed(123)
X_sub <- X[sample(1:nrow(X), 300), ]
X_esc_sub <- scale(X_sub)
dm_sub <- dist(X_esc_sub)
fit_sub <- hclust(dm_sub, method = "ward.D2")
fviz_dend(fit_sub, k = 4, cex = 0.5, show_labels = FALSE) +
geom_hline(yintercept = 4.5, linetype = "dashed") +
labs(title = "Clustering jerárquico (muestra de 300)",
subtitle = "Distancia euclídea, método Ward")## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## grupo
## 1 2 3 4
## 120 121 58 1# Visualización final
fviz_cluster(list(data = X_esc_muestra, cluster = grupo),
ellipse.type = "convex",
geom = "point",
show.clust.cent = TRUE) +
labs(title = "Segmentación de clientes (muestra)",
subtitle = "Cluster jerárquico Ward") +
theme_minimal() +
theme(legend.position = "bottom")
El análisis permitió identificar 4 grupos diferenciados de individuos, los cuales fueron segmentados basados en su perfil financiero y demográfico. Esta clasificaicón muestra una base solida para entender la composición de la base de datos y así la toma de decisiones como lo son políticas de crédito diferenciables, campañas personalizadas y estudios de riesgo.
Se realiza la caracterización de cada cluster propuesto:
# Caracterización de cada cluster propuesto usando la muestra
X_clusters <- X[idx_sample, ]
X_clusters$Grupo <- grupo
# Promedio de cada variable por cluster
caracterizacion <- aggregate(. ~ Grupo, data = X_clusters, FUN = mean)
print(caracterizacion)## Grupo INGRESOS_DECLARADOS_TOTA EGRESOS_DECLARADOS_TOTAL EDAD
## 1 1 23427329 2177795.0 50.27500
## 2 2 5403067 783074.4 30.57025
## 3 3 16316336 1775435.3 46.81034
## 4 4 33267668 136721583.0 67.00000
## SCORE_ACIERTA PORC_ENDTOT_CON_NUEVO_CRED
## 1 836.2917 74.52067
## 2 750.2397 79.27802
## 3 661.4828 78.84586
## 4 907.0000 438.24000Luego de la caracterización de los grupos obtenidos a partir del análisis de clustering jerárquico con el método Ward, se muestra que:
Grupo 1: personas con ingresos y egresos medios, edad intermedia y nivel de endeudamiento moderado. Representan un perfil estable.
Grupo 2: individuos con mayores ingresos, mayor edad, score alto y egresos más elevados. Son personas con capacidad financiera más sólida.
Grupo 3: clientes jóvenes, con ingresos bajos, menor score y bajo nivel de endeudamiento. Posiblemente clientes nuevos o de bajo perfil financiero.
Grupo 4: se observan valores más extremos o fuera del patrón. Puede tratarse de casos puntuales o perfiles atípicos.
Esta caracterización permite identificar perfiles diferenciados y tener una mejor idea de quiénes conforman cada grupo.
Conclusión.
En el estudio realizado se abordaron diferentes aspectos del comportamiento financiero de los clientes que accedieron a créditos en Colombia durante el año 2017. A lo largo del informe se aplicaron diferentes herramientas estadísticas que permitieron analizar el perfil de los clientes y explorar posibles desigualdades en variables clave como el ingreso, el nivel educativo y el score crediticio.
Se evidenciaron diferencias entre hombres y mujeres, especialmente en los ingresos, donde se confirmó estadísticamente que existe una brecha salarial significativa. También se encontraron diferencias en el nivel educativo dependiendo del género, lo cual puede estar relacionado con las oportunidades laborales y salariales.
Aunque se esperaba que los ingresos explicaran el monto otorgado en los créditos, el modelo mostró que no es así. Esto quiere decir que el banco probablemente tiene en cuenta otros factores para definir el monto del crédito, y que las variables que tenemos no son suficientes para predecirlo bien.
En general, este estuio permitió entender mejor cómo se comportan los clientes del banco, qué diferencias hay entre ellos, y cómo se podrían usar estos análisis para tomar decisiones, tanto desde la parte comercial como del riesgo.