Parcial Practico 2
Cristian Suarez
2026-09-18
PUNTO 1: LIMPIEZA Y SELECCIÓN DE DATOS
1.1 Carga de la base de datos
creditos <- read.delim("C:/Users/SAMSUNG/Downloads/creditos.txt")
# Verificación inicial de la estructura de los datos
str(creditos)## 'data.frame': 81536 obs. of 21 variables:
## $ AAAAMM_SOL : int 201709 201705 201701 201703 201702 201703 201709 201701 201709 201706 ...
## $ ESTRATOS : int 21 21 21 21 21 21 20 21 21 21 ...
## $ PRODS_SOLIC : chr "21.OTROS" "21.OTROS" "21.OTROS" "21.OTROS" ...
## $ MONTO_TOTAL_OTORGADO : num 3.65e+08 1.88e+08 7.00e+07 5.50e+06 1.48e+08 ...
## $ INGRESOS_DECLARADOS_TOTA : num 15000000 7800000 13910000 956000 8000000 ...
## $ EGRESOS_DECLARADOS_TOTAL : num 1200000 500000 1712000 200000 1000000 ...
## $ SEXO : chr "H" "H" "H" "M" ...
## $ EDAD : int 34 28 34 42 59 41 29 29 41 38 ...
## $ NIVEL_ESTUDIOS : chr "PRF" "PRF" "PRF" "TEC" ...
## $ NUM_DE_PERSONAS_A_CARGO : int 0 0 1 0 0 1 0 0 3 0 ...
## $ TIPO_VIVI : chr "ARRENDADA" "ARRENDADA" "ARRENDADA" "ARRENDADA" ...
## $ ESTRATO : int 6 5 3 3 3 4 4 4 1 4 ...
## $ PORC_ENDTOT_CON_NUEVO_CRED : num 65.6 68.6 66 41.3 80.1 ...
## $ SCORE_ACIERTA : int 767 745 663 620 702 647 855 831 791 804 ...
## $ VALOR_CUOTAS_CARTBANC : num 2309000 0 1658000 372000 1564000 ...
## $ PORC_DEUDA_SEC_FINANCIERO : num 71.7 NA 91.5 74.9 79.3 ...
## $ SALDO_ACTUAL_SEC_FINANCIERO: num 52976000 0 74052000 3083000 24554000 ...
## $ SALDO_TODOS_SECTORES : num 53167000 0 74052000 5561000 48486000 ...
## $ VALOR_CUOTA_TODOS_SECTORES : num 2309000 0 1853000 665000 2993000 ...
## $ CUOTA_NUEVO_CREDITO : num 5619394 2178410 1700924 106874 2100682 ...
## $ ENDEUD_NUEVO_CREDITO : num 17.9 13.2 10.4 10.6 23.9 ...# Se observan 21 variables de tipo numérico y character
# La variable MONTO_TOTAL_OTORGADO será nuestra variable de interés1.2 Selección de variables relevantes
variables_seleccionadas <- c(
"SEXO",
"INGRESOS_DECLARADOS_TOTA",
"NIVEL_ESTUDIOS",
"EDAD",
"ESTRATO",
"PORC_ENDTOT_CON_NUEVO_CRED",
"MONTO_TOTAL_OTORGADO"
)
creditos_subset <- creditos[, variables_seleccionadas]1.3 Depuración de datos incompletos
registros_completos <- complete.cases(creditos_subset)
creditos_final <- creditos_subset[registros_completos, ]
# Diagnóstico del impacto
n_original <- nrow(creditos)
n_final <- nrow(creditos_final)
perdidos <- n_original - n_final
porcentaje_perdidos <- round(perdidos / n_original * 100, 2)
cat("Registros originales:", n_original, "\n")## Registros originales: 81536cat("Registros finales:", n_final, "\n")## Registros finales: 81527cat("Registros eliminados:", perdidos, "\n")## Registros eliminados: 9cat("Porcentaje de registros eliminados:", porcentaje_perdidos, "%\n")## Porcentaje de registros eliminados: 0.01 %1.4 Asignación de identificador único
Se asigna un identificador único a cada cliente como nombre de fila, con el fin de garantizar trazabilidad en los análisis posteriores
rownames(creditos_final) <- paste0("Cliente_", 1:nrow(creditos_final))1.5 Verificación final de la base
Revisión de la estructura y estadísticas básicas de la base depurada
str(creditos_final)## 'data.frame': 81527 obs. of 7 variables:
## $ SEXO : chr "H" "H" "H" "M" ...
## $ INGRESOS_DECLARADOS_TOTA : num 15000000 7800000 13910000 956000 8000000 ...
## $ NIVEL_ESTUDIOS : chr "PRF" "PRF" "PRF" "TEC" ...
## $ EDAD : int 34 28 34 42 59 41 29 29 41 38 ...
## $ ESTRATO : int 6 5 3 3 3 4 4 4 1 4 ...
## $ PORC_ENDTOT_CON_NUEVO_CRED: num 65.6 68.6 66 41.3 80.1 ...
## $ MONTO_TOTAL_OTORGADO : num 3.65e+08 1.88e+08 7.00e+07 5.50e+06 1.48e+08 ...summary(creditos_final)## SEXO INGRESOS_DECLARADOS_TOTA NIVEL_ESTUDIOS EDAD
## Length :81527 Min. :3.283e+03 Length :81527 Min. : 2.0
## N.unique : 2 1st Qu.:1.689e+06 N.unique : 8 1st Qu.: 32.0
## N.blank : 0 Median :3.500e+06 N.blank : 0 Median : 41.0
## Min.nchar: 1 Mean :1.337e+07 Min.nchar: 3 Mean : 43.4
## Max.nchar: 1 3rd Qu.:1.164e+07 Max.nchar: 3 3rd Qu.: 53.0
## Max. :3.300e+10 Max. :219.0
## ESTRATO PORC_ENDTOT_CON_NUEVO_CRED MONTO_TOTAL_OTORGADO
## Min. :0.000 Min. :-1788.74 Min. :1.000e+06
## 1st Qu.:3.000 1st Qu.: 54.69 1st Qu.:1.100e+07
## Median :3.000 Median : 70.21 Median :3.050e+07
## Mean :3.622 Mean : 82.44 Mean :7.812e+07
## 3rd Qu.:5.000 3rd Qu.: 85.35 3rd Qu.:7.550e+07
## Max. :6.000 Max. :75002.97 Max. :1.120e+11head(creditos_final, 5)## SEXO INGRESOS_DECLARADOS_TOTA NIVEL_ESTUDIOS EDAD ESTRATO
## Cliente_1 H 15000000 PRF 34 6
## Cliente_2 H 7800000 PRF 28 5
## Cliente_3 H 13910000 PRF 34 3
## Cliente_4 M 956000 TEC 42 3
## Cliente_5 H 8000000 PRF 59 3
## PORC_ENDTOT_CON_NUEVO_CRED MONTO_TOTAL_OTORGADO
## Cliente_1 65.61 365000000
## Cliente_2 68.56 188000000
## Cliente_3 66.05 70000000
## Cliente_4 41.32 5500000
## Cliente_5 80.12 147600000Se conformó una base de trabajo final con 81.527 registros y 7 variables. La base original constaba de 81.536 registros y 21 variables, de la cual se seleccionaron 7 variables cuantitativas y cualitativas relevantes para explicar el monto total otorgado y analizar la distribución de ingresos (SEXO, INGRESOS_DECLARADOS_TOTA, NIVEL_ESTUDIOS, EDAD, ESTRATO, PORC_ENDTOT_CON_NUEVO_CRED y MONTO_TOTAL_OTORGADO).
Durante el proceso de depuración, se descartó la variable SCORE_ACIERTA por presentar 21.539 valores perdidos (26.42%); incluirla hubiera significado descartar más de un cuarto de la muestra sin justificación clara, siendo además una variable prescindible para el objetivo del estudio. Tras este filtro, la pérdida total de observaciones fue de solo 9 registros (0.01%), correspondientes a clientes con datos faltantes en la variable ESTRATO. La muestra final conserva el 99.99% de la base original, asignando a cada cliente un identificador único (Cliente_1, Cliente_2, …) como nombre de fila para garantizar la trazabilidad en los análisis posteriores.
PUNTO 2: ANÁLISIS EXPLORATORIO DE LOS DATOS
PUNTO 2a: FRECUENCIAS RELATIVAS - GÉNERO
# Verificar la codificación de SEXO
table(creditos_final$SEXO)##
## H M
## 50171 31356# Frecuencias absolutas y relativas
freq_sexo <- table(creditos_final$SEXO)
freq_rel_sexo <- prop.table(freq_sexo)
# Tabla presentable
tabla_sexo <- data.frame(
Genero = names(freq_sexo),
Frecuencia = as.numeric(freq_sexo),
Frecuencia_Relativa = round(as.numeric(freq_rel_sexo), 4),
Porcentaje = round(as.numeric(freq_rel_sexo) * 100, 2)
)
print(tabla_sexo)## Genero Frecuencia Frecuencia_Relativa Porcentaje
## 1 H 50171 0.6154 61.54
## 2 M 31356 0.3846 38.46# Alternativa con márgenes
tabla_sexo_completa <- addmargins(freq_rel_sexo)
print(round(tabla_sexo_completa, 4))##
## H M Sum
## 0.6154 0.3846 1.0000La distribución por género muestra un claro predominio masculino que refleja la estructura de la cartera del banco: el 61.54% de los clientes son hombres (50.171) y el 38.46% son mujeres (31.356), lo que equivale a una razón aproximada de 1.6 hombres por cada mujer. Esta composición condiciona las comparaciones posteriores; sin embargo, aunque el grupo femenino es menor en términos relativos, su tamaño en términos absolutos (más de 31.000 observaciones) es suficientemente grande para garantizar un poder estadístico elevado y realizar inferencias muy robustas en las pruebas de hipótesis.
PUNTO 2b: NIVEL EDUCATIVO POR GÉNERO
# Verificar los niveles educativos
table(creditos_final$NIVEL_ESTUDIOS)##
## BAS DOC MED NOG POS PRF TEC UNV
## 7850 768 10126 3646 9184 18323 9157 22473# Tabla de frecuencias absolutas cruzadas
tabla_educ_sexo <- table(creditos_final$NIVEL_ESTUDIOS, creditos_final$SEXO)
print(tabla_educ_sexo)##
## H M
## BAS 5560 2290
## DOC 549 219
## MED 8059 2067
## NOG 2225 1421
## POS 5589 3595
## PRF 11036 7287
## TEC 5078 4079
## UNV 12075 10398# Tabla de frecuencias relativas por género (por columna)
tabla_rel_por_genero <- prop.table(tabla_educ_sexo, margin = 2)
print(round(tabla_rel_por_genero, 4))##
## H M
## BAS 0.1108 0.0730
## DOC 0.0109 0.0070
## MED 0.1606 0.0659
## NOG 0.0443 0.0453
## POS 0.1114 0.1147
## PRF 0.2200 0.2324
## TEC 0.1012 0.1301
## UNV 0.2407 0.3316# Tabla con porcentajes
tabla_educ_sexo_pct <- round(prop.table(tabla_educ_sexo, margin = 2) * 100, 2)
print(tabla_educ_sexo_pct)##
## H M
## BAS 11.08 7.30
## DOC 1.09 0.70
## MED 16.06 6.59
## NOG 4.43 4.53
## POS 11.14 11.47
## PRF 22.00 23.24
## TEC 10.12 13.01
## UNV 24.07 33.16# Tabla de frecuencias relativas global
tabla_rel_global <- prop.table(tabla_educ_sexo)
print(round(tabla_rel_global, 4))##
## H M
## BAS 0.0682 0.0281
## DOC 0.0067 0.0027
## MED 0.0989 0.0254
## NOG 0.0273 0.0174
## POS 0.0686 0.0441
## PRF 0.1354 0.0894
## TEC 0.0623 0.0500
## UNV 0.1481 0.1275# GRÁFICO 1: Barras agrupadas (frecuencias absolutas)
barplot(tabla_educ_sexo,
beside = TRUE,
col = c("steelblue", "salmon", "lightgreen", "orange",
"purple", "pink", "brown", "gray"),
legend.text = rownames(tabla_educ_sexo),
args.legend = list(x = "topright", cex = 0.6),
main = "Nivel educativo por género",
xlab = "Género",
ylab = "Frecuencia absoluta")
# GRÁFICO 2: Barras con proporciones por género
barplot(tabla_rel_por_genero,
beside = TRUE,
col = c("steelblue", "salmon", "lightgreen", "orange",
"purple", "pink", "brown", "gray"),
legend.text = rownames(tabla_rel_por_genero),
args.legend = list(x = "topright", cex = 0.6),
main = "Distribución relativa del nivel educativo por género",
xlab = "Género",
ylab = "Proporción")
Se observan diferencias notables en la composición educativa por género:
Gráficos absolutos: Los hombres dominan en casi todas las categorías debido a su mayor volumen general. La categoría con mayor número de clientes para ambos géneros es UNV (Pregrado completo: ~12.075 hombres y ~10.398 mujeres).
Gráficos proporcionales: Revelan que las mujeres presentan un perfil educativo relativamente más alto. Una de cada tres mujeres tiene pregrado completo (UNV: 33.16% vs. 24.07% en hombres) y una mayor proporción en formación técnica (TEC: 13.01% vs. 10.12%). En contraste, los hombres se concentran en mayor proporción en niveles básicos como bachillerato (MED: 16.06% vs. 6.59%) y básica primaria (BAS: 11.08% vs. 7.30%). En el nivel de posgrado (POS y DOC), las brechas son reducidas, aunque ligeramente favorables a las mujeres en especializaciones y maestrías (11.47% vs. 11.14%). En síntesis, dentro de esta cartera, el segmento femenino está más educado en términos relativos.
PUNTO 2c: INGRESOS POR GÉNERO
# Ver niveles de SEXO
niveles_sexo <- levels(factor(creditos_final$SEXO))
print(niveles_sexo)## [1] "H" "M"# Separar ingresos por género
ingresos_g1 <- creditos_final$INGRESOS_DECLARADOS_TOTA[creditos_final$SEXO == niveles_sexo[1]]
ingresos_g2 <- creditos_final$INGRESOS_DECLARADOS_TOTA[creditos_final$SEXO == niveles_sexo[2]]# HISTOGRAMA: Ingresos género 1
hist(ingresos_g1,
breaks = 30,
col = "steelblue",
main = paste("Ingresos -", niveles_sexo[1]),
xlab = "Ingresos declarados",
ylab = "Frecuencia")
# HISTOGRAMA: Ingresos género 2
hist(ingresos_g2,
breaks = 30,
col = "salmon",
main = paste("Ingresos -", niveles_sexo[2]),
xlab = "Ingresos declarados",
ylab = "Frecuencia")
Ambas distribuciones de ingresos presentan una marcada asimetría positiva (sesgada a la derecha). La inmensa mayoría de los clientes se agrupa en el rango de ingresos bajos, extendiéndose una larga cola hacia valores extremadamente altos (hasta 333.000 millones de pesos). Este comportamiento típico justifica el uso de medianas o transformaciones logarítmicas sobre la media.
# DIAGRAMA DE CAJA: Ingresos por género
boxplot(INGRESOS_DECLARADOS_TOTA ~ SEXO,
data = creditos_final,
col = c("steelblue", "salmon"),
main = "Distribución de ingresos por género",
xlab = "Género",
ylab = "Ingresos declarados")
La caja central de ambos géneros aparece fuertemente comprimida cerca del origen por la magnitud de los valores atípicos. Los hombres muestran una mediana de ingresos superior (~$3.93M vs. ~$3.10M en mujeres). En ambos grupos se evidencian numerosos outliers, destacando un caso extremo en el grupo masculino de \(3.3 \times 10^{10}\).
# RESUMEN NUMÉRICO por grupo
aggregate(INGRESOS_DECLARADOS_TOTA ~ SEXO,
data = creditos_final,
FUN = function(x) c(
n = length(x),
media = mean(x),
mediana = median(x),
sd = sd(x),
min = min(x),
max = max(x)
))## SEXO INGRESOS_DECLARADOS_TOTA.n INGRESOS_DECLARADOS_TOTA.media
## 1 H 50171 15633658
## 2 M 31356 9751306
## INGRESOS_DECLARADOS_TOTA.mediana INGRESOS_DECLARADOS_TOTA.sd
## 1 3927571 179957105
## 2 3100000 183617637
## INGRESOS_DECLARADOS_TOTA.min INGRESOS_DECLARADOS_TOTA.max
## 1 3283 33000000000
## 2 16482 23500000000La brecha de ingresos en las medias es de ~$5.88 millones ($15.63M en hombres vs. $9.75M en mujeres), mientras que en las medianas la diferencia es de ~$0.83 millones ($3.93M vs. $3.10M). La gran divergencia entre ambas métricas indica que la brecha salarial se acentúa significativamente en la parte alta de la distribución (cola derecha), donde hay hombres con ingresos excepcionalmente altos que jalan la media hacia arriba, mientras que en el “cliente típico” (mediana) la diferencia es más moderada.
PUNTO 2d: PRUEBAS DE HIPÓTESIS
DIFERENCIA DE INGRESOS (brecha salarial)
H0: media ingresos hombres = media ingresos mujeres
H1: media ingresos hombres != media ingresos mujeres
test_ingresos <- t.test(INGRESOS_DECLARADOS_TOTA ~ SEXO,
data = creditos_final,
var.equal = FALSE)
print(test_ingresos)##
## Welch Two Sample t-test
##
## data: INGRESOS_DECLARADOS_TOTA by SEXO
## t = 4.4843, df = 65539, p-value = 7.328e-06
## alternative hypothesis: true difference in means between group H and group M is not equal to 0
## 95 percent confidence interval:
## 3311290 8453414
## sample estimates:
## mean in group H mean in group M
## 15633658 9751306Diferencia de Ingresos (Brecha Salarial - Welch t-test)Estadístico: \(t = 4.4843\), \(gl = 65.539\), \(p\text{-valor} = 7.328 \times 10^{-6}\) (\(p < 0.05\)).IC 95%: [$3.311.290 ; \(8.453.414].Conclusión: Se rechaza la hipótesis nula (\)H_0$). Existe evidencia estadística significativa de una brecha de ingresos a favor de los hombres de ~$5.88 millones en promedio.
DIFERENCIA DE ESTRATO
test_estrato <- t.test(ESTRATO ~ SEXO,
data = creditos_final,
var.equal = FALSE)
print(test_estrato)##
## Welch Two Sample t-test
##
## data: ESTRATO by SEXO
## t = -2.8378, df = 72196, p-value = 0.004544
## alternative hypothesis: true difference in means between group H and group M is not equal to 0
## 95 percent confidence interval:
## -0.047201123 -0.008635729
## sample estimates:
## mean in group H mean in group M
## 3.611608 3.639527Diferencia de Estrato Socioeconómico (Welch t-test)Estadístico: \(t = -2.8378\), \(gl = 72.196\), \(p\text{-valor} = 0.004544\) (\(p < 0.05\)).IC 95%: [-0.047 ; -0.009]. Medias: \(H = 3.6116\) | \(M = 3.6395\).Conclusión: Se rechaza \(H_0\). Las mujeres presentan un estrato estadísticamente mayor, pero la magnitud de la diferencia (0.028 puntos) es irrelevante en la práctica, indicando que provienen de contextos socioeconómicos equivalentes.
ASOCIACIÓN NIVEL EDUCATIVO vs GÉNERO (Chi-cuadrado)
test_educ <- chisq.test(tabla_educ_sexo)
print(test_educ)##
## Pearson's Chi-squared test
##
## data: tabla_educ_sexo
## X-squared = 2449.4, df = 7, p-value < 2.2e-16cat("\nMedias de ingreso por género:\n")##
## Medias de ingreso por género:print(tapply(creditos_final$INGRESOS_DECLARADOS_TOTA,
creditos_final$SEXO, mean))## H M
## 15633658 9751306cat("\nMedias de estrato por género:\n")##
## Medias de estrato por género:print(tapply(creditos_final$ESTRATO,
creditos_final$SEXO, mean))## H M
## 3.611608 3.639527Prueba Chi-cuadrado (Nivel Educativo vs. Género)Estadístico: \(\chi^2 = 2449.4\), \(gl = 7\), \(p\text{-valor} < 2.2 \times 10^{-16}\) (\(p < 0.05\)).Conclusión: Se rechaza \(H_0\). Existe una asociación altamente significativa entre el género y el nivel educativo.
¿Parece haber diferencias en el nivel educativo y el estrato entre hombres y mujeres?Sí, se confirman diferencias. En nivel educativo, existe una asociación estadísticamente significativa (\(\chi^2 = 2449.4, p < 0.001\)), donde las mujeres alcanzan mayores proporciones en niveles universitarios y técnicos (UNV: 33.16% vs. 24.07%; TEC: 13.01% vs. 10.12%), mientras que los hombres pesan más en educación secundaria y primaria (MED: 16.06% vs. 6.59%; BAS: 11.08% vs. 7.30%). En estrato, la diferencia es estadísticamente significativa (\(p = 0.0045\)), pero la magnitud (3.64 en mujeres vs. 3.61 en hombres) es insignificante en la práctica, concluyendo que provienen de estratos similares.¿Existe algún indicio de una brecha salarial entre hombres y mujeres?Sí, existe un indicio claro. La prueba \(t\) confirma una brecha promedio estadísticamente significativa (\(p < 0.001\)) de aproximadamente $5.88 millones de pesos a favor de los hombres, si bien la brecha en medianas ($3.93M vs. $3.10M) demuestra que el sesgo es mayor en la cola superior de ingresos. Dado que las mujeres poseen en promedio un nivel educativo superior, la brecha salarial observada no puede ser explicada por el capital humano, lo cual sugiere posibles factores no observados (como tipo de empleo, sector económico, horas trabajadas o brechas de género en cargos ejecutivos).
PUNTO 2e: MATRIZ DE CORRELACIÓN Y DISPERSOGRAMAS
# Variables numéricas
vars_numericas <- c("INGRESOS_DECLARADOS_TOTA",
"EDAD",
"ESTRATO",
"PORC_ENDTOT_CON_NUEVO_CRED",
"MONTO_TOTAL_OTORGADO")
datos_num <- creditos_final[, vars_numericas]
# Matriz de correlación (Pearson)
matriz_cor <- cor(datos_num, use = "complete.obs")
print(round(matriz_cor, 3))## INGRESOS_DECLARADOS_TOTA EDAD ESTRATO
## INGRESOS_DECLARADOS_TOTA 1.000 0.031 0.069
## EDAD 0.031 1.000 0.212
## ESTRATO 0.069 0.212 1.000
## PORC_ENDTOT_CON_NUEVO_CRED 0.001 0.013 0.015
## MONTO_TOTAL_OTORGADO 0.036 0.056 0.133
## PORC_ENDTOT_CON_NUEVO_CRED MONTO_TOTAL_OTORGADO
## INGRESOS_DECLARADOS_TOTA 0.001 0.036
## EDAD 0.013 0.056
## ESTRATO 0.015 0.133
## PORC_ENDTOT_CON_NUEVO_CRED 1.000 0.298
## MONTO_TOTAL_OTORGADO 0.298 1.000Todas las correlaciones entre las variables analizadas son débiles (\(\vert{}r\vert{} < 0.3\)). La asociación lineal más alta se presenta entre PORC_ENDTOT_CON_NUEVO_CRED y MONTO_TOTAL_OTORGADO (\(r = 0.298\)), la cual es positiva y de intensidad moderada-baja, reflejando una lógica financiera esperada: a mayor nivel de endeudamiento asumido, mayor es el monto del crédito otorgado. Le siguen la relación entre ESTRATO y MONTO_TOTAL_OTORGADO (\(r = 0.133\)) y entre EDAD y ESTRATO (\(r = 0.212\)).Resulta contraintuitivo que la correlación entre INGRESOS y MONTO_TOTAL_OTORGADO sea prácticamente nula (\(r = 0.036\)), sugiriendo que el monto del crédito no guarda una relación lineal directa con los ingresos declarados (pudiendo depender de variables no contempladas como políticas internas del banco, tipos de producto o garantías).
# DISPERSOGRAMAS
pairs(datos_num,
main = "Matriz de dispersión - Variables del análisis",
pch = 20,
col = rgb(0, 0, 1, 0.3),
cex = 0.5)
Los dispersogramas confirman la ausencia de patrones lineales definidos y muestran nubes de puntos comprimidas en el origen con una fuerte presencia de valores atípicos extremos, lo que justifica plenamente la necesidad de aplicar una estandarización previa antes de realizar el Análisis de Componentes Principales (ACP).
PUNTO 3: ANÁLISIS DE COMPONENTES PRINCIPALES
Preparar la matriz de datos numéricos
# Solo variables numéricas (sin SCORE_ACIERTA, que fue excluida)
datos_acp <- creditos_final[, c(
"INGRESOS_DECLARADOS_TOTA",
"EDAD",
"ESTRATO",
"PORC_ENDTOT_CON_NUEVO_CRED",
"MONTO_TOTAL_OTORGADO"
)]
# Estandarizar (media 0, sd 1) — necesario porque las variables están en escalas muy distintas
datos_acp <- scale(datos_acp)
# Verificación de la estandarización
data.frame(
Variable = colnames(datos_acp),
Media = round(colMeans(datos_acp), 10),
Desviacion = round(apply(datos_acp, 2, sd), 4),
row.names = NULL
)## Variable Media Desviacion
## 1 INGRESOS_DECLARADOS_TOTA 0 1
## 2 EDAD 0 1
## 3 ESTRATO 0 1
## 4 PORC_ENDTOT_CON_NUEVO_CRED 0 1
## 5 MONTO_TOTAL_OTORGADO 0 1Para el ACP se utilizaron las 5 variables numéricas disponibles en la base depurada: ingresos, edad, estrato, porcentaje de endeudamiento y monto otorgado. No se incluyó la variable SCORE_ACIERTA porque fue excluida en el punto 1 debido a su alto porcentaje de datos faltantes (26.42%). Las variables SEXO y NIVEL_ESTUDIOS tampoco se incluyen porque el ACP requiere variables numéricas.
PUNTO 3a: VARIABILIDAD RETENIDA
# Ajustar el ACP con princomp (como en clase)
pc <- princomp(datos_acp)
# Resumen: varianza explicada por cada componente
summary(pc)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.1783757 1.0769702 0.9909944 0.8908389 0.8220952
## Proportion of Variance 0.2777173 0.2319758 0.1964164 0.1587207 0.1351698
## Cumulative Proportion 0.2777173 0.5096931 0.7061095 0.8648302 1.0000000# Tabla de variabilidad
varianza_explicada <- summary(pc)$sdev^2 / sum(summary(pc)$sdev^2)
tabla_varianza <- data.frame(
Componente = paste0("CP", 1:length(varianza_explicada)),
`% Varianza Explicada` = round(varianza_explicada * 100, 1),
`% Varianza Acumulada` = round(cumsum(varianza_explicada) * 100, 1),
check.names = FALSE
)
print(tabla_varianza)## Componente % Varianza Explicada % Varianza Acumulada
## Comp.1 CP1 27.8 27.8
## Comp.2 CP2 23.2 51.0
## Comp.3 CP3 19.6 70.6
## Comp.4 CP4 15.9 86.5
## Comp.5 CP5 13.5 100.0El primer componente (CP1) explica el 27.8% de la variabilidad total, el segundo (CP2) el 23.2%, el tercero (CP3) el 19.6%, el cuarto (CP4) el 15.9% y el quinto (CP5) el 13.5%. La varianza está muy repartida entre las cinco componentes, sin que ninguna domine claramente. Esto es coherente con las correlaciones débiles que se encontraron en el punto 2e: cuando las variables no están fuertemente correlacionadas, el ACP no puede concentrar la información en pocas dimensiones.
PUNTO 3b: NÚMERO DE COMPONENTES
var_acum <- cumsum(varianza_explicada)
cp_80 <- which(var_acum >= 0.80)[1]
cp_90 <- which(var_acum >= 0.90)[1]
tabla_componentes <- data.frame(
Umbral = c("80%", "90%"),
Componentes_Necesarios = c(cp_80, cp_90),
Varianza_Acumulada_Pct = c(
round(var_acum[cp_80] * 100, 1),
round(var_acum[cp_90] * 100, 1)
),
row.names = NULL
)
print(tabla_componentes)## Umbral Componentes_Necesarios Varianza_Acumulada_Pct
## 1 80% 4 86.5
## 2 90% 5 100.0Para superar el 80% de variabilidad se necesitan 4 componentes (acumulan 86.5%).
Para superar el 90% se necesitan los 5 componentes (acumulan 100%).
Como solo hay 5 variables originales, el ACP no logra reducir la dimensionalidad de forma efectiva: se requieren casi todas las componentes para representar bien los datos. Esto confirma que las variables aportan información relativamente independiente entre sí.
PUNTO 3c: CARGAS DE CP1 Y CP2
cargas <- loadings(pc) # matriz de cargas (equivalente a pc$loadings)
tabla_cargas <- data.frame(
Variable = c("Ingresos", "Edad", "Estrato", "% Endeudamiento", "Monto otorgado"),
CP1 = round(cargas[, 1], 3),
CP2 = round(cargas[, 2], 3)
)
print(tabla_cargas)## Variable CP1 CP2
## INGRESOS_DECLARADOS_TOTA Ingresos 0.169 0.242
## EDAD Edad 0.371 0.544
## ESTRATO Estrato 0.461 0.497
## PORC_ENDTOT_CON_NUEVO_CRED % Endeudamiento 0.499 -0.534
## MONTO_TOTAL_OTORGADO Monto otorgado 0.610 -0.337CP1: todas las cargas son positivas, lo que indica que este componente captura un “tamaño económico global” del cliente: a mayor CP1, mayor monto otorgado, mayor endeudamiento, mayor estrato, mayor edad e ingresos. La variable más influyente es Monto otorgado (0.610).
CP2: muestra un contraste entre dos grupos de variables. Las que cargan positivo son Edad (0.544), Estrato (0.497) e Ingresos (0.242); las que cargan negativo son % Endeudamiento (-0.534) y Monto otorgado (-0.337). Es decir, CP2 separa a los clientes mayores y de estrato alto de los clientes más endeudados con montos altos.
PUNTO 3d: VARIABLES CON MAYOR IMPACTO
Ordenadas por impacto en CP1
tabla_cp1 <- data.frame(
Variable = tabla_cargas$Variable,
Carga_CP1 = tabla_cargas$CP1,
Impacto = abs(tabla_cargas$CP1)
)
tabla_cp1 <- tabla_cp1[order(-tabla_cp1$Impacto), c("Variable", "Carga_CP1")]
rownames(tabla_cp1) <- NULL
names(tabla_cp1)[2] <- "Carga en CP1"
print(tabla_cp1)## Variable Carga en CP1
## 1 Monto otorgado 0.610
## 2 % Endeudamiento 0.499
## 3 Estrato 0.461
## 4 Edad 0.371
## 5 Ingresos 0.169CP1 — ordenadas por impacto:
Variable Carga en CP1
Monto otorgado 0.610
% Endeudamiento 0.499
Estrato 0.461
Edad 0.371
Ingresos 0.169
Ordenadas por impacto en CP2
tabla_cp2 <- data.frame(
Variable = tabla_cargas$Variable,
Carga_CP2 = tabla_cargas$CP2,
Impacto = abs(tabla_cargas$CP2)
)
tabla_cp2 <- tabla_cp2[order(-tabla_cp2$Impacto), c("Variable", "Carga_CP2")]
rownames(tabla_cp2) <- NULL
names(tabla_cp2)[2] <- "Carga en CP2"
print(tabla_cp2)## Variable Carga en CP2
## 1 Edad 0.544
## 2 % Endeudamiento -0.534
## 3 Estrato 0.497
## 4 Monto otorgado -0.337
## 5 Ingresos 0.242Variable Carga en CP2
Edad 0.544
% Endeudamiento -0.534
Estrato 0.497
Monto otorgado -0.337
Ingresos 0.242
En CP1 las variables dominantes son Monto otorgado, % Endeudamiento y Estrato. En CP2 las dominantes son Edad, % Endeudamiento y Estrato. Llama la atención que Ingresos es la variable con menor contribución en ambos componentes, lo que sugiere que su relación lineal con el resto de variables del análisis es débil (coherente con la correlación de 0.036 observada en el punto 2e).
PUNTO 3e: BI-PLOT
set.seed(123)
n_muestra <- 3000
idx <- sample(1:nrow(datos_acp), n_muestra)
scores <- pc$scores[idx, 1:2]
cargas_plot <- cargas[, 1:2]
# Recortar outliers de los scores (percentiles 1% y 99%)
lim_cp1 <- quantile(scores[,1], c(0.01, 0.99))
lim_cp2 <- quantile(scores[,2], c(0.01, 0.99))
# Escalar cargas al rango de los scores
escala <- 0.8 * min(
max(abs(lim_cp1)) / max(abs(cargas_plot[, 1])),
max(abs(lim_cp2)) / max(abs(cargas_plot[, 2]))
)
cargas_plot <- cargas_plot * escala
# Gráfico
plot(scores,
type = "n",
xlab = paste0("CP1 (", round(varianza_explicada[1]*100, 1), "%)"),
ylab = paste0("CP2 (", round(varianza_explicada[2]*100, 1), "%)"),
main = "Bi-plot ACP - Clientes y variables",
xlim = lim_cp1,
ylim = lim_cp2)
# Puntos
points(scores, pch = 20, col = rgb(0, 0, 1, 0.2), cex = 0.6)
# Flechas
arrows(0, 0, cargas_plot[,1], cargas_plot[,2],
col = "red", length = 0.1, lwd = 2)
# Etiquetas
text(cargas_plot[,1] * 1.1, cargas_plot[,2] * 1.1,
labels = c("Ingresos", "Edad", "Estrato", "% Endeud", "Monto"),
col = "red", cex = 0.9, font = 2)
abline(h = 0, v = 0, lty = 2, col = "gray60")
El bi-plot representa simultáneamente los clientes (puntos azules) y las variables (flechas rojas) en el plano CP1-CP2:
CP1 ordena a los clientes por tamaño económico: a mayor CP1, mayor monto, ingresos, edad y estrato.
CP2 separa dos perfiles de cliente: hacia arriba quedan los clientes con mayor edad, estrato e ingresos; hacia abajo, los clientes con mayor % de endeudamiento y montos otorgados más altos.
La nube de clientes se concentra en torno al origen con una cola hacia la esquina superior derecha (clientes con valores altos en ambas componentes).
Las flechas confirman la oposición entre el perfil socioeconómico (Ingresos, Edad, Estrato) y el perfil crediticio (Monto, % Endeudamiento) en el eje CP2.
Como las dos primeras componentes explican en conjunto solo el 51% de la variabilidad, la representación en dos dimensiones no captura toda la estructura de los datos; se trata de una visualización útil pero parcial, lo cual es coherente con la dispersión de la información observada en 3a.
PUNTO 4: MODELAMIENTO
4.1 Transformación logarítmica
# Se aplica log a las variables monetarias por su fuerte asimetría
creditos_final$LOG_MONTO <- log(creditos_final$MONTO_TOTAL_OTORGADO)
creditos_final$LOG_INGRESOS <- log(creditos_final$INGRESOS_DECLARADOS_TOTA)
# Verificar que no haya problemas (log de 0 o negativos)
sum(is.infinite(creditos_final$LOG_MONTO))## [1] 0sum(is.infinite(creditos_final$LOG_INGRESOS))## [1] 0Se aplicó una transformación logarítmica a las variables monetarias MONTO_TOTAL_OTORGADO e INGRESOS_DECLARADOS_TOTA. Esta decisión se fundamenta en la fuerte asimetría positiva que evidenciaron los histogramas y diagramas de caja del punto 2c: la mayoría de los clientes se concentra en valores bajos, mientras que una cola muy larga se extiende hacia montos e ingresos extremadamente altos (hasta 3.3×10¹⁰). La regresión lineal asume normalidad de residuos y varianza constante, supuestos que se violan con variables tan asimétricas. La transformación logarítmica estabiliza la varianza, reduce el efecto de los valores extremos y aproxima la distribución a la normalidad. Adicionalmente, cuando tanto la variable dependiente como una predictora están en logaritmo, el coeficiente se interpreta como una elasticidad (cambio porcentual en Y ante un cambio del 1% en X), lo cual resulta muy útil en análisis financieros. Se verificó que no hubiera valores infinitos (log de cero o negativos) antes de continuar.
4.2 Modelo de regresión lineal múltiple
modelo <- lm(LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO +
PORC_ENDTOT_CON_NUEVO_CRED + SEXO + NIVEL_ESTUDIOS,
data = creditos_final)
# Resumen del modelo
summary(modelo)##
## Call:
## lm(formula = LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO + PORC_ENDTOT_CON_NUEVO_CRED +
## SEXO + NIVEL_ESTUDIOS, data = creditos_final)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.6079 -0.7244 0.1761 0.7346 5.0551
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.309e+00 5.770e-02 74.677 < 2e-16 ***
## LOG_INGRESOS 8.035e-01 4.287e-03 187.425 < 2e-16 ***
## EDAD 1.498e-02 2.812e-04 53.265 < 2e-16 ***
## ESTRATO -7.741e-02 3.829e-03 -20.215 < 2e-16 ***
## PORC_ENDTOT_CON_NUEVO_CRED 1.377e-04 9.424e-06 14.614 < 2e-16 ***
## SEXOM -8.856e-02 7.693e-03 -11.512 < 2e-16 ***
## NIVEL_ESTUDIOSDOC 3.393e-01 3.972e-02 8.542 < 2e-16 ***
## NIVEL_ESTUDIOSMED 5.943e-01 1.546e-02 38.435 < 2e-16 ***
## NIVEL_ESTUDIOSNOG 5.956e-03 2.078e-02 0.287 0.774
## NIVEL_ESTUDIOSPOS 3.796e-01 1.725e-02 22.013 < 2e-16 ***
## NIVEL_ESTUDIOSPRF 1.180e-01 1.571e-02 7.509 6.01e-14 ***
## NIVEL_ESTUDIOSTEC 8.518e-02 1.597e-02 5.335 9.59e-08 ***
## NIVEL_ESTUDIOSUNV 6.887e-02 1.433e-02 4.808 1.53e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.026 on 81514 degrees of freedom
## Multiple R-squared: 0.512, Adjusted R-squared: 0.5119
## F-statistic: 7127 on 12 and 81514 DF, p-value: < 2.2e-16El modelo completo resultó globalmente significativo (F = 7127, p < 2.2e-16), lo que indica que al menos una de las variables predictoras tiene efecto sobre el log del monto otorgado. El R² = 0.512 señala que el modelo explica el 51.2% de la variabilidad del log del monto, un ajuste moderado-bueno para datos financieros reales, donde existe mucha variabilidad no explicada por factores no observados.
Respecto a los coeficientes:
LOG_INGRESOS (0.8035): la variable más influyente. Un aumento del 1% en los ingresos se asocia con un aumento del 0.80% en el monto otorgado. Relación positiva fuerte y altamente significativa.
EDAD (0.01498): por cada año adicional de edad, el monto otorgado aumenta aproximadamente un 1.5%, manteniendo todo lo demás constante.
ESTRATO (-0.07741): resultado contraintuitivo. A mayor estrato, menor monto otorgado (≈ 7.4% menos por punto de estrato). Posiblemente refleja que el estrato captura efectos que se solapan con otras variables del modelo.
PORC_ENDTOT (0.0001377): efecto positivo pero de magnitud prácticamente despreciable.
SEXOM (-0.0886): las mujeres reciben, en promedio, un monto ≈ 8.5% menor que los hombres, controlando por ingresos, edad, estrato y nivel educativo. Esto confirma la brecha de género detectada en el punto 2d.
NIVEL_ESTUDIOS: en general, mayores niveles educativos se asocian con mayores montos. Sin embargo, NIVEL_ESTUDIOSMED presenta un coeficiente inusualmente alto (0.594), superior al de DOC y POS, lo que sugiere alguna particularidad de ese segmento que no se captura con las demás variables.
4.3 Diagnóstico de supuestos
plot(modelo, which = 1) # Residuals vs Fitted
Residuals vs Fitted: la nube de residuos se distribuye alrededor de cero sin un patrón claro, lo que sugiere que la relación lineal es adecuada.
plot(modelo, which = 2) # Normal Q-Q
Normal Q-Q: los residuos siguen aproximadamente la diagonal, aunque con algunas desviaciones en las colas. Esto es esperable en muestras grandes y con variables financieras, y no invalida el modelo.
plot(modelo, which = 3) # Scale-Location
Scale-Location: la línea roja es aproximadamente horizontal, indicando homocedasticidad razonable.
plot(modelo, which = 4) # Residuals vs Leverage
Residuals vs Leverage: se identifican algunas observaciones influyentes, pero ninguna con leverage tan alto como para distorsionar los coeficientes de forma crítica.
En conjunto, los supuestos se cumplen de forma aceptable para los fines del análisis, con las limitaciones propias de trabajar con datos financieros reales.
4.4 Comparación con modelo reducido (opcional)
# Modelo con solo las variables numéricas (sin categóricas)
modelo_reducido <- lm(LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO +
PORC_ENDTOT_CON_NUEVO_CRED,
data = creditos_final)
summary(modelo_reducido)##
## Call:
## lm(formula = LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO + PORC_ENDTOT_CON_NUEVO_CRED,
## data = creditos_final)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.5223 -0.7423 0.1686 0.7929 5.2585
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.258e+00 5.340e-02 79.73 <2e-16 ***
## LOG_INGRESOS 8.157e-01 4.058e-03 201.01 <2e-16 ***
## EDAD 1.711e-02 2.778e-04 61.59 <2e-16 ***
## ESTRATO -1.014e-01 3.695e-03 -27.45 <2e-16 ***
## PORC_ENDTOT_CON_NUEVO_CRED 1.363e-04 9.593e-06 14.21 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.045 on 81522 degrees of freedom
## Multiple R-squared: 0.4943, Adjusted R-squared: 0.4942
## F-statistic: 1.992e+04 on 4 and 81522 DF, p-value: < 2.2e-16# Comparar ambos modelos con ANOVA
anova(modelo_reducido, modelo)## Analysis of Variance Table
##
## Model 1: LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO + PORC_ENDTOT_CON_NUEVO_CRED
## Model 2: LOG_MONTO ~ LOG_INGRESOS + EDAD + ESTRATO + PORC_ENDTOT_CON_NUEVO_CRED +
## SEXO + NIVEL_ESTUDIOS
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 81522 89013
## 2 81514 85891 8 3122.2 370.39 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Se comparó el modelo completo (con SEXO y NIVEL_ESTUDIOS) contra un modelo reducido que solo incluye las 4 variables numéricas. El modelo reducido alcanzó un R² de 0.4943 (R² ajustado de 0.4942), mientras que el modelo completo obtuvo un R² de 0.512 (R² ajustado de 0.5119). El ANOVA de comparación arrojó F = 370.39 con p < 2.2e-16, lo que indica que el modelo completo es significativamente mejor que el reducido. Incluir SEXO y NIVEL_ESTUDIOS mejora el ajuste en aproximadamente 1.8 puntos porcentuales de R², un incremento modesto pero estadísticamente significativo. Se concluye que vale la pena incluir las variables categóricas en el modelo final.
PUNTO 5: CLASIFICACIÓN (CLUSTERING)
# Muestra aleatoria de 10.000 clientes
# Se trabaja con una muestra para agilizar el cómputo del clustering
set.seed(123)
n_muestra <- 10000
idx <- sample(1:nrow(creditos_final), n_muestra)
datos_muestra <- creditos_final[idx, ]El objetivo de este punto es segmentar clientes en grupos homogéneos según sus características, con el fin de identificar perfiles con comportamientos financieros similares. Para ello se emplean dos métodos de clasificación vistos en clase: clustering jerárquico y k-means.
Las variables se estandarizan (media 0, desviación 1) porque están en escalas muy distintas: ingresos en millones, edad en años, estrato en 0-6. Sin estandarizar, las variables con mayor magnitud dominarían las distancias euclídeas y sesgarían los clusters; la estandarización garantiza que todas las variables contribuyan por igual. Para el clustering jerárquico se trabaja con una muestra aleatoria de 10.000 clientes en lugar de los 81.527 registros completos. Esto se debe a que el método requiere calcular una matriz de distancias entre todos los pares de individuos, y con 81.527 registros esa matriz tendría ~6.6 mil millones de celdas, lo que es computacionalmente inviable. La muestra es suficientemente grande para representar la estructura de los datos.
Se aplican ambos métodos de forma complementaria. El jerárquico permite explorar la estructura sin fijar K y comparar distintos linkages (single, average, complete, ward) mediante la correlación cofenética. El k-means, por su parte, es más eficiente con grandes volúmenes de datos y permite ajustar el número óptimo de clusters mediante el método del codo (WSS) y el porcentaje de varianza explicada. Usar los dos enfoques permite validar la solución desde dos perspectivas.
Finalmente, se utilizan únicamente variables numéricas para construir los clusters, porque los métodos vistos en clase se basan en distancias euclídeas, que solo tienen sentido con variables de este tipo. Las variables categóricas (SEXO y NIVEL_ESTUDIOS) se reservan para la caracterización de los clusters una vez construidos, no para su formación.
5.1 Preparar matriz de variables numéricas
datos_clust <- datos_muestra[, c(
"INGRESOS_DECLARADOS_TOTA",
"EDAD",
"ESTRATO",
"PORC_ENDTOT_CON_NUEVO_CRED",
"MONTO_TOTAL_OTORGADO"
)]
# Estandarizar
datos_clust <- scale(datos_clust)
# Verificación
data.frame(
Variable = colnames(datos_clust),
Media = round(colMeans(datos_clust), 10),
Desviacion = round(apply(datos_clust, 2, sd), 4),
row.names = NULL
)## Variable Media Desviacion
## 1 INGRESOS_DECLARADOS_TOTA 0 1
## 2 EDAD 0 1
## 3 ESTRATO 0 1
## 4 PORC_ENDTOT_CON_NUEVO_CRED 0 1
## 5 MONTO_TOTAL_OTORGADO 0 1Se trabajó con una muestra aleatoria de 10.000 clientes para agilizar el cómputo del clustering (con 81.527 registros, la matriz de distancias sería computacionalmente inviable). Se utilizaron las 5 variables numéricas disponibles: ingresos, edad, estrato, porcentaje de endeudamiento y monto otorgado. Todas fueron estandarizadas (media 0, desviación 1) para que contribuyeran por igual al cálculo de distancias, ya que estaban en escalas muy distintas. La tabla de verificación confirma que la estandarización fue exitosa.
5.2 Clustering jerárquico
dm <- dist(datos_clust, method = "euclidean")
fit_sing <- hclust(dm, method = "single")
fit_aver <- hclust(dm, method = "average")
fit_comp <- hclust(dm, method = "complete")
fit_ward <- hclust(dm, method = "ward.D")
# Correlación cofenética
data.frame(
Metodo = c("Single", "Average", "Complete", "Ward"),
Correlacion_Cofenetica = round(c(
cor(dm, cophenetic(fit_sing)),
cor(dm, cophenetic(fit_aver)),
cor(dm, cophenetic(fit_comp)),
cor(dm, cophenetic(fit_ward))
), 3)
)## Metodo Correlacion_Cofenetica
## 1 Single 0.800
## 2 Average 0.929
## 3 Complete 0.802
## 4 Ward 0.209# Dendrograma con el mejor método (Average)
plot(fit_aver,
hang = -1,
cex = 0.3,
labels = FALSE,
main = "Dendrograma - Clustering jerarquico (Average)")
Se calcularon las distancias euclídeas entre los 10.000 clientes y se probaron los 4 métodos de linkage vistos en clase. La correlación cofenética (que mide qué tan bien el dendrograma reproduce las distancias originales) arrojó:
Single: 0.800
Average: 0.929
Complete: 0.802
Ward: 0.209
El método Average obtuvo la mayor correlación cofenética (0.929), lo que indica que su dendrograma representa fielmente la estructura de similitud entre los clientes. Los métodos Single y Complete mostraron valores similares entre sí (0.800 y 0.802), mientras que Ward presentó la correlación más baja (0.209), descartándose por no reflejar adecuadamente las distancias euclídeas originales. Por lo tanto, el dendrograma se construyó con el método Average, que permite visualizar la estructura jerárquica de los datos con la mejor representación posible de las distancias reales.
NOTA: Aunque el dendrograma de Average presenta ramas poco diferenciadas por la homogeneidad de los datos, su alta correlación cofenética lo convierte en la representación más fiel de las distancias entre clientes.
5.3 K-means: elección de K
pctp <- 0
within <- kmeans(datos_clust, centers = 1)$totss
for (k in 2:10) {
clk <- kmeans(datos_clust, centers = k, nstart = 25)
wi <- sum(clk$withinss)
pcte <- clk$betweenss / clk$totss
pctp <- c(pctp, pcte)
within <- c(within, wi)
}## Warning: Quick-TRANSfer stage steps exceeded maximum (= 500000)data.frame(
K = 1:10,
Varianza_Explicada_Pct = round(pctp * 100, 1),
WGSS = round(within, 0)
)## K Varianza_Explicada_Pct WGSS
## 1 1 0.0 49995
## 2 2 21.3 39338
## 3 3 32.8 33599
## 4 4 42.8 28605
## 5 5 65.0 17475
## 6 6 70.0 15007
## 7 7 73.6 13190
## 8 8 75.3 12328
## 9 9 78.0 10989
## 10 10 79.8 10084plot(1:10, pctp, type = "b", pch = 16, cex = 1.5, lwd = 2,
col = "blue", xlab = "K", ylab = "% variabilidad explicada",
main = "Varianza explicada vs K")
plot(1:10, within, type = "b", pch = 16, cex = 1.5, lwd = 2,
col = "red", xlab = "K", ylab = "WGSS",
main = "WSS vs K (metodo del codo)")
Se evaluó el número óptimo de clusters mediante dos criterios: el porcentaje de varianza explicada y el WSS (método del codo). Los resultados muestran un codo muy claro en K = 5:
K=4 → 42.8% varianza explicada
K=5 → 65.0% (salto de +22.2 puntos)
K=6 → 70.0% (solo +5.0)
A partir de K=5, los incrementos se vuelven marginales. El gráfico del WSS confirma lo mismo: la caída abrupta ocurre entre K=4 y K=5, y luego la curva se aplana. Por lo tanto, se elige K = 5 como número óptimo de clusters.
5.4 K-means con outliers recortados
# Recortar outliers: llevar los valores extremos al percentil 1 y 99
datos_clust_trim <- datos_clust
for (j in 1:ncol(datos_clust_trim)) {
q <- quantile(datos_clust_trim[, j], c(0.01, 0.99))
datos_clust_trim[, j] <- pmin(pmax(datos_clust_trim[, j], q[1]), q[2])
}
# Ajustar k-means
set.seed(123)
k_optimo <- 5
fit_kmeans <- kmeans(datos_clust_trim, centers = k_optimo, nstart = 50)
# Tamaño de los clusters
data.frame(
Cluster = 1:k_optimo,
N = as.numeric(table(fit_kmeans$cluster)),
Porcentaje = round(as.numeric(prop.table(table(fit_kmeans$cluster))) * 100, 1)
)## Cluster N Porcentaje
## 1 1 2169 21.7
## 2 2 1329 13.3
## 3 3 2105 21.0
## 4 4 629 6.3
## 5 5 3768 37.7Antes de ajustar el modelo final se recortaron los outliers (percentiles 1 y 99) para evitar que valores extremos aislaran clientes atípicos en clusters individuales. Sin este ajuste, dos clientes con montos y endeudamientos extremos quedaban solos en su propio cluster, distorsionando la segmentación.
El k-means final con K=5 produjo clusters balanceados:
Cluster N %
1 2.169 21.7%
2 1.329 13.3%
3 2.105 21.0%
4 629 6.3%
5 3.768 37.7%
Ningún cluster tiene un tamaño desproporcionado, lo que indica una segmentación útil y estable.
5.5 Visualización con ACP de datos SIN recortar
# ACP sobre datos originales (sin recorte)
pc_clust <- princomp(datos_clust)
scores_pc <- pc_clust$scores[, 1:2]
# Recortar solo para el gráfico
lim_cp1 <- quantile(scores_pc[,1], c(0.01, 0.99))
lim_cp2 <- quantile(scores_pc[,2], c(0.01, 0.99))
plot(scores_pc, type = "n",
xlab = "CP1", ylab = "CP2",
main = paste("Clusters k-means (K =", k_optimo, ")"),
xlim = lim_cp1,
ylim = lim_cp2)
colores <- c("red", "blue", "green", "orange", "purple")
points(scores_pc,
col = colores[fit_kmeans$cluster],
pch = 20, cex = 0.5)
legend("topright",
legend = paste("Cluster", 1:k_optimo),
col = colores, pch = 20, cex = 0.8)
El gráfico de clusters sobre las dos primeras componentes principales muestra una separación clara entre los cinco grupos. El cluster 5 (morado) se ubica en la zona izquierda (valores bajos de CP1), el cluster 4 (naranja) se extiende hacia la derecha (valores altos de CP1), y los clusters 1, 2 y 3 (rojo, azul y verde) ocupan la zona central con distintos patrones de CP2. La proyección confirma que los clusters capturan diferencias reales en el perfil de los clientes.
PUNTO 6: CARACTERIZACION DE CLUSTERS
# Asignar cluster a la muestra
datos_muestra$CLUSTER <- fit_kmeans$cluster
# Medias por cluster
caracterizacion <- aggregate(
cbind(INGRESOS_DECLARADOS_TOTA, EDAD, ESTRATO,
PORC_ENDTOT_CON_NUEVO_CRED, MONTO_TOTAL_OTORGADO) ~ CLUSTER,
data = datos_muestra,
FUN = mean
)
print(round(caracterizacion, 2))## CLUSTER INGRESOS_DECLARADOS_TOTA EDAD ESTRATO PORC_ENDTOT_CON_NUEVO_CRED
## 1 1 9232371 35.87 4.56 74.89
## 2 2 22311941 55.18 5.42 89.03
## 3 3 4232872 60.08 2.91 88.71
## 4 4 71720076 50.25 5.53 144.90
## 5 5 2840042 33.29 2.49 69.46
## MONTO_TOTAL_OTORGADO
## 1 60462715
## 2 105782815
## 3 40766733
## 4 470692419
## 5 25748361# Distribución de SEXO por cluster
tabla_sexo_clust <- prop.table(table(datos_muestra$CLUSTER, datos_muestra$SEXO), margin = 1)
print(round(tabla_sexo_clust, 3))##
## H M
## 1 0.559 0.441
## 2 0.640 0.360
## 3 0.557 0.443
## 4 0.811 0.189
## 5 0.629 0.371# Distribución de NIVEL_ESTUDIOS por cluster
tabla_educ_clust <- prop.table(table(datos_muestra$CLUSTER, datos_muestra$NIVEL_ESTUDIOS), margin = 1)
print(round(tabla_educ_clust, 3))##
## BAS DOC MED NOG POS PRF TEC UNV
## 1 0.024 0.019 0.019 0.033 0.152 0.376 0.025 0.352
## 2 0.028 0.014 0.031 0.034 0.207 0.423 0.008 0.255
## 3 0.184 0.003 0.221 0.067 0.121 0.101 0.109 0.193
## 4 0.025 0.032 0.022 0.013 0.229 0.437 0.017 0.224
## 5 0.131 0.003 0.172 0.061 0.031 0.112 0.208 0.283A partir de las medias por cluster y las distribuciones de SEXO y NIVEL_ESTUDIOS, se caracteriza cada uno de los 5 segmentos identificados:
Cluster 5 — “Jóvenes de bajos recursos” (37.7% de la muestra)
Es el cluster más grande. Agrupa a los clientes más jóvenes (edad promedio 33.3 años), con el estrato más bajo (2.49), los ingresos más bajos (2.84M) y el monto otorgado más bajo (25.7M). Su porcentaje de endeudamiento también es el más bajo (69.5). En cuanto a educación, concentra mayor proporción en niveles medios y básicos: MED (17.2%), BAS (13.1%), TEC (20.8%) y UNV (28.3%). La distribución por sexo es 62.9% hombres / 37.1% mujeres. Representa la base de la pirámide crediticia del banco: clientes jóvenes, de estratos bajos, con capacidad económica limitada.
Cluster 1 — “Clase media joven” (21.7% de la muestra)
Clientes jóvenes (35.9 años) pero con estrato medio-alto (4.56), ingresos cercanos al promedio (9.23M) y monto otorgado medio-bajo (60.5M). Su endeudamiento es moderado (74.9). El nivel educativo está fuertemente concentrado en PRF (37.6%) y UNV (35.2%), lo que indica un perfil profesional. La distribución por sexo es la más equilibrada de todos los clusters (55.9% H / 44.1% M). Representa el segmento emergente o de profesionales jóvenes que están consolidando su situación financiera.
Cluster 3 — “Adultos de bajos recursos” (21.0% de la muestra)
El cluster de mayor edad promedio (60.1 años). Agrupa a clientes de estrato bajo (2.91), con ingresos bajos (4.23M) y monto otorgado medio-bajo (40.8M). Su endeudamiento es cercano al promedio (88.7). En educación, presenta mayor peso de niveles bajos: BAS (18.4%) y MED (22.1%), aunque también un 19.3% con UNV. La distribución por sexo es equilibrada (55.7% H / 44.3% M). Corresponde probablemente a adultos mayores, pensionados o trabajadores independientes de edad avanzada con créditos de largo plazo.
Cluster 2 — “Adultos consolidados” (13.3% de la muestra)
Clientes mayores (55.2 años) con estrato alto (5.42), ingresos altos (22.3M) y monto otorgado alto (105.8M). Su endeudamiento es similar al promedio (89.0). El nivel educativo está fuertemente concentrado en PRF (42.3%) y POS (20.7%), con un 25.5% en UNV. Es un perfil claramente profesional y consolidado. La distribución por sexo es 64.0% H / 36.0% M. Representa el segmento premium de clientes con buen poder adquisitivo y estabilidad financiera.
Cluster 4 — “Alto patrimonio / élite” (6.3% de la muestra)
Es el cluster más pequeño pero el más extremo en todas las variables. Ingresos extremadamente altos (71.7M, más de 5 veces el promedio), monto otorgado muy superior al resto (470.7M, más de 6 veces el promedio), estrato más alto (5.53) y porcentaje de endeudamiento más alto (144.9). La edad promedio es 50.3 años. En educación, presenta la mayor concentración en PRF (43.7%) y POS (22.9%). La distribución por sexo revela un fuerte sesgo masculino: 81.1% hombres vs 18.9% mujeres. Constituye la élite financiera del banco: clientes de altísimo patrimonio que solicitan créditos de gran magnitud.
Conclusiones generales
El análisis integral de la cartera de clientes del banco permitió articular cuatro enfoques complementarios —análisis descriptivo, reducción de dimensionalidad, modelamiento y segmentación— para construir una visión coherente del comportamiento financiero de los clientes y, en particular, de la distribución de sus ingresos.
El análisis exploratorio evidenció un patrón de género relevante: las mujeres de la muestra presentan, en promedio, un perfil educativo más alto que los hombres, pero obtienen ingresos significativamente menores. Esta aparente contradicción —mayor formación académica con menores ingresos— constituye uno de los hallazgos centrales del trabajo, pues sugiere que la brecha salarial no se explica por diferencias educativas. Las pruebas de hipótesis confirmaron que esta diferencia es estadísticamente significativa y no atribuible al azar.
El ACP mostró que las cinco variables numéricas analizadas son relativamente independientes entre sí: la información no se concentra en pocas dimensiones, sino que se distribuye de manera uniforme entre las componentes. Esto anticipó una de las conclusiones más importantes del trabajo: el monto otorgado no depende de un único factor dominante, sino de una combinación de variables que operan con efectos moderados. Las variables más asociadas al monto fueron el propio monto, el porcentaje de endeudamiento, la edad y el estrato, mientras que los ingresos tuvieron una contribución marginal dentro del ACP.
El modelo de regresión matizó esta aparente contradicción: al controlar simultáneamente por otras variables, los ingresos emergieron como el predictor más fuerte del monto otorgado, lo que indica que su efecto se enmascara cuando se analiza de forma aislada (como en la matriz de correlación o el ACP), pero se revela al considerar el resto de factores. Adicionalmente, el modelo confirmó que el género tiene un efecto propio sobre el monto otorgado: incluso controlando por ingresos, edad, estrato y nivel educativo, las mujeres reciben montos sistemáticamente menores. Este resultado conecta los hallazgos del análisis descriptivo con el modelamiento, y sugiere la presencia de factores estructurales no observados que afectan el acceso al crédito por parte de las mujeres.
El clustering complementó el análisis al identificar cinco segmentos con perfiles socioeconómicos claramente diferenciados, que van desde clientes jóvenes de bajos recursos hasta una élite de alto patrimonio. Un hallazgo particularmente relevante fue la fuerte masculinización del segmento de mayor patrimonio, lo que refuerza desde otra perspectiva la evidencia de desigualdad de género encontrada en los análisis previos. Los segmentos también revelaron que la combinación de edad, estrato y nivel educativo genera perfiles de cliente muy distintos, lo que sugiere que la segmentación de la cartera podría aprovecharse para diseñar productos crediticios diferenciados.
En conjunto, el trabajo permite concluir que la distribución de ingresos y el acceso al crédito en esta cartera no son fenómenos aleatorios, sino que responden a patrones identificables en los que el género, el nivel educativo y el perfil socioeconómico juegan un papel central. La convergencia de hallazgos desde cuatro enfoques metodológicos distintos refuerza la solidez de estas conclusiones.
Como limitación principal, se reconoce que ningún modelo agota la complejidad del fenómeno: queda sin explicar una parte importante de la variabilidad del monto otorgado, lo que apunta a la existencia de factores no observados (garantías, tipo de producto, comportamiento histórico específico).