Análisis de Morosidad en la Colocación de Créditos

Prueba Data Analyst — Entidad Financiera ABC

1 Contexto y objetivo

La entidad financiera ABC presenta un crecimiento sostenido en colocación de crédito, acompañado de un incremento en la morosidad a 30 días dentro de los primeros 12 meses de vida del crédito (BGI_30_12). El objetivo de este análisis es (1) describir la evolución histórica de la cartera, (2) perfilar el comportamiento de mora por segmento y (3) identificar cruces de variables con morosidad significativamente distinta al promedio de la cartera, como insumo para ajustar las políticas de originación.

Fuente de datos: base_prueba_F.xlsx (hojas prestamos, perfil_riesgo, perfil_sociodemografico), unidas por ID + FECHA_APER. Periodo disponible: enero 2022 – enero 2023 (13 meses, 20.551 créditos).

ruta <- "base_prueba_F.xlsx"

prestamos <- read_excel(ruta, sheet = "prestamos")
riesgo    <- read_excel(ruta, sheet = "perfil_riesgo")
socio     <- read_excel(ruta, sheet = "perfil_sociodemografico")

df <- prestamos %>%
  left_join(riesgo, by = c("ID", "FECHA_APER")) %>%
  left_join(socio,  by = c("ID", "FECHA_APER")) %>%
  mutate(
    FECHA = as.Date(paste0(as.character(FECHA_APER), "01"), format = "%Y%m%d"),
    PERFIL_RIESGO = factor(PERFIL_RIESGO, levels = sort(unique(PERFIL_RIESGO))),
    EDAD          = factor(EDAD,          levels = sort(unique(EDAD))),
    EXPERIENCIA   = factor(EXPERIENCIA,   levels = sort(unique(EXPERIENCIA))),
    Ingreso_SMMLV = factor(Ingreso_SMMLV, levels = sort(unique(Ingreso_SMMLV))),
    PRODUCTO      = factor(PRODUCTO)
  )

Nota de calidad de datos (transparencia metodológica):

• VALOR tiene 126 registros faltantes (0,6%) y PUNTAJE 28 (0,1%); no se imputan, se excluyen fila a fila solo en los cálculos donde aplica (na.rm = TRUE), sin afectar el conteo de créditos ni la mora.
• El catálogo PRODUCTO trae “Lib” y “Libre” como categorías separadas (no se unificaron). Sus perfiles son muy distintos — “Lib” tiene ticket promedio de $34,6 millones y mora de 3,9%, “Libre” tiene ticket de $14,0 millones y mora de 19,3% — consistente con Libranza (descuento por nómina, bajo riesgo) vs. Libre Inversión (sin garantía de nómina, mayor riesgo). Se tratan como productos distintos; se recomienda validar esta interpretación con el área de producto.
• Existen categorías "00_SinInfo", "0.SIN_CALCULO" y "Sin Info" que agrupan información faltante en variables sociodemográficas y de score; se mantienen como una categoría explícita “Sin información” en vez de eliminarse, porque su tasa de mora es en sí misma informativa (ver secciones 2 y 3).

---

2 Actividad 1 — Evolución histórica de la cartera

2.1 Serie mensual total

mensual_tot <- df %>%
  group_by(FECHA) %>%
  summarise(
    n_prestamos    = n(),
    valor_total    = sum(VALOR, na.rm = TRUE),
    valor_promedio = mean(VALOR, na.rm = TRUE),
    tasa_mora      = mean(BGI_30_12)
  )

p1 <- ggplot(mensual_tot, aes(x = FECHA)) +
  geom_col(aes(y = n_prestamos, text = paste0(format(FECHA, "%b-%Y"),
                                               "<br>N créditos: ", n_prestamos)),
           fill = col_vol, alpha = 0.85) +
  geom_line(aes(y = tasa_mora * max(n_prestamos) / max(tasa_mora),
                text = paste0(format(FECHA, "%b-%Y"), "<br>Mora: ", percent(tasa_mora, 0.1))),
            color = col_mora, linewidth = 1.1, group = 1) +
  geom_point(aes(y = tasa_mora * max(n_prestamos) / max(tasa_mora)), color = col_mora, size = 1.6) +
  scale_y_continuous(
    name = "N° de créditos",
    sec.axis = sec_axis(~ . * max(mensual_tot$tasa_mora) / max(mensual_tot$n_prestamos),
                         name = "Tasa de mora (BGI_30_12)", labels = percent_format(accuracy = 1))
  ) +
  scale_x_date(date_labels = "%b-%y", date_breaks = "1 month") +
  labs(x = NULL, title = "Volumen de originación vs. tasa de mora (mensual, total cartera)") +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(p1, tooltip = "text") %>% layout(margin = list(t = 60))

mensual_tot %>%
  mutate(tasa_mora = percent(tasa_mora, accuracy = 0.1),
         valor_total = comma(round(valor_total)),
         valor_promedio = comma(round(valor_promedio))) %>%
  rename(Fecha = FECHA, `N créditos` = n_prestamos, `Valor total ($miles)` = valor_total,
         `Valor promedio ($miles)` = valor_promedio, `Tasa mora` = tasa_mora) %>%
  datatable(rownames = FALSE, options = list(dom = "t", pageLength = 13))

2.2 Evolución por producto

mensual_prod <- df %>%
  group_by(FECHA, PRODUCTO) %>%
  summarise(n = n(), valor_prom = mean(VALOR, na.rm = TRUE), mora = mean(BGI_30_12), .groups = "drop")

p2 <- ggplot(mensual_prod, aes(x = FECHA, y = mora, color = PRODUCTO,
                                text = paste0(PRODUCTO, " · ", format(FECHA, "%b-%Y"),
                                              "<br>Mora: ", percent(mora, 0.1), " · N: ", n))) +
  geom_line(linewidth = 0.9) + geom_point(size = 1.3) +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  scale_x_date(date_labels = "%b-%y") +
  labs(x = NULL, y = "Tasa de mora", title = "Tasa de mora mensual por producto", color = "Producto") +
  theme_minimal(base_size = 11)

ggplotly(p2, tooltip = "text")

resumen_prod <- df %>%
  group_by(PRODUCTO) %>%
  summarise(
    n_prestamos    = n(),
    valor_total    = sum(VALOR, na.rm = TRUE),
    valor_promedio = mean(VALOR, na.rm = TRUE),
    tasa_mora      = mean(BGI_30_12)
  ) %>%
  arrange(desc(tasa_mora))

resumen_prod %>%
  mutate(across(c(valor_total, valor_promedio), ~comma(round(.))),
         tasa_mora = percent(tasa_mora, 0.1)) %>%
  rename(Producto = PRODUCTO, `N créditos` = n_prestamos, `Valor total ($miles)` = valor_total,
         `Valor promedio ($miles)` = valor_promedio, `Tasa mora` = tasa_mora) %>%
  kable(align = "lrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Producto	N créditos	Valor total (\(miles) </th> <th style="text-align:right;"> Valor promedio (\)miles)	Tasa mora
Libre	6488	90,892,184	14,011	19.3%
Veh	289	15,522,212	53,710	16.3%
TDC	9348	48,854,669	5,296	13.7%
Micro	2691	19,155,106	7,121	11.0%
Hipotecario	335	40,371,863	120,513	6.9%
Lib	1400	48,507,038	34,648	3.9%

2.3 Comentarios y conclusiones — Actividad 1

• La mora total de la cartera sube de forma sostenida: pasa de 12,4% en enero 2022 a 16,5% en enero 2023 — un incremento de +4,1 puntos porcentuales (~33% relativo) en 12 meses, sin que el volumen de originación muestre una tendencia de crecimiento equivalente (de hecho cae en el último trimestre). Esto respalda la hipótesis del caso: el deterioro no es solo efecto de “más volumen”, sino de un cambio en la composición de riesgo de lo que se está originando.
• La mora está muy concentrada por producto: Libre Inversión (19,3%) y Vehículo (16,3%) son los más riesgosos; Hipotecario (6,9%) y Lib/Libranza (3,9%) son los más sanos, coherente con el respaldo de garantía real o descuento de nómina de estos últimos. TDC (13,7%) y Microcrédito (11,0%) están en un punto intermedio pero con TDC concentrando el 45% del volumen de créditos, por lo que su mora pesa mucho en el agregado aunque no sea la más alta.
• Recomendación: dar seguimiento diferenciado por producto en el comité de riesgo — Libre Inversión y Vehículo deberían tener alertas tempranas propias, no solo un indicador consolidado, porque están arrastrando el promedio general al alza.

---

3 Actividad 2 — Perfilamiento total y mensual

3.1 Función de apoyo

Para no repetir código, se construye una función que genera el perfilamiento (n y mora) para cualquier variable categórica, con volumen como barras y mora como línea en eje secundario.

plot_perfil <- function(data, var, top_n = NULL, titulo = NULL) {
  tab <- data %>%
    group_by(.data[[var]]) %>%
    summarise(n = n(), mora = mean(BGI_30_12), .groups = "drop") %>%
    arrange(desc(n))

  if (!is.null(top_n) && nrow(tab) > top_n) {
    tab <- tab %>% slice_max(n, n = top_n)
  }
  tab <- tab %>% mutate(across(1, ~fct_reorder(as.character(.x), n)))

  p <- ggplot(tab, aes(x = .data[[var]])) +
    geom_col(aes(y = n, text = paste0(.data[[var]], "<br>N: ", n)), fill = col_vol, alpha = 0.85) +
    geom_line(aes(y = mora * max(n) / max(mora),
                  text = paste0(.data[[var]], "<br>Mora: ", percent(mora, 0.1)), group = 1),
              color = col_mora, linewidth = 1) +
    geom_point(aes(y = mora * max(n) / max(mora)), color = col_mora, size = 1.8) +
    scale_y_continuous(name = "N° de créditos",
                        sec.axis = sec_axis(~ . * max(tab$mora) / max(tab$n),
                                             name = "Tasa de mora", labels = percent_format(accuracy = 1))) +
    coord_flip() +
    labs(x = NULL, title = titulo %||% paste("Perfilamiento por", var)) +
    theme_minimal(base_size = 11)

  ggplotly(p, tooltip = "text") %>% layout(margin = list(t = 60))
}
`%||%` <- function(a, b) if (is.null(a)) b else a

3.2 Perfilamiento total

3.2.1 Producto

plot_perfil(df, "PRODUCTO", titulo = "Volumen y mora por producto")

3.2.2 Perfil de riesgo

plot_perfil(df, "PERFIL_RIESGO", titulo = "Volumen y mora por perfil de riesgo (score)")

3.2.3 Actividad económica

plot_perfil(df, "Actividad_Economica", titulo = "Volumen y mora por actividad económica")

3.2.4 Departamento (top 15)

plot_perfil(df, "DEPARTAMENTO", top_n = 15, titulo = "Volumen y mora por departamento (top 15 por volumen)")

3.2.5 Edad

plot_perfil(df, "EDAD", titulo = "Volumen y mora por rango de edad")

3.2.6 Experiencia crediticia

plot_perfil(df, "EXPERIENCIA", titulo = "Volumen y mora por experiencia crediticia (meses)")

3.2.7 Ingreso

plot_perfil(df, "Ingreso_SMMLV", titulo = "Volumen y mora por rango de ingreso (SMMLV)")

3.3 Perfilamiento mensual

3.3.1 Por perfil de riesgo

mens_riesgo <- df %>%
  group_by(FECHA, PERFIL_RIESGO) %>%
  summarise(n = n(), mora = mean(BGI_30_12), .groups = "drop")

p3 <- ggplot(mens_riesgo, aes(x = FECHA, y = mora, color = PERFIL_RIESGO,
                               text = paste0(PERFIL_RIESGO, " · ", format(FECHA, "%b-%Y"),
                                             "<br>Mora: ", percent(mora, 0.1), " · N: ", n))) +
  geom_line(linewidth = 0.9) + geom_point(size = 1.2) +
  scale_color_manual(values = paleta_riesgo) +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  labs(x = NULL, y = "Tasa de mora", title = "Mora mensual por perfil de riesgo", color = "Perfil") +
  theme_minimal(base_size = 11)

ggplotly(p3, tooltip = "text")

3.3.2 Por producto (volumen apilado)

p4 <- ggplot(mensual_prod, aes(x = FECHA, y = n, fill = PRODUCTO,
                                text = paste0(PRODUCTO, " · ", format(FECHA, "%b-%Y"), "<br>N: ", n))) +
  geom_col(position = "stack") +
  labs(x = NULL, y = "N° de créditos", title = "Composición mensual de la originación por producto",
       fill = "Producto") +
  theme_minimal(base_size = 11)

ggplotly(p4, tooltip = "text")

3.4 Comentarios y conclusiones — Actividad 2

• PERFIL_RIESGO es, de lejos, la variable con mayor poder discriminante y de forma perfectamente monotónica: de 6,3% de mora en “Muy bajo” a 45,1% en “Muy alto” (7 veces más). Esto valida que el score actual sí ordena bien el riesgo — el problema no es el score en sí, sino qué tan permisivo es el punto de corte de aprobación que se aplica sobre ese score.
• Edad y experiencia crediticia se comportan igual de monotónicas y en la misma dirección: clientes de 18-25 años tienen 18,3% de mora vs. 8,3% en mayores de 55; clientes con menos de 12 meses de historial tienen 22,0% de mora vs. 12,0% con más de 60 meses. Edad y experiencia están correlacionadas (a menor edad, menor historial posible), por lo que en el cruce (Actividad 3) conviene revisar si aportan señal independiente o son redundantes.
• Ingreso también es protector pero con una relación menos limpia: cae de forma consistente de 18,6% (≤1 SMMLV) a 9,6% (>7,5 SMMLV), aunque el tramo “04. >5 y ≤7,5 SMMLV” rompe levemente la tendencia (12,7% vs. 12,2% del tramo inferior), posible ruido muestral (n=1.090) más que un efecto real.
• Geografía muestra un patrón costa vs. interior: Magdalena, Cesar, La Guajira, Atlántico y Bolívar (todos costa Caribe) están entre los departamentos con mayor mora (18-20%) con volúmenes suficientes para ser confiables (n>100), mientras Bogotá, con el mayor volumen (5.502 créditos), tiene mora cercana al promedio (14,8%).
• La categoría “Sin información” sociodemográfica no es ruido, es señal: en casi todas las variables, el segmento “sin información” tiene mora igual o superior al promedio general (edad sin info: 22,1%; experiencia sin info: 17,6%), lo que sugiere que la falta de dato en sí misma correlaciona con mayor riesgo y debería tratarse como una señal de alerta en el proceso de originación, no simplemente excluirse del análisis.
• En el tiempo, el deterioro de mora no es exclusivo de un perfil: todos los perfiles de riesgo muestran una tendencia al alza en el año, lo que indica un efecto de cosecha/entorno macro (además del efecto de mezcla de producto), y no solo un problema puntual de un segmento.

---

4 Actividad 3 — Segmentos con diferencias significativas en morosidad

Para cada cruce se calcula la mora por celda y se contrasta contra el promedio del resto de la cartera mediante una prueba de proporciones de dos muestras (prop.test), para distinguir diferencias que son estadísticamente significativas (y no solo ruido muestral). Se filtran celdas con n ≥ 30 para que la prueba sea confiable.

matriz_cruce <- function(data, var1, var2, min_n = 30) {
  n_total <- nrow(data)
  mora_total <- sum(data$BGI_30_12)

  tab <- data %>%
    group_by(.data[[var1]], .data[[var2]]) %>%
    summarise(n = n(), mora_n = sum(BGI_30_12), tasa = mean(BGI_30_12), .groups = "drop") %>%
    filter(n >= min_n) %>%
    rowwise() %>%
    mutate(
      resto_n    = n_total - n,
      resto_mora = mora_total - mora_n,
      p_valor    = tryCatch(
        prop.test(c(mora_n, resto_mora), c(n, resto_n))$p.value,
        error = function(e) NA_real_),
      significativo = case_when(
        is.na(p_valor) ~ "n/a",
        p_valor < 0.05 & tasa > mora_total / n_total ~ "↑ Mayor riesgo (sig.)",
        p_valor < 0.05 & tasa < mora_total / n_total ~ "↓ Menor riesgo (sig.)",
        TRUE ~ "Sin diferencia significativa"
      )
    ) %>%
    ungroup() %>%
    select(-resto_n, -resto_mora)

  tab
}

heatmap_cruce <- function(tab, var1, var2, titulo) {
  p <- ggplot(tab, aes(x = .data[[var2]], y = .data[[var1]], fill = tasa,
                        text = paste0(.data[[var1]], " × ", .data[[var2]],
                                      "<br>Mora: ", percent(tasa, 0.1), "<br>N: ", n,
                                      "<br>", significativo))) +
    geom_tile(color = "white") +
    scale_fill_gradient(low = "#EAF2F8", high = col_mora, labels = percent_format(accuracy = 1),
                         name = "Tasa mora") +
    labs(x = var2, y = var1, title = titulo) +
    theme_minimal(base_size = 10) +
    theme(axis.text.x = element_text(angle = 40, hjust = 1))

  ggplotly(p, tooltip = "text")
}

4.1 Matriz 1 — Perfil de riesgo × Producto

cruce1 <- matriz_cruce(df, "PERFIL_RIESGO", "PRODUCTO")
heatmap_cruce(cruce1, "PERFIL_RIESGO", "PRODUCTO", "Mora por Perfil de riesgo × Producto")

cruce1 %>%
  arrange(desc(tasa)) %>%
  mutate(tasa = percent(tasa, 0.1), p_valor = signif(p_valor, 3)) %>%
  select(`Perfil riesgo` = PERFIL_RIESGO, Producto = PRODUCTO, N = n, `Tasa mora` = tasa,
         `p-valor` = p_valor, Diagnóstico = significativo) %>%
  datatable(rownames = FALSE, options = list(pageLength = 10))

4.2 Matriz 2 — Edad × Ingreso

cruce2 <- matriz_cruce(df, "EDAD", "Ingreso_SMMLV")
heatmap_cruce(cruce2, "EDAD", "Ingreso_SMMLV", "Mora por Edad × Rango de ingreso")

cruce2 %>%
  arrange(desc(tasa)) %>%
  mutate(tasa = percent(tasa, 0.1), p_valor = signif(p_valor, 3)) %>%
  select(Edad = EDAD, Ingreso = Ingreso_SMMLV, N = n, `Tasa mora` = tasa,
         `p-valor` = p_valor, Diagnóstico = significativo) %>%
  datatable(rownames = FALSE, options = list(pageLength = 10))

4.3 Matriz 3 — Departamento (top 10 por volumen) × Perfil de riesgo

top_deptos <- df %>% count(DEPARTAMENTO, sort = TRUE) %>% slice_max(n, n = 10) %>% pull(DEPARTAMENTO)

cruce3 <- matriz_cruce(df %>% filter(DEPARTAMENTO %in% top_deptos), "DEPARTAMENTO", "PERFIL_RIESGO", min_n = 20)
heatmap_cruce(cruce3, "DEPARTAMENTO", "PERFIL_RIESGO", "Mora por Departamento (top 10) × Perfil de riesgo")

cruce3 %>%
  arrange(desc(tasa)) %>%
  mutate(tasa = percent(tasa, 0.1), p_valor = signif(p_valor, 3)) %>%
  select(Departamento = DEPARTAMENTO, `Perfil riesgo` = PERFIL_RIESGO, N = n, `Tasa mora` = tasa,
         `p-valor` = p_valor, Diagnóstico = significativo) %>%
  datatable(rownames = FALSE, options = list(pageLength = 10))

4.4 Comentarios y conclusiones — Actividad 3

• El cruce Perfil de riesgo × Producto revela el segmento de mayor prioridad para política: Libre Inversión en perfil 1.MUY_ALTO tiene 51,9% de mora sobre 231 créditos, y TDC en el mismo perfil tiene 39,2% sobre 181 créditos — ambos estadísticamente significativos frente al resto de la cartera. Esto indica que hoy se está originando crédito de consumo sin garantía a clientes ya identificados como de muy alto riesgo por el score, lo cual es el punto más claro de intervención inmediata: endurecer o eliminar la aprobación de Libre Inversión y TDC para el perfil Muy Alto.
• El cruce Edad × Ingreso muestra que el riesgo no es aditivo, es multiplicativo: clientes de 25-35 años con ingreso ≤1 SMMLV llegan a 22,8% de mora (n=771), muy por encima de lo que edad o ingreso predicen por separado. Los segmentos jóvenes con bajo ingreso y sin información concentran las celdas de mayor riesgo del cruce, lo que sugiere que una política de doble filtro (edad + ingreso), no solo score, mejoraría la segmentación de originación.
• El cruce geográfico confirma que el efecto costa Caribe no es homogéneo dentro de cada departamento: al cruzar con perfil de riesgo, la brecha entre departamentos se explica en parte por diferencias en la composición de perfiles que se están aprobando en cada región — es decir, no solo hay más riesgo inherente en la costa, sino que también se está aprobando una mezcla de riesgo más laxa en esas regionales, lo cual es accionable desde política (cupos de aprobación diferenciados por región y perfil).

---

5 Conclusiones generales y recomendaciones

1. Causa del incremento en morosidad: es una combinación de (a) tendencia macro/cosecha —sube en todos los perfiles y productos a lo largo del año— y (b) mezcla de originación más riesgosa en productos sin garantía (Libre Inversión, TDC) hacia perfiles de score alto/muy alto.
2. El score de originación funciona bien (relación monotónica y fuerte con mora); el problema es de política de corte por producto, no del modelo de score en sí.
3. Variables con mayor poder de segmentación, en orden: Perfil de riesgo > Producto > Experiencia crediticia ≈ Edad > Departamento > Ingreso > Actividad económica (esta última con diferencia mínima y no significativa en la mayoría de cruces).
4. Recomendaciones concretas de política de originación:
   • Definir un corte de aprobación específico por producto para el perfil 1.MUY_ALTO y 2.ALTO en Libre Inversión y TDC (hoy son los que más castigan la cartera).
   • Incorporar edad + ingreso como filtro conjunto adicional al score para clientes jóvenes de bajo ingreso, no solo el score aislado.
   • Revisar cupos/atribuciones de aprobación regional en la costa Caribe, validando si la mezcla de riesgo aprobada allí es comparable a la del resto del país.
   • Tratar la ausencia de información sociodemográfica como una señal de riesgo explícita dentro del proceso, no como un dato neutro.
   • Dar seguimiento mensual diferenciado (no solo un KPI consolidado) para Libre Inversión, Vehículo y TDC, que son los productos que están arrastrando la tendencia general al alza.

Nota: todos los hallazgos cuantitativos de este documento se recalculan directamente de base_prueba_F.xlsx al compilar el .Rmd; ningún número está codificado a mano.