Políticas de Originación Préstamos Banco Santa Cruz
Transunion
19 Noviembre 2020
people <- matrix(c(
"Líder de Proyecto", "Alvaro Andres Navarro", "AlvaroAndres.Navarro@transunion.com"
, "Consultor", "Nelson Zambrano", "Nelson.Zambrano@transunion.com"
, "Analista", "Vannesa Elian", "Vannesa.Elian@transunion.com"
), ncol = 3, byrow = T)
colnames(people) <- c("Rol", "Nombre", "Email")
DT::datatable(
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
htmltools::h2('Equipo de Trabajo'))
, people
, options = list(dom = 't'))1 Legal Disclaimer
© 2020 TransUnion LLC
All Rights Reserved
No part of this publication may be reproduced or distributed in any form or by any means, electronic or otherwise, now known or hereafter developed, including, but not limited to, the Internet, without the explicit prior written consent from TransUnion LLC.
Requests for permission to reproduce or distribute any part of, or all of, this publication should be mailed to:
Law Department
TransUnion
555 West Adams
Chicago, Illinois 60661
The “T” logo, TransUnion, and other trademarks, service marks, and logos (the “Trademarks”) used in this publication are registered or unregistered Trademarks of TransUnion LLC or their respective owners. Trademarks may not be used for any purpose whatsoever without the express written permission of the Trademark owner.
2 Introducción y Preparación de la Base de Datos
2.1 Configuración Inicial
2.1.1 Configuración del Entorno
Nuestras herramientas de modelado utilizan software de código abierto, incluidas en R. Las herramientas de código abierto tienen la ventaja de ser desarrolladas y examinadas por una comunidad de usuarios que abarca una amplia variedad de aplicaciones. El código abierto, proporciona una amplia biblioteca de paquetes y la disponibilidad de los últimos algoritmos y técnicas.
2.2 Bases de Datos
2.2.1 Carga Base de Datos del Cliente
Utilizaremos “Base Detallada” a partir de la información de solicitudes compartida por el banco.
BIMod<- read_csv("/shared/nas/shape/bu_lam/persist/AnalyticsDR/BSC/AN_BCS_103_CM_201911/V3/20200529_BASESAS_ARBOL.csv")
Atributos <- read_excel("/shared/nas/shape/bu_lam/persist/AnalyticsDR/BSC/AN_BCS_103_CM_201911/Diccionario/Diccionario_insumo_r.xlsx")2.3 Atributos- Variables
2.3.1 Creación de set de Atributos
Para cada período de observación, TransUnion agrega su conjunto de más de 200 características de crédito agregadas. Estas características miden una serie de facetas del ciclo de vida del crédito, incluidos los tipos de cuentas, la edad de las cuentas, la utilización y la morosidad.
Utilizarenmos todos los atributos calculados a partir de la informacion de los clientes que posee TU.
2.3.2 Atributos Disponibles y descripcion:
vars <- tbl_df(colnames(BIMod))
colnames(vars) <- "Attr"
vars <- vars %>%
left_join(Atributos, by = "Attr")
datatable(vars)2.3.3 Analisis Univariado ANEXO Diccionario Variables
En éste paso se analiza cada una de las variables , con el fin de determinar si cumplen con características de completitud y variabilidad, descartando aquellas variables que no cumplen dichas condiciones.
- Variabilidad: Rechazo aquellas con una variabilidad inferior al 50%
- Completitud: Rechazo aquellas con un porcentaje poblacional inferior al 50%.
2.3.4 Correlación ANEXO Diccionario Variables
- Rechazo aquellas con una correlación superior al 80% entre 2 variables. Rechazo la variable que tenga el gini mas bajo
2.3.5 Analisis de Negocio ANEXO Diccionario Variables
- En el desarrollo del binning , seleccion de variables y analisis de los arboles de decision se van eliminando variables que a pesar de no ser descartadas por los anteriores procesos, no cumplen con el sentido de negocio o se contraponen con otras variables que ya han sido incluidas
## # A tibble: 10 x 2
## type n
## <chr> <int>
## 1 Completitud-Eliminadas 131
## 2 CondicionesCredito 21
## 3 Correlacion-Eliminadas 48
## 4 Indagaciones 5
## 5 Internas 3
## 6 Morosidad 11
## 7 Negocio-Eliminadas 65
## 8 NoDescription 5
## 9 Transaccionalidad 7
## 10 VarDescartadas 42.3.6 Atributos Preferidos
datatable(vars %>%
filter(Attr %in% preds))3 Etapa 1: Definición Punto de Incumplimiento
El modelo está diseñado para predecir la probabilidad de que una operación alcance 90 días o más dentro de los 12 meses posteriores a la fecha de observación. Esta definición se elige según los resultados mostrados por las matrices de transición, cosechas, las conversaciones con el cliente y se adapta a sus peculiaridades de su cartera.
- Revisión de las tasas de rodamiento.
- Se observa el punto en el cual una fracción muy grande de la población alcanza un nivel de morosidad tal que no se recupere sino que al contrario avance a niveles superiores de morosidad,
- Verificar de que los volúmenes sean suficientes para construir un modelo robusto
- Contrastar y asegurar que las definiciones de rodamiento tienen sentido comercial
3.1 Definiciones-Incumplimiento
La definición de desempeño, basada en la morosidad máxima, se definió de la siguiente manera:
Buenos (1) – Al día sobre una ventana de desmpeño de 12 meses
Malos (0) – Clientes que tocan el rango de morosidad 61-90 días o mas sobre una ventana de desempeño de 12 mesesLas distribuciones se comportan de la siguiente forma:
3.2 Tabla de Distribución
3.2.1 Tabla de distribucion inicial
Calificamos nuestrabase de trabajo con el Score de Credit Vision en el momento de apertura de cada una de las cuentas. Se observa la siguiente tabla de desempeno.
gt_toti<- gainsTable(BGI_F ~ SCORE, data = BIMod, numOfIntervals = 10)
gt_toti %>% wrapGainsTable()4 Etapa 2: Definición y Generación de Políticas de Originación
4.0.1 Objetivo Segmentación
El objetivo de la segmentación es dividir a la población en grupos más pequeños y homogéneos basados en un perfil de comportamiento similar. Típicamente, un modelo construido sobre grupos homogéneos tiene más poder predictivo que un solo algoritmo que se aplica a toda la población.
4.0.2 Separación Bases Validación y Entrenamiento
Generamos una muestra de entrenamiento y una de validación.
set.seed(77)
index1 = sample(nrow(BIMod), nrow(BIMod)*0.7)Para el diseño del árbol de decisión seleccionamos una muestra de validación 30% y una de desarrollo 70%:
Bases de Entrenamiento y Validación:
train1<- BIMod[index1,]
train1<- addDescriptions(data = train1, dictionary = Atributos,nameCol = "Attr",descrCol = "Description")
test1<- BIMod[-index1,]
test1<- addDescriptions(data = test1, dictionary = Atributos,nameCol = "Attr",descrCol = "Description")
nrow(train1)/nrow(BIMod)## [1] 0.699971Iniciamos el desarrollo del árbol:
#segTree_delivered <- newTree( data = BIMod[index1, c("BGI_F", preds )]
# , target ="BGI_F" )4.0.3 Segmentación y Diseño de Árbol Decisión
segTree_delivered <- treeExplorer(segTree_delivered)
#saveRDS(segTree_delivered,"segTree_delivered.RData")
plot(segTree_delivered)
A caption
4.0.4 Detalle Atributos Utilizados
La variable CANT_PAGOS 24 MESES se genera desde la base Trades en Shape.
base_V0263_s2 <- Trades %>%
arrange(id,accno,fecha_corte) %>%
group_by(accno) %>%
mutate(pago=lastpayment >0,
pagoenmes= fecha_corte == dateoflastactivity_corte,
balance_ant = lag(balance),
pagobalance = if_else(is.na(balance_ant) | is.na(balance),
NA,
(balance_ant > 0) & (balance < balance_ant)),
pagofechamonto=if_else(is.na(pago) | is.na(pagoenmes),
NA,
if_else(pago==T & pagoenmes == T,
1,
0)
)) %>%
compute("base_V0263_s2")
tbl(sc,"IDS_ARBOL_2")
V0263_join <- sdf_sql(sc,
"SELECT a.*
FROM base_V0263_s2 a
INNER JOIN IDS_ARBOL_2 b ON a.id = b.id
AND (a.fecha_corte > b.INI_INT AND
a.fecha_corte <=b.FIN_INT)") %>% compute("V0263_join")
tbl_cant_pagos_s <- V0263_join %>%
select(id,accno,lastpayment,pago,fecha_corte,dateoflastactivity_corte,pagoenmes,
balance_ant,balance,pagobalance,pagofechamonto) %>%
mutate(pagobalance = if_else(pagobalance==T,1,0),
pago_prod = if_else((is.na(pagobalance) & pagofechamonto == F) | (pagobalance == F & is.na(pagofechamonto)),
0,
if_else(pagobalance == T | pagofechamonto == T,
1,
0))) %>%
group_by(id) %>%
summarise(cant_pagos = sum(pago_prod))
tbl_cant_pagos2 <- tbl_cant_pagos_s %>% collect4.0.5 Tabla de Distribución Final
Una vez hemos desarrollado el árbol de decisión seleccionado tenemos la siguiente tabla de distribución en la Base Total:
BIMod_vfdel <- BIMod %>% mutate(segment = case_when(
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M < 36 & SCORE < 698 ~ 2,
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M < 36 & SCORE >= 698 & SCORE < 725 ~ 6,
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M < 36 & SCORE >= 725 ~ 12,
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M >= 36 & V0180 < 5 & V0020 < 1 ~ 18,
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M >= 36 & V0180 < 5 & V0020 >= 1 ~ 15,
V0019 < 3 & V0276 < 49 & V0265 < 5 & CANT_PAGOS_24M >= 36 & V0180 >= 5 ~ 9,
V0019 < 3 & V0276 < 49 & V0265 >= 5 & V0180 < 6 ~ 5,
V0019 < 3 & V0276 < 49 & V0265 >= 5 & V0180 >= 6 ~ 1,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 < 5 & V0265 < 2 ~ 20,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 < 5 & V0265 >= 2 & V0265 < 8 ~ 17,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 < 5 & V0265 >= 8 ~ 11,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 >= 5 & SCORE < 720 ~ 10,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 >= 5 & SCORE >= 720 & SCORE < 745 ~ 14,
V0019 < 3 & V0276 >= 49 & V0179 < 1 & V0180 >= 5 & SCORE >= 745 ~ 19,
V0019 < 3 & V0276 >= 49 & V0179 >= 1 & CANT_PAGOS_24M < 75 ~ 8,
V0019 < 3 & V0276 >= 49 & V0179 >= 1 & CANT_PAGOS_24M >= 75 ~ 16,
V0019 >= 3 & V0180 < 5 & SCORE < 675 ~ 4,
V0019 >= 3 & V0180 < 5 & SCORE >= 675 & SCORE < 725 ~ 7,
V0019 >= 3 & V0180 < 5 & SCORE >= 725 ~ 13,
V0019 >= 3 & V0180 >= 5 ~ 3,
TRUE ~ 999))
#BIMod_vfdelsegSummary_vdel <- BIMod_vfdel%>%
group_by(segment) %>%
summarize(
n = n()
, nBad = sum(as.numeric(BGI_F == 0))
, nGood = sum(as.numeric(BGI_F == 1))
)%>%
arrange(segment)
segSummary_vdel ## # A tibble: 20 x 4
## segment n nBad nGood
## <dbl> <int> <dbl> <dbl>
## 1 1 1001 263 738
## 2 2 1387 305 1082
## 3 3 1988 431 1557
## 4 4 937 190 747
## 5 5 1633 238 1395
## 6 6 1353 164 1189
## 7 7 1368 151 1217
## 8 8 851 86 765
## 9 9 1713 159 1554
## 10 10 953 84 869
## 11 11 847 46 801
## 12 12 2173 114 2059
## 13 13 826 41 785
## 14 14 880 39 841
## 15 15 1169 46 1123
## 16 16 976 36 940
## 17 17 1897 48 1849
## 18 18 2185 50 2135
## 19 19 1598 30 1568
## 20 20 5252 29 5223 TDv_del<-segSummary_vdel%>%mutate(PctBad=(nBad/n),PctGood=(nGood/n))%>%
arrange (PctBad)
TDv_del ## # A tibble: 20 x 6
## segment n nBad nGood PctBad PctGood
## <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 20 5252 29 5223 0.00552 0.994
## 2 19 1598 30 1568 0.0188 0.981
## 3 18 2185 50 2135 0.0229 0.977
## 4 17 1897 48 1849 0.0253 0.975
## 5 16 976 36 940 0.0369 0.963
## 6 15 1169 46 1123 0.0393 0.961
## 7 14 880 39 841 0.0443 0.956
## 8 13 826 41 785 0.0496 0.950
## 9 12 2173 114 2059 0.0525 0.948
## 10 11 847 46 801 0.0543 0.946
## 11 10 953 84 869 0.0881 0.912
## 12 9 1713 159 1554 0.0928 0.907
## 13 8 851 86 765 0.101 0.899
## 14 7 1368 151 1217 0.110 0.890
## 15 6 1353 164 1189 0.121 0.879
## 16 5 1633 238 1395 0.146 0.854
## 17 4 937 190 747 0.203 0.797
## 18 3 1988 431 1557 0.217 0.783
## 19 2 1387 305 1082 0.220 0.780
## 20 1 1001 263 738 0.263 0.737datatable(TDv_del, options = list(dom = 't'))del_Nodos <- c(20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1)
Nodos_vdel <- data_frame(Nodo = del_Nodos)
TDv_del <- bind_cols(TDv_del, Nodos_vdel)
BIMod_vfdel <- BIMod_vfdel %>% left_join(TDv_del, by = c('segment'))4.0.6 Desemepeño Base Validación
train1_vfdel <- train1_vfdel %>% left_join(TDv_del, by = c('segment'))
gt_train1_vdel <- gainsTable(BGI_F ~ Nodo, data = train1_vfdel, breaks = c(-Inf,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,Inf))
gt_train1_vdel %>% wrapGainsTable()max(gt_train1_vdel$KS)## [1] 41.896554.0.7 Desemepeño Base Entrenamiento
test1_vfdel <- test1_vfdel %>% left_join(TDv_del, by = c('segment'))
gt_test1_vdel <- gainsTable(BGI_F ~ Nodo, data = test1_vfdel, breaks = c(-Inf,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,Inf))
gt_test1_vdel %>% wrapGainsTable()max(gt_test1_vdel$KS)## [1] 42.690254.0.8 Desemepeño Base Total
gt_BIMod_vfdel<- gainsTable(BGI_F ~ Nodo, data = BIMod_vfdel, breaks = c(-Inf,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,Inf))
gt_BIMod_vfdel %>% wrapGainsTable()max(gt_BIMod_vfdel$KS)## [1] 42.13632