Análisis de datos Aval Buró de Crédito
Introducción
En los últimos años surge un especial interés en las instituciones financieras en conocer los riesgos de financiamiento y liquidez, a los que están expuestas estas empresas; con el fin de proponer instrumentos que les permitan actuar oportunamente y de esta forma, tomar adecuadas decisiones se hace uso de ciertas herramientas que bajo un fundamento estadístico y matemático ayuda a poder estimar el riesgo del crédito y la recuperación de cuentas por cobrar. Se han diseñado modelos estadísticos, en base a un conjunto de atributos que permiten calificar objetivamente la calidad de un cliente.
En el presente trabajo se analiza una base de datos que contiene el detalle de clientes de una entidad financiera. Lo que se realizará es un análisis y procesamiento de los datos para una futura modelización de la probabilidad de caer en default (Mal pagador) dado un conjunto de variables exógenas. Nuestra variable objetivo es BM la cual clasifica a los clientes en “Buenos”(si no presenta atrasos) o “Malos”(si presenta atrasos superiores a 45 días en el pago de sus obligaciones de crédito).
1. Preanálisis y limpieza de datos
Librerías que serán usadas en éste trabajo.
library(readxl)
library(tidyverse)
library(data.table)
library(knitr)
library(kableExtra)
library(DataExplorer)
library(FNN)
library(PCAmixdata)
library(Information)
library(caret)
library(rpart)Procedemos a la lectura de los datos:
datos <- setDT(read_excel("bases/base.xlsx"))
kable(head(datos), align = 'c')| Identificacion | BM | PorcMesesAlDia_6M | LN_Sum_SalVenDjuCCaDSCE_36M | r_numOpsVenc_36M | Prom_NumDiasVencido_12M | ANTIGUEDAD_TRABAJO | ingresoNoComprometido | EstadoCivil | RelacionLaboral | TipoVivienda | REGION |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 1.0000000 | 0 | 0.00 | 0.0000000 | 23 | 0.8591550 | DIVORCIADO | Independiente | Propia no hipotecada | SIERRA |
| 2 | 0 | 0.6666667 | 0 | 0.25 | 0.0000000 | 23 | 0.6435970 | DIVORCIADO | Independiente | Propia no hipotecada | SIERRA |
| 3 | 0 | 1.0000000 | 0 | 0.00 | 0.0000000 | 120 | 0.3681624 | CASADO | Dependiente | Propia no hipotecada | SIERRA |
| 4 | 0 | 0.8333333 | 0 | 0.00 | 0.0833333 | 47 | 0.0000000 | SOLTERO | Independiente | Arrendado | SIERRA |
| 5 | 0 | 1.0000000 | 0 | 0.00 | 0.0000000 | 120 | -0.5315200 | CASADO | Independiente | Propia no hipotecada | SIERRA |
| 6 | 0 | 1.0000000 | 0 | 0.00 | 0.0000000 | 120 | 0.4452300 | CASADO | Dependiente | Familiar | SIERRA |
Revisamos la posible existencia de valores faltantes:
plot_missing(datos, title = "Porcentaje de valores faltantes")
Notemos que no hay valores NA. Por tanto no hay necesidad de alguna imputación en el conjunto de datos.
Valores Atípicos
Para poder realizar una detección de datos atípicos vamos a separar las variables entre cuantitativas y cualitativas:
data.cut <- splitmix(datos)
data.quanti<-as.data.frame(data.cut$X.quanti[-1])#omitimos la columna identificación
data.quali<-as.data.frame(data.cut$X.quali)Distribuciones de las variables cuantitativas
ggplot(datos) +
aes(x = PorcMesesAlDia_6M) +
geom_density() +
theme(legend.position="none") +
labs(title = "Densidad de la variable *PorcMesesAlDia_6M*")
Recordemos que esta variable representa el porcentaje de meses en los que el cliente pagó al día en el último semestre, así el gráfico de densidad tiene bastante sentido ya que los picos consisten en los 6 últimos meses y podemos ver que la gran mayoría de clientes han pagado los 6 últimos meses al día.
A continuación presentamos las densidades de todas las variables cuantitativas:
data.quanti %>% gather(metric, value) %>%ggplot(aes(value, fill = metric)) +
geom_density(show.legend = FALSE) +
facet_wrap(~ metric, scales = "free") +
labs(title = "Densidad de las variables cuantitativas")
Dado que a simple vista podría decirse que hay una posible existencia de datos anómalos, es mejor realizar un gráfico de cajas y bigotes para una mejor precisión en la detección de estas anomalías:
data.quanti %>% gather(metric, value) %>%ggplot(aes(value, fill = metric)) +
geom_boxplot(show.legend = FALSE) +
facet_wrap(~ metric, scales = "free") +
labs(title = "Gráfico de cajas de las variables cuantitativas")
Para tener un criterio mas potente para determinar cuales serán las observaciones con anomalías, haremos uso de un algoritmo para la detección de los mismos.
KNN (K-Nearest-Neighbor), en sus siglas en inglés, es un algoritmo basado en instancia de tipo supervisado de Machine Learning. Se lo utilizará pues el supuesto fundamental en el vecino más cercano es que las observaciones similares están próximas entre sí y los valores atípicos suelen ser observaciones solitarias, que se mantienen más alejadas del grupo de observaciones similares.
Cuando se trata de la detección de anomalías, adopta un enfoque no supervisado. Esto se debe a que no hay un “aprendizaje” real involucrado en el proceso y no hay un etiquetado predeterminado de “valor atípico” o “no atípico” en el conjunto de datos, sino que se basa completamente en valores de umbral.
Para ello, se utilizará la función get.knn, que son algoritmos rápidos de búsqueda de vecino más cercano k incluyendo un árbol-kd (kd-tree), árbol de cobertura (cover-tree) y el algoritmo implementado en el paquete de clases, siendo k el número máximo de vecinos más cercanos para buscar. Se tomamará k=5 y el percentil 0.975 para declarar como cota y se obtendrá una lista de indices que superan la cota:
data.out <- get.knn(data.quanti,k=5)
kable(head(data.out$nn.dist,10))| 0.0032145 | 0.0183678 | 0.0208720 | 0.0245709 | 0.0250641 |
| 0.0042738 | 0.2502265 | 0.2507925 | 0.2538469 | 0.2563851 |
| 0.0001298 | 0.0007253 | 0.0007476 | 0.0007745 | 0.0008838 |
| 0.0833333 | 0.0833333 | 0.0833333 | 0.0833333 | 0.0833333 |
| 0.0000495 | 0.0014557 | 0.0033983 | 0.0060723 | 0.0063014 |
| 0.0000586 | 0.0001889 | 0.0002327 | 0.0005695 | 0.0006589 |
| 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| 0.0118629 | 0.0144475 | 0.0195458 | 0.0213165 | 0.0232702 |
| 0.0000942 | 0.0003315 | 0.0007561 | 0.0008789 | 0.0009339 |
## El total de datos atípicos en la base de datos es: 532valores <- as.factor(ifelse(score>cota,"Eliminar","No eliminar"))
obs <- c(1:length(score))
pd <- data.frame(score,valores,obs)
ggplot(pd, aes(x=obs,y=score, col=valores)) +
geom_point() +
labs(title = "Grafico de etiquetado de observaciones mediante KNN")
De este modo, estos \(532\) datos deben ser separados del conjunto de datos para un futuro análisis.
datos <- datos[-index,]
rm(data.cut, data.out, data.quali, data.quanti, pd)#removemos los datos del ambiente para no ocupar mucha memoriaAnálisis de datos exploratorios (EDA)
datos %>% mutate(BM = ifelse(datos$BM == 0, "Buen Pagador", "Mal Pagador")) %>%
ggplot() +
aes(x = BM, fill = BM) +
geom_bar() +
geom_text(aes(label = scales::percent(((..count..)/sum(..count..))), y= ((..count..)/sum(..count..))), stat= "count", vjust = -.5) +
labs(title = "Gráfico de barras de la variable BM (tipo de cliente)")
Notemos que existe una diferencia muy grande en cuanto a la proporción del tipo de cliente, lo cual podría generar futuros problemas a la hora de generar un posible modelo sobre esta variable.
ggplot(datos) +
aes(x = RelacionLaboral, fill = RelacionLaboral) +
geom_bar() +
geom_text(aes(label = scales::percent(((..count..)/sum(..count..))), y= ((..count..)/sum(..count..))), stat= "count", vjust = -.5) +
theme(axis.text.x = element_text(angle = 60, margin = margin(b = -0.5, unit = "cm"), vjust = 0.7)) +
labs(title = "Gráfico de barras del tipo de relación laboral de los clientes", y = "Número de clientes")
Notemos que en su mayoría los clientes son independientes laboralmente.
ggplot(datos) +
aes(x = EstadoCivil, fill = EstadoCivil) +
geom_bar() +
geom_text(aes(label = scales::percent(((..count..)/sum(..count..))), y= ((..count..)/sum(..count..))), stat= "count", vjust = -.5) +
theme(axis.text.x = element_text(angle = 60, margin = margin(b = -0.5, unit = "cm"), vjust = 0.7)) +
labs(title = "Gráfico de barras del estado civil de los clientes", y = "Número de clientes")
Nótese que los perfiles mas predominantes son el de casado y de soltero, como era de esperarse. Otro gráfico que podría arrojar mayor información para el estudio sería cuál estado civil es el mejor pagador:
datos %>% mutate(BM = ifelse(datos$BM == 0, "Buen Pagador", "Mal Pagador")) %>%
ggplot() +
aes(x = BM, fill = BM) +
geom_bar() +
theme(axis.text.x=element_blank(), axis.ticks.x=element_blank()) +
facet_wrap(~EstadoCivil) +
labs(title = "Gráfico de barras de tipo de cliente por estado civil")
Notemos que en casi todos los niveles de estado civil se tiene la misma relación entre buenos y malos pagadores.
datos %>% mutate(BM = ifelse(datos$BM == 0, "Buen Pagador", "Mal Pagador")) %>%
ggplot() +
aes(x = ANTIGUEDAD_TRABAJO, fill = BM) +
geom_histogram(bins = 10, color = 'black') +
theme_minimal() + labs(title = "Histograma de antiguedad de trabajo con detalle de buen o mal pagador", y = "Número de observaciones")
Podría decirse que a media que crece la antiguedad en el trabajo se tiene una mayor cantidad de buenos clientes con respecto de los malos, aunque la diferencia no es muy marcada si puede observarse que en las dos barras extremas la de mayor antiguedad posee en proporción menos clientes malos en comparación con la barra de menor antiguedad.
2. Procesamiento
Primeramente vamos a realizar un cambio en la estructura de los datos, vamos a transformar nuestro conjunto de datos en un dataframe.
datos <- as.data.frame(datos)
str(datos)## 'data.frame': 20725 obs. of 12 variables:
## $ Identificacion : num 1 2 3 4 5 6 7 8 9 10 ...
## $ BM : num 0 0 0 0 0 0 0 0 0 0 ...
## $ PorcMesesAlDia_6M : num 1 0.667 1 0.833 1 ...
## $ LN_Sum_SalVenDjuCCaDSCE_36M: num 0 0 0 0 0 0 0 0 0 0 ...
## $ r_numOpsVenc_36M : num 0 0.25 0 0 0 0 0 0 0 0 ...
## $ Prom_NumDiasVencido_12M : num 0 0 0 0.0833 0 ...
## $ ANTIGUEDAD_TRABAJO : num 23 23 120 47 120 120 120 24 36 120 ...
## $ ingresoNoComprometido : num 0.859 0.644 0.368 0 -0.532 ...
## $ EstadoCivil : chr "DIVORCIADO" "DIVORCIADO" "CASADO" "SOLTERO" ...
## $ RelacionLaboral : chr "Independiente" "Independiente" "Dependiente" "Independiente" ...
## $ TipoVivienda : chr "Propia no hipotecada" "Propia no hipotecada" "Propia no hipotecada" "Arrendado" ...
## $ REGION : chr "SIERRA" "SIERRA" "SIERRA" "SIERRA" ...Cambiamos las variables que son tipo character a tipo factor, para una mejor maipulación del dataset:
datos <- mutate_if(datos, is.character, as.factor)
datos$BM <- as.factor(datos$BM)
str(datos)## 'data.frame': 20725 obs. of 12 variables:
## $ Identificacion : num 1 2 3 4 5 6 7 8 9 10 ...
## $ BM : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ PorcMesesAlDia_6M : num 1 0.667 1 0.833 1 ...
## $ LN_Sum_SalVenDjuCCaDSCE_36M: num 0 0 0 0 0 0 0 0 0 0 ...
## $ r_numOpsVenc_36M : num 0 0.25 0 0 0 0 0 0 0 0 ...
## $ Prom_NumDiasVencido_12M : num 0 0 0 0.0833 0 ...
## $ ANTIGUEDAD_TRABAJO : num 23 23 120 47 120 120 120 24 36 120 ...
## $ ingresoNoComprometido : num 0.859 0.644 0.368 0 -0.532 ...
## $ EstadoCivil : Factor w/ 5 levels "CASADO","DIVORCIADO",..: 2 2 1 4 1 1 1 4 5 5 ...
## $ RelacionLaboral : Factor w/ 6 levels "Dependiente",..: 2 2 1 2 2 1 1 1 2 2 ...
## $ TipoVivienda : Factor w/ 7 levels "Arrendado","Familiar",..: 7 7 7 1 7 2 7 7 7 2 ...
## $ REGION : Factor w/ 3 levels "AMAZONIA","COSTA",..: 3 3 3 3 3 3 1 3 3 3 ...Selección de variables
Para realizar un buen modelo, es necesario introducir las variables que tengan el mayor poder predictivo con respecto a la variable objetivo.
En nuestro caso, la variable objetivo es BM la cual es dicotómica.
- Valor de información IV
Muy tradicionalmente se ha conciderado el IV como una regla discriminatoria para el poder predictivo de las variables. Este IV tiene las siguientes reglas.
Reglas:
IV < 0.02 sin poder predictivo.
0.02 < IV < 0.1 poder predictivo bajo.
0.1 < IV < 0.3 poder predictivo medio.
0.3 < IV < 0.5 poder predictivo fuerte.
IV > 0.5 poder predictivo sospechosamente fuerte.
DatosIV<-datos[, -1]
DatosIV$BM<-as.numeric(DatosIV$BM)
DatosIV$BM<-ifelse(DatosIV$BM==1,0,1)
IV<- Information::create_infotables(data=DatosIV, y="BM", parallel = FALSE)
knitr::kable(head(IV$Summary))| Variable | IV | |
|---|---|---|
| 1 | PorcMesesAlDia_6M | 0.6686113 |
| 4 | Prom_NumDiasVencido_12M | 0.6207141 |
| 5 | ANTIGUEDAD_TRABAJO | 0.2956649 |
| 8 | RelacionLaboral | 0.2651091 |
| 6 | ingresoNoComprometido | 0.2260130 |
| 2 | LN_Sum_SalVenDjuCCaDSCE_36M | 0.1327862 |
- Analisis de interacción de variables independientes con la variable dependiente
Otra forma de ver cuales variables están con mayor relación de dependencia con nuestra variable objetivo, lo podemos realizar mediante una matriz de correlación. La matriz de correlación nos explica como se encuentran relacionadas cada una de las variables con otra variable. Mientras el coeficiente de correlación se encuentre mas cercano a cero las variables son más independientes.
datos1 <- as.data.table(datos)
datos1 <- datos1 %>% mutate_if(is.factor, as.numeric) #convertimos las variable tipo factor a numericas
kable(cor(datos1[,-1]), caption = "Matriz de correlación")| BM | PorcMesesAlDia_6M | LN_Sum_SalVenDjuCCaDSCE_36M | r_numOpsVenc_36M | Prom_NumDiasVencido_12M | ANTIGUEDAD_TRABAJO | ingresoNoComprometido | EstadoCivil | RelacionLaboral | TipoVivienda | REGION | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| BM | 1.0000000 | -0.2302612 | 0.1004755 | 0.1059263 | 0.2859499 | -0.1236307 | -0.0859131 | 0.0299427 | 0.0983453 | -0.0422956 | -0.0083119 |
| PorcMesesAlDia_6M | -0.2302612 | 1.0000000 | -0.2606972 | -0.2205515 | -0.3871559 | 0.0682109 | 0.1655208 | 0.0448443 | -0.0716597 | -0.0253385 | -0.0302654 |
| LN_Sum_SalVenDjuCCaDSCE_36M | 0.1004755 | -0.2606972 | 1.0000000 | 0.6487830 | 0.0601568 | -0.0089279 | -0.0744798 | 0.0073283 | 0.0114426 | -0.0432484 | 0.0199902 |
| r_numOpsVenc_36M | 0.1059263 | -0.2205515 | 0.6487830 | 1.0000000 | 0.0893770 | -0.0502344 | -0.0266948 | 0.0355233 | 0.0194621 | -0.0581990 | -0.0023434 |
| Prom_NumDiasVencido_12M | 0.2859499 | -0.3871559 | 0.0601568 | 0.0893770 | 1.0000000 | -0.0690272 | -0.0199390 | -0.0118496 | 0.0798750 | 0.0097563 | 0.0093893 |
| ANTIGUEDAD_TRABAJO | -0.1236307 | 0.0682109 | -0.0089279 | -0.0502344 | -0.0690272 | 1.0000000 | 0.0513511 | -0.1322516 | -0.3549288 | 0.1669440 | -0.0447375 |
| ingresoNoComprometido | -0.0859131 | 0.1655208 | -0.0744798 | -0.0266948 | -0.0199390 | 0.0513511 | 1.0000000 | 0.0421066 | -0.0179946 | -0.0681859 | -0.0553075 |
| EstadoCivil | 0.0299427 | 0.0448443 | 0.0073283 | 0.0355233 | -0.0118496 | -0.1322516 | 0.0421066 | 1.0000000 | -0.0285092 | -0.2543081 | -0.0856955 |
| RelacionLaboral | 0.0983453 | -0.0716597 | 0.0114426 | 0.0194621 | 0.0798750 | -0.3549288 | -0.0179946 | -0.0285092 | 1.0000000 | 0.0210349 | 0.0139629 |
| TipoVivienda | -0.0422956 | -0.0253385 | -0.0432484 | -0.0581990 | 0.0097563 | 0.1669440 | -0.0681859 | -0.2543081 | 0.0210349 | 1.0000000 | -0.0536148 |
| REGION | -0.0083119 | -0.0302654 | 0.0199902 | -0.0023434 | 0.0093893 | -0.0447375 | -0.0553075 | -0.0856955 | 0.0139629 | -0.0536148 | 1.0000000 |
Notemos que de esta matriz se puede observar en la primara fila, que las variables que guardan una mayor relación con la variable objetivo de mayor a menor son:
- Prom_NumDiasVencido_12M.
- PorcMesesAlDia_6M.
- ANTIGUEDAD_TRABAJO.
- r_numOpsVenc_36M.
- LN_Sum_SalVenDjuCCaDSCE_36M.
- RelacioLaboral.
- ingresoNoComprometido.
- TipoVivienda.
- EstadoCIvil.
- REGION.
Notemos que el ranking de correlación es bastante similar al arrojado por el criterio de información IV, por tanto podría realizarse un futuro modelo con las variables con mayor índice de relación con la variable objetivo.
Conclusiones
Como se vió en los gráficos uno de los posible problemas es lo desequilibrados que se encuentran los datos respecto a la variable objetivo (BM). Desde una perspectiva de modelado, un conjunto de datos desequilibrado presenta numerosos desafíos al desarrollar un modelo predictivo. Primero, un conjunto de datos desequilibrado tiende a producir un modelo con métricas de rendimiento infladas artificialmente.
Otro desafío de un conjunto de datos desequilibrado es que el modelo creado puede tener un sesgo hacia la clase representada más alta. El modelo tratará a la clase minoritaria como ruido que conduce a altos niveles de clasificación errónea.
Hay una serie de técnicas, que van de simples a complejas, que pueden ayudar a abordar los datos desequilibrados.