# Limpiamos entorno
rm(list = ls())Esta Prueba de Evaluación Continuada (PEC) cubre principalmente el material didáctico de modelos supervisados y evaluación de modelos.
Complementarios:
La descripción de las variables se puede ver en https://archive.ics.uci.edu/ml/datasets/statlog+(german+credit+data)
La variable “default” es el target siendo 1 = “No default” y 2 = “Default”. Se deben utilizar estos datos para la realización de los ejercicios.
En este ejercicio vamos a seguir los pasos del ciclo de vida de un proyecto de minería de datos, para el caso de un algoritmo de clasificación usaremos un árbol de decisión, que es el algoritmo supervisado que vamos a tratar en esta asignatura. Primero y a modo de ejemplo sencillo lo haremos con el archivo titanic.csv, que se encuentra adjunto en el aula. Este archivo contiene un registro por cada pasajero que viajaba en el Titanic. En las variables se caracteriza si era hombre o mujer, adulto o menor (niño), en qué categoría viajaba o si era miembro de la tripulación.
Se mostrará un ejemplo sencillo de solución con estos datos pero los alumnos deberéis responder a las preguntas de la rúbrica para otro conjunto: German Credit. Para este conjunto, tomaréis como referencia la variable target “default” que indica el impago de créditos. Es decir, un cliente “1=no default” es positivo, al contrario del “2-default” que viene indicado como negativo.
Objetivos:
A continuación, se plantean los puntos a realizar en la PEC 3 y, tomando como ejemplo el conjunto de datos de Titanic, se obtendrán, a modo de ejemplo, algunos resultados que pretender servir a modo de inspiración para los estudiantes. Los estudiantes deberán utilizar el conjunto de datos de “German Credit Data” que se pueden conseguir en este enlace: https://www.kaggle.com/shravan3273/credit-approval
Este recurso puede ser útil para profundizar sobre el paquete IML: https://uc-r.github.io/iml-pkg
Revisión de los datos, extracción visual de información y preparación de los datos
Carga de los datos:
data<-read.csv("./titanic.csv",header=T,sep=",")
attach(data)Empezaremos haciendo un breve análisis de los datos ya que nos interesa tener una idea general de los datos que disponemos.
Primero calcularemos las dimensiones de nuestra base de datos y analizaremos qué tipos de atributos tenemos.
Para empezar, calculamos las dimensiones de la base de datos mediante la función dim(). Obtenemos que disponemos de 2201 registros o pasajeros (filas) y 4 variables (columnas).
dim(data)## [1] 2201 4¿Cuáles son esas variables? Gracias a la función str() sabemos que las cuatro variables son categóricas o discretas, es decir, toman valores en un conjunto finito. La variable CLASS hace referencia a la clase en la que viajaban los pasajeros (1ª, 2ª, 3ª o crew), AGE determina si era adulto o niño (Adulto o Menor), la variable SEX si era hombre o mujer (Hombre o Mujer) y la última variable (SURVIVED) informa si el pasajero murió o sobrevivió en el accidente (Muere o Sobrevive).
str(data)## 'data.frame': 2201 obs. of 4 variables:
## $ CLASS : chr "1a" "1a" "1a" "1a" ...
## $ AGE : chr "Adulto" "Adulto" "Adulto" "Adulto" ...
## $ SEX : chr "Hombre" "Hombre" "Hombre" "Hombre" ...
## $ SURVIVED: chr "Sobrevive" "Sobrevive" "Sobrevive" "Sobrevive" ...Vemos que las variables están definidas como carácter, así que las transformamos a tipo factor.
data[] <- lapply(data, factor)
str(data)## 'data.frame': 2201 obs. of 4 variables:
## $ CLASS : Factor w/ 4 levels "1a","2a","3a",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ AGE : Factor w/ 2 levels "Adulto","Menor": 1 1 1 1 1 1 1 1 1 1 ...
## $ SEX : Factor w/ 2 levels "Hombre","Mujer": 1 1 1 1 1 1 1 1 1 1 ...
## $ SURVIVED: Factor w/ 2 levels "Muere","Sobrevive": 2 2 2 2 2 2 2 2 2 2 ...Es de gran interés saber si tenemos muchos valores nulos (campos vacíos) y la distribución de valores por variables. Es por ello recomendable empezar el análisis con una visión general de las variables. Mostraremos para cada atributo la cantidad de valores perdidos mediante la función summary.
summary(data)## CLASS AGE SEX SURVIVED
## 1a :325 Adulto:2092 Hombre:1731 Muere :1490
## 2a :285 Menor : 109 Mujer : 470 Sobrevive: 711
## 3a :706
## crew:885Como parte de la preparación de los datos, miraremos si hay valores missing.
missing <- data[is.na(data),]
dim(missing)## [1] 0 4Observamos fácilmente que no hay valores missing y, por tanto, no deberemos preparar los datos en este sentido. En caso de haberlos, habría que tomar decisiones para tratar los datos adecuadamente.
Disponemos por tanto de un data frame formado por cuatro variables categóricas sin valores nulos.
Para un conocimiento mayor sobre los datos, tenemos a nuestro alcance unas herramientas muy valiosas: las herramientas de visualización. Para dichas visualizaciones, haremos uso de los paquetes ggplot2, gridExtra y grid de R.
if(!require(ggplot2)){
install.packages('ggplot2', repos='http://cran.us.r-project.org')
library(ggplot2)
}## Cargando paquete requerido: ggplot2if(!require(ggpubr)){
install.packages('ggpubr', repos='http://cran.us.r-project.org')
library(ggpubr)
}## Cargando paquete requerido: ggpubrif(!require(grid)){
install.packages('grid', repos='http://cran.us.r-project.org')
library(grid)
}## Cargando paquete requerido: gridif(!require(gridExtra)){
install.packages('gridExtra', repos='http://cran.us.r-project.org')
library(gridExtra)
}## Cargando paquete requerido: gridExtraif(!require(C50)){
install.packages('C50', repos='http://cran.us.r-project.org')
library(C50)
}## Cargando paquete requerido: C50Siempre es importante analizar los datos que tenemos ya que las conclusiones dependerán de las características de la muestra.
grid.newpage()
plotbyClass<-ggplot(data,aes(CLASS))+geom_bar() +labs(x="Class", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("blue","#008000"))+ggtitle("Class")
plotbyAge<-ggplot(data,aes(AGE))+geom_bar() +labs(x="Age", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("blue","#008000"))+ggtitle("Age")
plotbySex<-ggplot(data,aes(SEX))+geom_bar() +labs(x="Sex", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("blue","#008000"))+ggtitle("Sex")
plotbySurvived<-ggplot(data,aes(SURVIVED))+geom_bar() +labs(x="Survived", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("blue","#008000"))+ggtitle("SURVIVED")
grid.arrange(plotbyClass,plotbyAge,plotbySex,plotbySurvived,ncol=2)
Claramente vemos cómo es la muestra analizando la distribución de las
variables disponibles. De cara a los informes, es mucho más interesante
esta información que la obtenida en summary, que se puede usar para
complementar.
Nos interesa describir la relación entre la supervivencia y cada uno de las variables mencionadas anteriormente. Para ello, por un lado graficaremos mediante diagramas de barras la cantidad de muertos y supervivientes según la clase en la que viajaban, la edad o el sexo. Por otro lado, para obtener los datos que estamos graficando utilizaremos el comando table para dos variables que nos proporciona una tabla de contingencia.
grid.newpage()
plotbyClass<-ggplot(data,aes(CLASS,fill=SURVIVED))+geom_bar() +labs(x="Class", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("black","#008000"))+ggtitle("Survived by Class")
plotbyAge<-ggplot(data,aes(AGE,fill=SURVIVED))+geom_bar() +labs(x="Age", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("black","#008000"))+ggtitle("Survived by Age")
plotbySex<-ggplot(data,aes(SEX,fill=SURVIVED))+geom_bar() +labs(x="Sex", y="Passengers")+ guides(fill=guide_legend(title=""))+ scale_fill_manual(values=c("black","#008000"))+ggtitle("Survived by Sex")
grid.arrange(plotbyClass,plotbyAge,plotbySex,ncol=2)
De estos gráficos obtenemos información muy valiosa que complementamos con las tablas de contingencia (listadas abajo). Por un lado, la cantidad de pasajeros que sobrevivieron es similar en hombres y mujeres (hombres: 367 y mujeres 344). No, en cambio, si tenemos en cuenta el porcentaje respecto a su sexo. Es decir, pese a que la cantidad de mujeres y hombres que sobrevivieron es pareja, viajaban más hombres que mujeres (470 mujeres y 1731 hombres), por lo tanto, la tasa de muerte en hombres es muchísimo mayor (el 78,79% de los hombres murieron mientras que en mujeres ese porcentaje baja a 26,8%).
En cuanto a la clase en la que viajaban, los pasajeros que viajaban en primera clase fueron los únicos que el porcentaje de supervivencia era mayor que el de mortalidad. El 62,46% de los viajeros de primera clase sobrevivió, el 41,4% de los que viajaban en segunda clase mientras que de los viajeros de tercera y de la tripulación solo sobrevivieron un 25,21% y 23,95% respectivamente. Para finalizar, destacamos que la presencia de pasajeros adultos era mucho mayor que la de los niños (2092 frente a 109) y que la tasa de supervivencia en niños fue mucho mayor (52,29% frente a 31,26%), no podemos obviar, en cambio, que los únicos niños que murieron fueron todos pasajeros de tercera clase (52 niños).
tabla_SST <- table(SEX, SURVIVED)
tabla_SST## SURVIVED
## SEX Muere Sobrevive
## Hombre 1364 367
## Mujer 126 344prop.table(tabla_SST, margin = 1)## SURVIVED
## SEX Muere Sobrevive
## Hombre 0.7879838 0.2120162
## Mujer 0.2680851 0.7319149tabla_SCT <- table(CLASS,SURVIVED)
tabla_SCT## SURVIVED
## CLASS Muere Sobrevive
## 1a 122 203
## 2a 167 118
## 3a 528 178
## crew 673 212prop.table(tabla_SCT, margin = 1)## SURVIVED
## CLASS Muere Sobrevive
## 1a 0.3753846 0.6246154
## 2a 0.5859649 0.4140351
## 3a 0.7478754 0.2521246
## crew 0.7604520 0.2395480tabla_SAT <- table(AGE,SURVIVED)
tabla_SAT## SURVIVED
## AGE Muere Sobrevive
## Adulto 1438 654
## Menor 52 57prop.table(tabla_SAT, margin = 1) ## SURVIVED
## AGE Muere Sobrevive
## Adulto 0.6873805 0.3126195
## Menor 0.4770642 0.5229358tabla_SAT.byClass <- table(AGE,SURVIVED,CLASS)
tabla_SAT.byClass## , , CLASS = 1a
##
## SURVIVED
## AGE Muere Sobrevive
## Adulto 122 197
## Menor 0 6
##
## , , CLASS = 2a
##
## SURVIVED
## AGE Muere Sobrevive
## Adulto 167 94
## Menor 0 24
##
## , , CLASS = 3a
##
## SURVIVED
## AGE Muere Sobrevive
## Adulto 476 151
## Menor 52 27
##
## , , CLASS = crew
##
## SURVIVED
## AGE Muere Sobrevive
## Adulto 673 212
## Menor 0 0Los resultados anteriores muestran los datos de forma descriptiva, podemos añadir algún test estadístico para validar el grado de significancia de la relación. La librería “DescTools” nos permite instalarlo fácilmente.
if(!require(DescTools)){
install.packages('DescTools', repos='http://cran.us.r-project.org')
library(DescTools)
}## Cargando paquete requerido: DescToolsPhi(tabla_SST) ## [1] 0.4556048CramerV(tabla_SST) ## [1] 0.4556048Phi(tabla_SAT) ## [1] 0.09757511CramerV(tabla_SAT) ## [1] 0.09757511Phi(tabla_SCT) ## [1] 0.2941201CramerV(tabla_SCT) ## [1] 0.2941201Valores de la V de Cramér (https://en.wikipedia.org/wiki/Cramér%27s_V) y Phi (https://en.wikipedia.org/wiki/Phi_coefficient) entre 0.1 y 0.3 nos indican que la asociación estadística es baja, y entre 0.3 y 0.5 se puede considerar una asociación media. Finalmente, si los valores fueran superiores a 0.5 (no es el caso), la asociación estadística entre las variables sería alta. Como se puede apreciar, los valores de Phi y V coinciden. Esto ocurre en el contexto de analizar tablas de contingencia 2x2.
Una alternativa interesante a las barras de diagramas, es el plot de las tablas de contingencia. Obtenemos la misma información pero para algunos receptores puede resultar más visual.
par(mfrow=c(2,2))
plot(tabla_SCT, col = c("black","#008000"), main = "SURVIVED vs. CLASS")
plot(tabla_SAT, col = c("black","#008000"), main = "SURVIVED vs. AGE")
plot(tabla_SST, col = c("black","#008000"), main = "SURVIVED vs. SEX")
Nuestro objetivo es crear un árbol de decisión que permita analizar qué tipo de pasajero del Titanic tenía probabilidades de sobrevivir o no. Por lo tanto, la variable por la que clasificaremos es el campo de si el pasajero sobrevivió o no. De todas maneras, al imprimir las primeras (con head) y últimas 10 (con tail) filas nos damos cuenta de que los datos están ordenados.
head(data,10)## CLASS AGE SEX SURVIVED
## 1 1a Adulto Hombre Sobrevive
## 2 1a Adulto Hombre Sobrevive
## 3 1a Adulto Hombre Sobrevive
## 4 1a Adulto Hombre Sobrevive
## 5 1a Adulto Hombre Sobrevive
## 6 1a Adulto Hombre Sobrevive
## 7 1a Adulto Hombre Sobrevive
## 8 1a Adulto Hombre Sobrevive
## 9 1a Adulto Hombre Sobrevive
## 10 1a Adulto Hombre Sobrevivetail(data,10)## CLASS AGE SEX SURVIVED
## 2192 crew Adulto Mujer Sobrevive
## 2193 crew Adulto Mujer Sobrevive
## 2194 crew Adulto Mujer Sobrevive
## 2195 crew Adulto Mujer Sobrevive
## 2196 crew Adulto Mujer Sobrevive
## 2197 crew Adulto Mujer Sobrevive
## 2198 crew Adulto Mujer Sobrevive
## 2199 crew Adulto Mujer Muere
## 2200 crew Adulto Mujer Muere
## 2201 crew Adulto Mujer MuerePara la futura evaluación del árbol de decisión, es necesario dividir el conjunto de datos en un conjunto de entrenamiento y un conjunto de prueba. El conjunto de entrenamiento es el subconjunto del conjunto original de datos utilizado para construir un primer modelo; y el conjunto de prueba, el subconjunto del conjunto original de datos utilizado para evaluar la calidad del modelo.
Lo más correcto será utilizar un conjunto de datos diferente del que utilizamos para construir el árbol, es decir, un conjunto diferente del de entrenamiento. No hay ninguna proporción fijada con respecto al número relativo de componentes de cada subconjunto, pero la más utilizada acostumbra a ser 2/3 para el conjunto de entrenamiento y 1/3, para el conjunto de prueba.
La variable por la que clasificaremos es el campo de si el pasajero sobrevivió o no, que está en la cuarta columna. De esta forma, tendremos un conjunto de datos para el entrenamiento y uno para la validación
set.seed(666)
y <- data[,4]
X <- data[,1:3] De forma dinámica podemos definir una forma de separar los datos en función de un parámetro. Así, definimos un parámetro que controla el split de forma dinámica en el test.
split_prop <- 3
indexes = sample(1:nrow(data), size=floor(((split_prop-1)/split_prop)*nrow(data)))
trainX<-X[indexes,]
trainy<-y[indexes]
testX<-X[-indexes,]
testy<-y[-indexes]Después de una extracción aleatoria de casos es altamente recomendable efectuar un análisis de datos mínimo para asegurarnos de no obtener clasificadores sesgados por los valores que contiene cada muestra. En este caso, verificaremos que la proporción del supervivientes es más o menos constante en los dos conjuntos:
summary(trainX);## CLASS AGE SEX
## 1a :208 Adulto:1395 Hombre:1153
## 2a :185 Menor : 72 Mujer : 314
## 3a :477
## crew:597summary(trainy)## Muere Sobrevive
## 997 470summary(testX)## CLASS AGE SEX
## 1a :117 Adulto:697 Hombre:578
## 2a :100 Menor : 37 Mujer :156
## 3a :229
## crew:288summary(testy)## Muere Sobrevive
## 493 241Verificamos fácilmente que no hay diferencias graves que puedan sesgar las conclusiones.
Se crea el árbol de decisión usando los datos de entrenamiento (no hay que olvidar que la variable outcome es de tipo factor):
trainy <- as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE )
summary(model)##
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Mon May 19 05:09:39 2025
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 1467 cases (4 attributes) from undefined.data
##
## Rules:
##
## Rule 1: (1153/243, lift 1.2)
## SEX = Hombre
## -> class Muere [0.789]
##
## Rule 2: (477/123, lift 1.1)
## CLASS = 3a
## -> class Muere [0.741]
##
## Rule 3: (178/15, lift 2.8)
## CLASS in {1a, 2a, crew}
## SEX = Mujer
## -> class Sobrevive [0.911]
##
## Default class: Muere
##
##
## Evaluation on training data (1467 cases):
##
## Rules
## ----------------
## No Errors
##
## 3 322(21.9%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 982 15 (a): class Muere
## 307 163 (b): class Sobrevive
##
##
## Attribute usage:
##
## 90.73% SEX
## 44.65% CLASS
##
##
## Time: 0.0 secsErrors muestra el número y porcentaje de casos mal clasificados en el subconjunto de entrenamiento. El árbol obtenido clasifica erróneamente 322 de los 1467 casos dados, una tasa de error del 21.9%.
A partir del árbol de decisión de dos hojas que hemos modelado, se pueden extraer las siguientes reglas de decisión (gracias a rules=TRUE podemos imprimir las reglas directamente):
SEX = “Hombre” → Muere. Validez: 78,9%
CLASS “3ª” → Muere. Validez: 74,1%
CLASS “1ª”, “2ª”, “crew” y SEX = “Mujer” → Sobrevive. Validez: 91,1%
Por tanto, podemos concluir que el conocimiento extraído y cruzado con el análisis visual se resume en “las mujeres y los niños primero a excepción de que fueras de 3ª clase”.
A continuación, mostramos el árbol obtenido.
model <- C50::C5.0(trainX, trainy)
plot(model,gp = gpar(fontsize = 9.5))
Una vez tenemos el modelo, podemos comprobar su calidad prediciendo la clase para los datos de prueba que nos hemos reservado al principio.
predicted_model <- predict( model, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))## [1] "La precisión del árbol es: 78.8828 %"Cuando hay pocas clases, la calidad de la predicción se puede analizar mediante una matriz de confusión que identifica los tipos de errores cometidos.
mat_conf<-table(testy,Predicted=predicted_model)
mat_conf## Predicted
## testy Muere Sobrevive
## Muere 488 5
## Sobrevive 150 91Otra manera de calcular el porcentaje de registros correctamente clasificados usando la matriz de confusión:
porcentaje_correct<-100 * sum(diag(mat_conf)) / sum(mat_conf)
print(sprintf("El %% de registros correctamente clasificados es: %.4f %%",porcentaje_correct))## [1] "El % de registros correctamente clasificados es: 78.8828 %"Además, tenemos a nuestra disposición el paquete gmodels para obtener información más completa:
if(!require(gmodels)){
install.packages('gmodels', repos='http://cran.us.r-project.org')
library(gmodels)
}## Cargando paquete requerido: gmodels## Registered S3 method overwritten by 'gdata':
## method from
## reorder.factor DescToolsCrossTable(testy, predicted_model,prop.chisq = FALSE, prop.c = FALSE, prop.r =FALSE,dnn = c('Reality', 'Prediction'))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 734
##
##
## | Prediction
## Reality | Muere | Sobrevive | Row Total |
## -------------|-----------|-----------|-----------|
## Muere | 488 | 5 | 493 |
## | 0.665 | 0.007 | |
## -------------|-----------|-----------|-----------|
## Sobrevive | 150 | 91 | 241 |
## | 0.204 | 0.124 | |
## -------------|-----------|-----------|-----------|
## Column Total | 638 | 96 | 734 |
## -------------|-----------|-----------|-----------|
##
## En este apartado buscaremos probar con las variaciones que nos ofrece el paquete C5.0 para analizar cómo afectan a la creación de los árboles generados. Existen muchas posibles variaciones con otras funciones que podéis investigar. La idea es seguir con el enfoque de árboles de decisión explorando posibles opciones. Una vez tengamos un método alternativo, debemos analizar cómo se modifica el árbol y cómo afecta a la capacidad predictiva en el conjunto de test.
A continuación, utilizamos otro enfoque para comparar los resultados: incorpora como novedad “adaptative boosting”, basado en el trabajo Rob Schapire and Yoav Freund (1999). La idea de esta técnica es generar varios clasificadores, con sus correspondientes arboles de decisión y su ser de reglas. Cuando un nuevo caso va a ser clasificado, cada clasificador vota cual es la clase predicha. Los votos son sumados y determina la clase final.
modelo2 <- C50::C5.0(trainX, trainy, trials = 10)
plot(modelo2,gp = gpar(fontsize = 9.5))
En este caso, dada la simplicidad del conjunto de ejemplo, no se aprecian diferencias, pero aparecerán en datos de mayor complejidad y modificando el parámetro “trials” se puede intentar mejorar los resultados.
Vemos a continuación cómo son las predicciones del nuevo árbol:
predicted_model2 <- predict( modelo2, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model2 == testy) / length(predicted_model2)))## [1] "La precisión del árbol es: 75.0681 %"Observamos como se modifica levemente la precisión del modelo a mejor.
mat_conf<-table(testy,Predicted=predicted_model2)
mat_conf## Predicted
## testy Muere Sobrevive
## Muere 438 55
## Sobrevive 128 113Otra manera de calcular el porcentaje de registros correctamente clasificados usando la matriz de confusión:
porcentaje_correct<-100 * sum(diag(mat_conf)) / sum(mat_conf)
print(sprintf("El %% de registros correctamente clasificados es: %.4f %%",porcentaje_correct))## [1] "El % de registros correctamente clasificados es: 75.0681 %"El algoritmo C5.0 incorpora algunas opciones para ver la importancia de las variables (ver documentación para los detalles entre los dos métodos):
importancia_usage <- C50::C5imp(modelo2, metric = "usage")
importancia_splits <- C50::C5imp(modelo2, metric = "splits")
importancia_usage## Overall
## CLASS 100.00
## SEX 100.00
## AGE 93.73importancia_splits## Overall
## CLASS 40
## SEX 40
## AGE 20Curiosamente y aunque el conjunto de datos es muy sencillo, se aprecian diferencias en los métodos de importancia de las variables. Se recomienda en vuestro ejercicio mejorar la visualización de los resultados con la función ggplo2 o similar.
Nos interesa saber para las predicciones que variable son las que tienen más influencia. Así, probaremos con un enfoque algorítmico de Random Forest y obtendremos métricas de interpretabilidad con la librería IML (https://cran.r-project.org/web/packages/iml/iml.pdf). As:
if(!require(randomForest)){
install.packages('randomForest',repos='http://cran.us.r-project.org')
library(randomForest)
}## Cargando paquete requerido: randomForest## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Adjuntando el paquete: 'randomForest'## The following object is masked from 'package:gridExtra':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginif(!require(iml)){
install.packages('iml', repos='http://cran.us.r-project.org')
library(iml)
}## Cargando paquete requerido: imlEmpezamos ejecutado un Random Forest:
train.data <- as.data.frame(cbind(trainX,trainy))
colnames(train.data)[4] <- "SURVIVED"
rf <- randomForest(SURVIVED ~ ., data = train.data, ntree = 50)Podemos medir y graficar la importancia de cada variable para las predicciones del random forest con FeatureImp. La medida se basa funciones de pérdida de rendimiento que en nuestro caso será con el objetivo de clasificación (“ce”).
X <- train.data[which(names(train.data) != "SURVIVED")]
predictor <- Predictor$new(rf, data = X, y = train.data$SURVIVED)
imp <- FeatureImp$new(predictor, loss = "ce")
plot(imp)
imp$results## feature importance.05 importance importance.95 permutation.error
## 1 SEX 1.702194 1.771160 1.826332 0.3851397
## 2 AGE 1.053292 1.056426 1.062069 0.2297205
## 3 CLASS 1.014420 1.028213 1.040125 0.2235855Adicionalmente, podemos también dibujar los efectos locales acumulados (ALE) de la variable usando la libreria patchwork:
if(!require(patchwork)){
install.packages('patchwork',repos='http://cran.us.r-project.org')
library(patchwork)
}## Cargando paquete requerido: patchwork##
## Adjuntando el paquete: 'patchwork'## The following object is masked from 'package:MASS':
##
## areaeffs <- FeatureEffects$new(predictor)
plot(effs)
Como podemos ver, el género es la variable con más importancia para las predicciones, siendo las mujeres mucho más propensas a sobrevivir. > Nota: Se espera que los alumnos profundicen en la función de cara a la resolución de los ejercicios.
Para el conjunto de datos German Credit, los alumnos deben completar aquí la solución a la PEC3 que consiste de los siguientes apartados. El formato de entrega es como en las anteriores PECs: usernameestudiant-PECn.html (o PDF/HTML) y el código .Rmd. Se debe entregar la PEC en el buzón de entregas del aula, como en las anteriores PECs.
(Obligatorio) Se debe realizar un breve informe (Html) donde se respondan a las preguntas concretas, mostrando en primer lugar el código utilizado, luego los resultados y posteriormente los comentarios que se consideren pertinentes para cada apartado.
Realizar un primer análisis descriptivo, preparando y acondicionando correctamente los datos. Sucesivamente realizar un análisis de correlaciones de las variables. Es importante en este apartado entender bien los datos antes de seguir con los análisis posteriores. Lista todo lo que te haya sorprendido de los datos.
Evaluación:
Realizar un primer árbol de decisión. Puedes decidir utilizar todas las variables o, de forma justificada, quitar alguna para el ajuste del modelo.
Evaluación:
Con el árbol obtenido, realiza una breve explicación de las reglas obtenidas así como de todos los puntos que te parezcan interesantes. Un elemento a considerar es, por ejemplo, cuantas observaciones caen dentro de cada regla.
Evaluación:
Una vez tengas un modelo válido, procede a realizar un análisis de la bondad de ajuste sobre el conjunto de test y matriz de confusión. ¿Te parece un modelo suficientemente bueno como para utilizarlo? Justifica tu respuesta considerando todos los posibles tipos de error.
Evaluación:
Con un enfoque parecido a los puntos anteriores y considerando las mismas variables, enriquece el ejercicio mediante el ajuste de modelos de árbol de decisión complementarios. Por ejemplo, crear el modelo con todos los datos y validación cruzada; probar el boosting o variar el pruning, etc. ¿Es el nuevo enfoque mejor que el original? Justifica la respuesta.
Evaluación:
Haz un resumen de las principales conclusiones de todos los análisis y modelos realizados.
Evaluación:
…
El conjunto de datos contiene información sobre solicitantes de crédito de un banco alemán. Cada fila representa a un cliente e incluye una serie de atributos demográficos y financieros, así como la clasificación de riesgo crediticio del cliente (bueno o malo). Este tipo de datos es común en la industria financiera y se utiliza para desarrollar modelos de evaluación de riesgos y automatizar la toma de decisiones sobre la aprobación de créditos.
La variable es la variable objetivo en el análisis de riesgo crediticio. Toma el valor 1 cuando el cliente no incurre en impago () y el valor 2 cuando el cliente incurre en impago (), es decir, no cumple con el pago de su deuda.
El objetivo principal de estos datos es permitir la construcción de modelos predictivos que puedan predecir con precisión el riesgo crediticio de un solicitante de crédito. Estos modelos pueden utilizarse para:
La fuente de los datos es el repositorio de aprendizaje automático de la UCI (), accesible a través de Kaggle: .
Los datos fueron originalmente recopilados por el profesor Dr. Hans Hofmann del . Esta fuente es comúnmente utilizada en la investigación y evaluación de modelos de aprendizaje automático en el ámbito crediticio.
# Lista de librerías necesarias
librerias <- c("readr", "dplyr", "ggplot2", "corrplot", "C50", "gmodels",
"factoextra", "cluster", "randomForest", "iml", "ggpubr",
"gridExtra", "patchwork", "e1071", "corrplot")
# Instalación de las librerías
for (lib in librerias) {
if (!requireNamespace(lib, quietly = TRUE)) {
install.packages(lib)
}
}# CarGa de los datos
credit<-read.csv("credit.csv",header=TRUE,sep=",")
head(credit)## checking_balance months_loan_duration credit_history purpose amount
## 1 < 0 DM 6 critical radio/tv 1169
## 2 1 - 200 DM 48 repaid radio/tv 5951
## 3 unknown 12 critical education 2096
## 4 < 0 DM 42 repaid furniture 7882
## 5 < 0 DM 24 delayed car (new) 4870
## 6 unknown 36 repaid education 9055
## savings_balance employment_length installment_rate personal_status
## 1 unknown > 7 yrs 4 single male
## 2 < 100 DM 1 - 4 yrs 2 female
## 3 < 100 DM 4 - 7 yrs 2 single male
## 4 < 100 DM 4 - 7 yrs 2 single male
## 5 < 100 DM 1 - 4 yrs 3 single male
## 6 unknown 1 - 4 yrs 2 single male
## other_debtors residence_history property age installment_plan
## 1 none 4 real estate 67 none
## 2 none 2 real estate 22 none
## 3 none 3 real estate 49 none
## 4 guarantor 4 building society savings 45 none
## 5 none 4 unknown/none 53 none
## 6 none 4 unknown/none 35 none
## housing existing_credits default dependents telephone foreign_worker
## 1 own 2 1 1 yes yes
## 2 own 1 2 1 none yes
## 3 own 1 1 2 none yes
## 4 for free 1 1 2 none yes
## 5 for free 2 2 2 none yes
## 6 for free 1 1 2 yes yes
## job
## 1 skilled employee
## 2 skilled employee
## 3 unskilled resident
## 4 skilled employee
## 5 skilled employee
## 6 unskilled residentPara empezar, calculamos las dimensiones de la base de datos mediante la función dim(). Obtenemos que disponemos de 1000 registros o clientes (filas) y 21 variables (columnas).
dim(credit)## [1] 1000 21Verificamos la estructura del juego de datos, el número de columnas y el tipo de datos que contiene, y un ejemplo de sus valores.
# Mostramos la estructura de los datos
str(credit)## 'data.frame': 1000 obs. of 21 variables:
## $ checking_balance : chr "< 0 DM" "1 - 200 DM" "unknown" "< 0 DM" ...
## $ months_loan_duration: int 6 48 12 42 24 36 24 36 12 30 ...
## $ credit_history : chr "critical" "repaid" "critical" "repaid" ...
## $ purpose : chr "radio/tv" "radio/tv" "education" "furniture" ...
## $ amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ savings_balance : chr "unknown" "< 100 DM" "< 100 DM" "< 100 DM" ...
## $ employment_length : chr "> 7 yrs" "1 - 4 yrs" "4 - 7 yrs" "4 - 7 yrs" ...
## $ installment_rate : int 4 2 2 2 3 2 3 2 2 4 ...
## $ personal_status : chr "single male" "female" "single male" "single male" ...
## $ other_debtors : chr "none" "none" "none" "guarantor" ...
## $ residence_history : int 4 2 3 4 4 4 4 2 4 2 ...
## $ property : chr "real estate" "real estate" "real estate" "building society savings" ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ installment_plan : chr "none" "none" "none" "none" ...
## $ housing : chr "own" "own" "own" "for free" ...
## $ existing_credits : int 2 1 1 1 2 1 1 1 1 2 ...
## $ default : int 1 2 1 1 2 1 1 1 1 2 ...
## $ dependents : int 1 1 2 2 2 2 1 1 1 1 ...
## $ telephone : chr "yes" "none" "none" "none" ...
## $ foreign_worker : chr "yes" "yes" "yes" "yes" ...
## $ job : chr "skilled employee" "skilled employee" "unskilled resident" "skilled employee" ...Revisamos la descripción de las variables contenidas en el fichero y si los tipos de variables se corresponden con las que hemos cargado. Las organizamos lógicamente para darles sentido y construimos un pequeño diccionario de datos utilizando la documentación auxiliar.
# Revisamos el tipo de cada variable
sapply(credit, class)## checking_balance months_loan_duration credit_history
## "character" "integer" "character"
## purpose amount savings_balance
## "character" "integer" "character"
## employment_length installment_rate personal_status
## "character" "integer" "character"
## other_debtors residence_history property
## "character" "integer" "character"
## age installment_plan housing
## "integer" "character" "character"
## existing_credits default dependents
## "integer" "integer" "integer"
## telephone foreign_worker job
## "character" "character" "character"Es una buena práctica crear una copia del dataset y trabajar sobre ella con el propósito de no perder las propiedades del original.
# Copia dataset credit
df_credit <- creditTransformamos las variables están definidas como carácter a tipo factor y comprobamos
# Conversión de char a factor
chars <- sapply(df_credit, is.character)
df_credit[chars] <- lapply(df_credit[chars], factor)
str(df_credit)## 'data.frame': 1000 obs. of 21 variables:
## $ checking_balance : Factor w/ 4 levels "< 0 DM","> 200 DM",..: 1 3 4 1 1 4 4 3 4 3 ...
## $ months_loan_duration: int 6 48 12 42 24 36 24 36 12 30 ...
## $ credit_history : Factor w/ 5 levels "critical","delayed",..: 1 5 1 5 2 5 5 5 5 1 ...
## $ purpose : Factor w/ 10 levels "business","car (new)",..: 8 8 5 6 2 5 6 3 8 2 ...
## $ amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ savings_balance : Factor w/ 5 levels "< 100 DM","> 1000 DM",..: 5 1 1 1 1 5 4 1 2 1 ...
## $ employment_length : Factor w/ 5 levels "> 7 yrs","0 - 1 yrs",..: 1 3 4 4 3 3 1 3 4 5 ...
## $ installment_rate : int 4 2 2 2 3 2 3 2 2 4 ...
## $ personal_status : Factor w/ 4 levels "divorced male",..: 4 2 4 4 4 4 4 4 1 3 ...
## $ other_debtors : Factor w/ 3 levels "co-applicant",..: 3 3 3 2 3 3 3 3 3 3 ...
## $ residence_history : int 4 2 3 4 4 4 4 2 4 2 ...
## $ property : Factor w/ 4 levels "building society savings",..: 3 3 3 1 4 4 1 2 3 2 ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ installment_plan : Factor w/ 3 levels "bank","none",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ housing : Factor w/ 3 levels "for free","own",..: 2 2 2 1 1 1 2 3 2 2 ...
## $ existing_credits : int 2 1 1 1 2 1 1 1 1 2 ...
## $ default : int 1 2 1 1 2 1 1 1 1 2 ...
## $ dependents : int 1 1 2 2 2 2 1 1 1 1 ...
## $ telephone : Factor w/ 2 levels "none","yes": 2 1 1 1 1 2 1 2 1 1 ...
## $ foreign_worker : Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ job : Factor w/ 4 levels "mangement self-employed",..: 2 2 4 2 2 4 2 1 4 1 ...Obtenemos los valores únicos de las variables categoricas y numéricas.
# v. categoricas
df_fac <- df_credit[sapply(df_credit, is.factor)]
cat("Número de valores únicos por variable categórica (factor):\n")## Número de valores únicos por variable categórica (factor):for (colname in names(df_fac)) {
num_unique <- length(unique(df_fac[[colname]]))
cat(colname, "=", num_unique, "\n")
}## checking_balance = 4
## credit_history = 5
## purpose = 10
## savings_balance = 5
## employment_length = 5
## personal_status = 4
## other_debtors = 3
## property = 4
## installment_plan = 3
## housing = 3
## telephone = 2
## foreign_worker = 2
## job = 4# V. numériccas
df_num <- df_credit[sapply(df_credit, is.numeric)]
cat("Número de valores únicos por variable numérica:\n")## Número de valores únicos por variable numérica:for (colname in names(df_num)) {
num_unique <- length(unique(df_num[[colname]]))
cat(colname, "=", num_unique, "\n")
}## months_loan_duration = 33
## amount = 921
## installment_rate = 4
## residence_history = 4
## age = 53
## existing_credits = 4
## default = 2
## dependents = 2En el análisis de datos crediticios, encontramos variables numéricas con muy pocos valores únicos que, en realidad, representan categorías discretas. Tales como la tasa de cuota (, con valores de 1 a 4), el número de créditos existentes (, también de 1 a 4), la variable objetivo de impago (, con valores 1 y 2), y el número de personas a cargo (, valores 1 y 2). Aunque estas variables se almacenan como numéricas, su naturaleza categórica las hace más adecuadas para ser tratadas como factores. Esta transformación permite construir modelos más interpretables, facilita el uso de algoritmos que diferencian entre variables continuas y categóricas, y posibilita análisis descriptivos como tablas de frecuencias, proporciones y visualizaciones con diagramas de barras.
# Conversión de v.numericas a factor
df_credit$installment_rate <- as.factor(df_credit$installment_rate)
df_credit$residence_history <- as.factor(df_credit$residence_history)
df_credit$existing_credits <- as.factor(df_credit$existing_credits)
df_credit$default <- as.factor(df_credit$default)
df_credit$dependents <- as.factor(df_credit$dependents)
# Verificamos
str(df_credit)## 'data.frame': 1000 obs. of 21 variables:
## $ checking_balance : Factor w/ 4 levels "< 0 DM","> 200 DM",..: 1 3 4 1 1 4 4 3 4 3 ...
## $ months_loan_duration: int 6 48 12 42 24 36 24 36 12 30 ...
## $ credit_history : Factor w/ 5 levels "critical","delayed",..: 1 5 1 5 2 5 5 5 5 1 ...
## $ purpose : Factor w/ 10 levels "business","car (new)",..: 8 8 5 6 2 5 6 3 8 2 ...
## $ amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ savings_balance : Factor w/ 5 levels "< 100 DM","> 1000 DM",..: 5 1 1 1 1 5 4 1 2 1 ...
## $ employment_length : Factor w/ 5 levels "> 7 yrs","0 - 1 yrs",..: 1 3 4 4 3 3 1 3 4 5 ...
## $ installment_rate : Factor w/ 4 levels "1","2","3","4": 4 2 2 2 3 2 3 2 2 4 ...
## $ personal_status : Factor w/ 4 levels "divorced male",..: 4 2 4 4 4 4 4 4 1 3 ...
## $ other_debtors : Factor w/ 3 levels "co-applicant",..: 3 3 3 2 3 3 3 3 3 3 ...
## $ residence_history : Factor w/ 4 levels "1","2","3","4": 4 2 3 4 4 4 4 2 4 2 ...
## $ property : Factor w/ 4 levels "building society savings",..: 3 3 3 1 4 4 1 2 3 2 ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ installment_plan : Factor w/ 3 levels "bank","none",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ housing : Factor w/ 3 levels "for free","own",..: 2 2 2 1 1 1 2 3 2 2 ...
## $ existing_credits : Factor w/ 4 levels "1","2","3","4": 2 1 1 1 2 1 1 1 1 2 ...
## $ default : Factor w/ 2 levels "1","2": 1 2 1 1 2 1 1 1 1 2 ...
## $ dependents : Factor w/ 2 levels "1","2": 1 1 2 2 2 2 1 1 1 1 ...
## $ telephone : Factor w/ 2 levels "none","yes": 2 1 1 1 1 2 1 2 1 1 ...
## $ foreign_worker : Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ job : Factor w/ 4 levels "mangement self-employed",..: 2 2 4 2 2 4 2 1 4 1 ...Resumen estadístico básico del conjunto de los datos
Para las variables numéricas proporciona los valores del min, primer cuartil (25%), mediana (50%), mean, tercer cuartil (75%) y máx. Y, para las variables categóricas (de tipo factor) devuelve el recuento de observaciones de cada categoría.
# Estadísticos básicos
summary(df_credit)## checking_balance months_loan_duration credit_history
## < 0 DM :274 Min. : 4.0 critical :293
## > 200 DM : 63 1st Qu.:12.0 delayed : 88
## 1 - 200 DM:269 Median :18.0 fully repaid : 40
## unknown :394 Mean :20.9 fully repaid this bank: 49
## 3rd Qu.:24.0 repaid :530
## Max. :72.0
##
## purpose amount savings_balance employment_length
## radio/tv :280 Min. : 250 < 100 DM :603 > 7 yrs :253
## car (new) :234 1st Qu.: 1366 > 1000 DM : 48 0 - 1 yrs :172
## furniture :181 Median : 2320 101 - 500 DM :103 1 - 4 yrs :339
## car (used):103 Mean : 3271 501 - 1000 DM: 63 4 - 7 yrs :174
## business : 97 3rd Qu.: 3972 unknown :183 unemployed: 62
## education : 50 Max. :18424
## (Other) : 55
## installment_rate personal_status other_debtors residence_history
## 1:136 divorced male: 50 co-applicant: 41 1:130
## 2:231 female :310 guarantor : 52 2:308
## 3:157 married male : 92 none :907 3:149
## 4:476 single male :548 4:413
##
##
##
## property age installment_plan housing
## building society savings:232 Min. :19.00 bank :139 for free:108
## other :332 1st Qu.:27.00 none :814 own :713
## real estate :282 Median :33.00 stores: 47 rent :179
## unknown/none :154 Mean :35.55
## 3rd Qu.:42.00
## Max. :75.00
##
## existing_credits default dependents telephone foreign_worker
## 1:633 1:700 1:845 none:596 no : 37
## 2:333 2:300 2:155 yes :404 yes:963
## 3: 28
## 4: 6
##
##
##
## job
## mangement self-employed:148
## skilled employee :630
## unemployed non-resident: 22
## unskilled resident :200
##
##
## El conjunto de datos contiene 1,000 observaciones y 21 variables. Entre las variables numéricas, el importe del crédito () presenta una media de 3,271 DM y una mediana de 2,320 DM, con valores comprendidos entre 250 y 18,424 DM. La duración media del préstamo () es de 20,9 meses, mientras que la edad de los solicitantes varía entre 19 y 75 años, con una media de 35,5 años. La tasa de la cuota () es mayoritariamente de 2 a 4 y el número de créditos existentes rara vez supera los dos. La mayoría de los solicitantes solo tienen una persona a su cargo.
Respecto a las variables categóricas, destaca que el balance en
cuenta corriente es principalmente
$<$ 0 DM'' ounknown’‘, y la categoría más frecuente en
el historial crediticio es
repaid''. Los propósitos de los préstamos más habituales sonradio/tv’‘,
car (new)'' yfurniture’‘. En cuanto al estado laboral,
predomina el perfil de ``skilled employee’’, y la mayor parte de los
solicitantes reside en viviendas propias. Más del 95,% de los
solicitantes disponen de teléfono y son trabajadores no extranjeros. Por
último, la variable objetivo () presenta una media de 1,3, lo que indica
que aproximadamente el 30,% de los solicitantes presentan problemas de
impago o retraso en el pago.
En conjunto, el dataset ofrece una estructura representativa de un problema de scoring crediticio, con predominio de variables categóricas y una información numérica suficiente para el análisis y la construcción de modelos predictivos.
# Comprobamos la presencia de NAs
sum(is.na(df_credit))## [1] 0# NAs por columna
colSums(is.na(df_credit))## checking_balance months_loan_duration credit_history
## 0 0 0
## purpose amount savings_balance
## 0 0 0
## employment_length installment_rate personal_status
## 0 0 0
## other_debtors residence_history property
## 0 0 0
## age installment_plan housing
## 0 0 0
## existing_credits default dependents
## 0 0 0
## telephone foreign_worker job
## 0 0 0# Detectamos de strings vacíos (""). Solo tipo factor
sapply(df_credit, function(x) sum(x == "", na.rm = TRUE))## checking_balance months_loan_duration credit_history
## 0 0 0
## purpose amount savings_balance
## 0 0 0
## employment_length installment_rate personal_status
## 0 0 0
## other_debtors residence_history property
## 0 0 0
## age installment_plan housing
## 0 0 0
## existing_credits default dependents
## 0 0 0
## telephone foreign_worker job
## 0 0 0Verificamos visualmente que el dataset está limpio de valores NA y vacios.
# Libreria para graficar los valors NA y vacios
install.packages("naniar", repos = "https://cran.es.r-project.org/")## Installing package into 'C:/Users/Sue NC/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## package 'naniar' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\Sue NC\AppData\Local\Temp\Rtmp6hAOIr\downloaded_packageslibrary(naniar)
# Visualiza el % de NA por variable (barra)
gg_miss_var(df_credit)
# Visualiza el patrón de NA por observación y variable (heatmap)
gg_miss_case(df_credit)
# Densidad del importe solicitado por clase de riesgo
ggplot(df_credit, aes(x = amount, fill = default)) +
geom_density(alpha = 0.5) +
labs(title = "Distribución del importe por clase de riesgo", x = "Importe solicitado", fill = "Riesgo") +
theme_minimal()
# Boxplot del importe por clase de riesgo
ggplot(df_credit, aes(x = default, y = amount, fill = default)) +
geom_boxplot() +
labs(title = "Boxplot de importe por clase de riesgo", x = "Riesgo", y = "Importe solicitado") +
theme_minimal()
# Detección de Outliers de la v. numérica
boxplot(df_credit$amount, main="Boxplot del importe solicitado", col="skyblue")
Q1 <- quantile(df_credit$amount, 0.25)
Q3 <- quantile(df_credit$amount, 0.75)
IQR <- Q3 - Q1
lower <- Q1 - 1.5 * IQR
upper <- Q3 + 1.5 * IQR
outliers <- df_credit$amount[df_credit$amount < lower | df_credit$amount > upper]
cat("Cantidad de outliers:", length(outliers), "\n")## Cantidad de outliers: 72El análisis visual mediante el boxplot del importe solicitado evidencia una fuerte asimetría hacia valores altos y la presencia de numerosos outliers situados por encima del rango considerado típico. Estos valores atípicos representan solicitudes de crédito muy superiores a las del resto de clientes, lo que puede indicar la existencia de perfiles financieros diferentes. La concentración de outliers en la cola superior sugiere que una minoría de clientes solicita importes inusualmente elevados. Este fenómeno es relevante en el contexto bancario, ya que estos valores extremos pueden distorsionar estadísticas como la media y afectar el comportamiento de algunos modelos predictivos. Por ello, resulta crucial analizar la naturaleza de estos outliers.
# Examinamos las 20 solicitudes de crédito más altas para detectar incoherencias
head(df_credit[order(-df_credit$amount), ], 20)## checking_balance months_loan_duration credit_history purpose
## 916 1 - 200 DM 48 fully repaid others
## 96 1 - 200 DM 54 fully repaid business
## 819 < 0 DM 36 repaid others
## 888 1 - 200 DM 48 repaid business
## 638 unknown 60 delayed radio/tv
## 918 < 0 DM 6 repaid car (new)
## 375 1 - 200 DM 60 fully repaid this bank others
## 237 1 - 200 DM 6 repaid car (new)
## 64 1 - 200 DM 48 fully repaid business
## 379 1 - 200 DM 36 repaid car (new)
## 745 < 0 DM 39 critical furniture
## 715 1 - 200 DM 60 repaid car (new)
## 374 unknown 60 critical car (new)
## 382 1 - 200 DM 18 repaid car (used)
## 922 unknown 48 delayed radio/tv
## 764 unknown 21 critical car (new)
## 88 1 - 200 DM 36 repaid education
## 19 1 - 200 DM 24 repaid car (used)
## 564 1 - 200 DM 36 repaid car (new)
## 616 1 - 200 DM 48 fully repaid business
## amount savings_balance employment_length installment_rate personal_status
## 916 18424 < 100 DM 1 - 4 yrs 1 female
## 96 15945 < 100 DM 0 - 1 yrs 3 single male
## 819 15857 < 100 DM unemployed 2 divorced male
## 888 15672 < 100 DM 1 - 4 yrs 2 single male
## 638 15653 < 100 DM 4 - 7 yrs 2 single male
## 918 14896 < 100 DM > 7 yrs 1 single male
## 375 14782 101 - 500 DM > 7 yrs 3 female
## 237 14555 unknown unemployed 1 single male
## 64 14421 < 100 DM 1 - 4 yrs 2 single male
## 379 14318 < 100 DM > 7 yrs 4 single male
## 745 14179 unknown 4 - 7 yrs 4 single male
## 715 14027 < 100 DM 4 - 7 yrs 4 single male
## 374 13756 unknown > 7 yrs 2 single male
## 382 12976 < 100 DM unemployed 3 female
## 922 12749 501 - 1000 DM 4 - 7 yrs 4 single male
## 764 12680 unknown > 7 yrs 4 single male
## 88 12612 101 - 500 DM 1 - 4 yrs 1 single male
## 19 12579 < 100 DM > 7 yrs 4 female
## 564 12389 unknown 1 - 4 yrs 1 single male
## 616 12204 unknown 1 - 4 yrs 2 single male
## other_debtors residence_history property age
## 916 none 2 building society savings 32
## 96 none 4 unknown/none 58
## 819 co-applicant 3 other 43
## 888 none 2 other 23
## 638 none 4 other 21
## 918 none 4 unknown/none 68
## 375 none 4 unknown/none 60
## 237 none 2 building society savings 23
## 64 none 2 other 25
## 379 none 2 unknown/none 57
## 745 none 4 building society savings 30
## 715 none 2 unknown/none 27
## 374 none 4 unknown/none 63
## 382 none 4 unknown/none 38
## 922 none 1 other 37
## 764 none 4 unknown/none 30
## 88 none 4 unknown/none 47
## 19 none 2 unknown/none 44
## 564 none 4 unknown/none 37
## 616 none 2 other 48
## installment_plan housing existing_credits default dependents telephone
## 916 bank own 1 2 1 yes
## 96 none rent 1 2 1 yes
## 819 none own 1 1 1 none
## 888 none own 1 2 1 yes
## 638 none own 2 1 1 yes
## 918 bank own 1 2 1 yes
## 375 bank for free 2 2 1 yes
## 237 none own 1 2 1 yes
## 64 none own 1 2 1 yes
## 379 none for free 1 2 1 yes
## 745 none own 2 1 1 yes
## 715 none own 1 2 1 yes
## 374 bank for free 1 1 1 yes
## 382 none for free 1 2 1 yes
## 922 none own 1 1 1 yes
## 764 none for free 1 2 1 yes
## 88 none for free 1 2 2 yes
## 19 none for free 1 2 1 yes
## 564 none for free 1 2 1 yes
## 616 bank own 1 1 1 yes
## foreign_worker job
## 916 no mangement self-employed
## 96 yes skilled employee
## 819 yes mangement self-employed
## 888 yes skilled employee
## 638 yes skilled employee
## 918 yes mangement self-employed
## 375 yes mangement self-employed
## 237 yes unemployed non-resident
## 64 yes skilled employee
## 379 yes mangement self-employed
## 745 yes mangement self-employed
## 715 yes mangement self-employed
## 374 yes mangement self-employed
## 382 yes mangement self-employed
## 922 yes mangement self-employed
## 764 yes mangement self-employed
## 88 yes skilled employee
## 19 yes mangement self-employed
## 564 yes skilled employee
## 616 yes mangement self-employedTras la revisión manual de los registros correspondientes a los mayores importes solicitados, no se observan incongruencias evidentes en las combinaciones de variables. Los datos asociados a estos casos resultan creibles dentro del contexto bancario, ya que los importes elevados se asocian a propósitos razonables como negocios, adquisición de vehículos nuevos o necesidades diversas. Las características demográficas y financieras de estos clientes, así como la diversidad en la variable objetivo, sugieren que estos valores atípicos no corresponden a errores de introducción de datos, sino a perfiles reales de clientes que, aunque minoritarios, forman parte natural de la cartera crediticia. Por tanto, mantenemos estos registros en el análisis.
Con el objetivo de analizar la distribución y relación entre variables y la variable objetivo (default) en el contexto de scoring crediticio.
# Gráficas de la distribución simple de variables (diagramas de barras)
# Gráfico 1: Checking Balance
plotChecking <- ggplot(df_credit, aes(checking_balance)) +
geom_bar(fill="steelblue") +
labs(x="Balance en cuenta corriente", y="Clientes") +
ggtitle("Distribución de Checking Balance") +
theme(axis.text.x = element_text(angle=0, hjust=0.5, size=11))
# Gráfico 2: Propósito del crédito
plotPurpose <- ggplot(df_credit, aes(purpose)) +
geom_bar(fill="darkgreen") +
labs(x="Propósito del crédito", y="Clientes") +
ggtitle("Distribución de Propósito") +
theme(axis.text.x = element_text(angle=45, hjust=1, size=9))
# Gráfico 3: Tipo de vivienda
plotHousing <- ggplot(df_credit, aes(housing)) +
geom_bar(fill="gold") +
labs(x="Tipo de vivienda", y="Clientes") +
ggtitle("Distribución de Vivienda") +
theme(axis.text.x = element_text(angle=0, hjust=0.5, size=11))
# Gráfico 4: Tipo de trabajo
plotJob <- ggplot(df_credit, aes(job)) +
geom_bar(fill="coral") +
labs(x="Tipo de trabajo", y="Clientes") +
ggtitle("Distribución de Trabajo") +
theme(axis.text.x = element_text(angle=30, hjust=1, size=10))
# Mostrar los gráficos juntos en dos columnas
grid.arrange(plotChecking, plotPurpose, plotHousing, plotJob, ncol=2)
# Distribución de la variable objetivo default
plotDefault <- ggplot(df_credit, aes(default)) +
geom_bar(fill=c("black","tomato")) +
labs(x="Riesgo de crédito", y="Clientes") +
ggtitle("Distribución del Riesgo de Crédito")
plotDefault
# Relación entre variables categóricas y riesgo (default)
plotCheckingRisk <- ggplot(df_credit, aes(checking_balance, fill=default)) +
geom_bar(position="dodge") +
labs(x="Balance en cuenta corriente", y="Clientes", fill="Riesgo") +
ggtitle("Riesgo de crédito por Balance") +
scale_fill_manual(values=c("black", "tomato")) +
theme(
plot.title = element_text(size=14, face="bold"),
axis.text.x = element_text(angle=45, hjust=1, size=9),
axis.text.y = element_text(size=10),
legend.title = element_text(size=10),
legend.text = element_text(size=10)
)
plotPurposeRisk <- ggplot(df_credit, aes(purpose, fill=default)) +
geom_bar(position="dodge") +
labs(x="Propósito", y="Clientes", fill="Riesgo") +
ggtitle("Riesgo de crédito por Propósito") +
scale_fill_manual(values=c("black", "tomato")) +
theme(
plot.title = element_text(size=14, face="bold"),
axis.text.x = element_text(angle=45, hjust=1, size=9),
axis.text.y = element_text(size=10),
legend.title = element_text(size=10),
legend.text = element_text(size=10)
)
plotHousingRisk <- ggplot(df_credit, aes(housing, fill=default)) +
geom_bar(position="dodge") +
labs(x="Tipo de vivienda", y="Clientes", fill="Riesgo") +
ggtitle("Riesgo de crédito por Vivienda") +
scale_fill_manual(values=c("black", "tomato")) +
theme(
plot.title = element_text(size=14, face="bold"),
axis.text.x = element_text(angle=0, size=10),
axis.text.y = element_text(size=10),
legend.title = element_text(size=10),
legend.text = element_text(size=10)
)
grid.arrange(plotCheckingRisk, plotPurposeRisk, plotHousingRisk, ncol=2)
# Tablas de contingencia y proporciones
# Seleccionamos las variables categóricas/factor (excepto la variable objetivo)
cat_vars <- names(df_credit)[sapply(df_credit, is.factor) &
names(df_credit) != "default"]
# Creamos listas vacías para guardar resultados
tablas_frecuencia <- list()
tablas_porcentaje <- list()
for (v in cat_vars) {
# Tabla de contingencia
tab <- table(df_credit[[v]], df_credit$default)
tablas_frecuencia[[v]] <- tab
# Tabla de proporciones (% sobre cada categoría de la variable explicativa)
prop_tab <- round(100 * prop.table(tab, margin=1), 2)
tablas_porcentaje[[v]] <- prop_tab
# Puedes imprimirlas si quieres
cat("\nTabla de contingencia para", v, ":\n")
print(tab)
cat("\nPorcentajes (por fila) para", v, ":\n")
print(prop_tab)
}##
## Tabla de contingencia para checking_balance :
##
## 1 2
## < 0 DM 139 135
## > 200 DM 49 14
## 1 - 200 DM 164 105
## unknown 348 46
##
## Porcentajes (por fila) para checking_balance :
##
## 1 2
## < 0 DM 50.73 49.27
## > 200 DM 77.78 22.22
## 1 - 200 DM 60.97 39.03
## unknown 88.32 11.68
##
## Tabla de contingencia para credit_history :
##
## 1 2
## critical 243 50
## delayed 60 28
## fully repaid 15 25
## fully repaid this bank 21 28
## repaid 361 169
##
## Porcentajes (por fila) para credit_history :
##
## 1 2
## critical 82.94 17.06
## delayed 68.18 31.82
## fully repaid 37.50 62.50
## fully repaid this bank 42.86 57.14
## repaid 68.11 31.89
##
## Tabla de contingencia para purpose :
##
## 1 2
## business 63 34
## car (new) 145 89
## car (used) 86 17
## domestic appliances 8 4
## education 28 22
## furniture 123 58
## others 7 5
## radio/tv 218 62
## repairs 14 8
## retraining 8 1
##
## Porcentajes (por fila) para purpose :
##
## 1 2
## business 64.95 35.05
## car (new) 61.97 38.03
## car (used) 83.50 16.50
## domestic appliances 66.67 33.33
## education 56.00 44.00
## furniture 67.96 32.04
## others 58.33 41.67
## radio/tv 77.86 22.14
## repairs 63.64 36.36
## retraining 88.89 11.11
##
## Tabla de contingencia para savings_balance :
##
## 1 2
## < 100 DM 386 217
## > 1000 DM 42 6
## 101 - 500 DM 69 34
## 501 - 1000 DM 52 11
## unknown 151 32
##
## Porcentajes (por fila) para savings_balance :
##
## 1 2
## < 100 DM 64.01 35.99
## > 1000 DM 87.50 12.50
## 101 - 500 DM 66.99 33.01
## 501 - 1000 DM 82.54 17.46
## unknown 82.51 17.49
##
## Tabla de contingencia para employment_length :
##
## 1 2
## > 7 yrs 189 64
## 0 - 1 yrs 102 70
## 1 - 4 yrs 235 104
## 4 - 7 yrs 135 39
## unemployed 39 23
##
## Porcentajes (por fila) para employment_length :
##
## 1 2
## > 7 yrs 74.70 25.30
## 0 - 1 yrs 59.30 40.70
## 1 - 4 yrs 69.32 30.68
## 4 - 7 yrs 77.59 22.41
## unemployed 62.90 37.10
##
## Tabla de contingencia para installment_rate :
##
## 1 2
## 1 102 34
## 2 169 62
## 3 112 45
## 4 317 159
##
## Porcentajes (por fila) para installment_rate :
##
## 1 2
## 1 75.00 25.00
## 2 73.16 26.84
## 3 71.34 28.66
## 4 66.60 33.40
##
## Tabla de contingencia para personal_status :
##
## 1 2
## divorced male 30 20
## female 201 109
## married male 67 25
## single male 402 146
##
## Porcentajes (por fila) para personal_status :
##
## 1 2
## divorced male 60.00 40.00
## female 64.84 35.16
## married male 72.83 27.17
## single male 73.36 26.64
##
## Tabla de contingencia para other_debtors :
##
## 1 2
## co-applicant 23 18
## guarantor 42 10
## none 635 272
##
## Porcentajes (por fila) para other_debtors :
##
## 1 2
## co-applicant 56.10 43.90
## guarantor 80.77 19.23
## none 70.01 29.99
##
## Tabla de contingencia para residence_history :
##
## 1 2
## 1 94 36
## 2 211 97
## 3 106 43
## 4 289 124
##
## Porcentajes (por fila) para residence_history :
##
## 1 2
## 1 72.31 27.69
## 2 68.51 31.49
## 3 71.14 28.86
## 4 69.98 30.02
##
## Tabla de contingencia para property :
##
## 1 2
## building society savings 161 71
## other 230 102
## real estate 222 60
## unknown/none 87 67
##
## Porcentajes (por fila) para property :
##
## 1 2
## building society savings 69.40 30.60
## other 69.28 30.72
## real estate 78.72 21.28
## unknown/none 56.49 43.51
##
## Tabla de contingencia para installment_plan :
##
## 1 2
## bank 82 57
## none 590 224
## stores 28 19
##
## Porcentajes (por fila) para installment_plan :
##
## 1 2
## bank 58.99 41.01
## none 72.48 27.52
## stores 59.57 40.43
##
## Tabla de contingencia para housing :
##
## 1 2
## for free 64 44
## own 527 186
## rent 109 70
##
## Porcentajes (por fila) para housing :
##
## 1 2
## for free 59.26 40.74
## own 73.91 26.09
## rent 60.89 39.11
##
## Tabla de contingencia para existing_credits :
##
## 1 2
## 1 433 200
## 2 241 92
## 3 22 6
## 4 4 2
##
## Porcentajes (por fila) para existing_credits :
##
## 1 2
## 1 68.40 31.60
## 2 72.37 27.63
## 3 78.57 21.43
## 4 66.67 33.33
##
## Tabla de contingencia para dependents :
##
## 1 2
## 1 591 254
## 2 109 46
##
## Porcentajes (por fila) para dependents :
##
## 1 2
## 1 69.94 30.06
## 2 70.32 29.68
##
## Tabla de contingencia para telephone :
##
## 1 2
## none 409 187
## yes 291 113
##
## Porcentajes (por fila) para telephone :
##
## 1 2
## none 68.62 31.38
## yes 72.03 27.97
##
## Tabla de contingencia para foreign_worker :
##
## 1 2
## no 33 4
## yes 667 296
##
## Porcentajes (por fila) para foreign_worker :
##
## 1 2
## no 89.19 10.81
## yes 69.26 30.74
##
## Tabla de contingencia para job :
##
## 1 2
## mangement self-employed 97 51
## skilled employee 444 186
## unemployed non-resident 15 7
## unskilled resident 144 56
##
## Porcentajes (por fila) para job :
##
## 1 2
## mangement self-employed 65.54 34.46
## skilled employee 70.48 29.52
## unemployed non-resident 68.18 31.82
## unskilled resident 72.00 28.00El análisis visual de las principales variables muestra que la mayoría de clientes son propietarios de vivienda, empleados cualificados y solicitan créditos para bienes de consumo duradero (especialmente radio/TV y vehículos).
En cuanto a la variable objetivo (), la proporción de no pagadores ronda el 30%. Las tablas de contingencia y los diagramas de barras revelan que los clientes con saldo bajo o desconocido, inquilinos y quienes solicitan préstamos para consumo presentan un mayor porcentaje de impago.
Estos patrones confirman la relevancia de las variables financieras y sociodemográficas como predictores del riesgo crediticio y justifican su uso en modelos de clasificación.
library(corrplot)## corrplot 0.95 loaded# Selecciona variables numéricas
df_num <- df_credit[, sapply(df_credit, is.numeric)]
# Calcula la matriz de correlación de Pearson
corr_matrix <- cor(df_num, use = "complete.obs")
# Visualiza la matriz de correlación con corrplot (opciones optimizadas)
corrplot(
corr_matrix,
method = "color", # Mapa de calor
type = "upper", # Solo parte superior
tl.col = "black", # Etiquetas en negro
tl.cex = 0.8, # Tamaño de etiquetas
tl.srt = 30, # Rotación de etiquetas
order = "AOE", # Agrupa variables similares
number.cex = 0.65, # Tamaño de los coeficientes
addCoef.col = "black", # Color de los números
sig.level = 0.01 # Nivel de significación para destacar correlaciones fuertes
)
if (!require(DescTools)) install.packages("DescTools")
library(DescTools)
# Bucle para todas las categóricas si lo deseas
cat_vars <- names(df_credit)[sapply(df_credit, is.factor) & names(df_credit) != "default"]
for (v in cat_vars) {
v_cramer <- CramerV(table(df_credit[[v]], df_credit$default))
cat("V de Cramér para", v, "vs default:", round(v_cramer, 3), "\n")
}## V de Cramér para checking_balance vs default: 0.352
## V de Cramér para credit_history vs default: 0.248
## V de Cramér para purpose vs default: 0.183
## V de Cramér para savings_balance vs default: 0.19
## V de Cramér para employment_length vs default: 0.136
## V de Cramér para installment_rate vs default: 0.074
## V de Cramér para personal_status vs default: 0.098
## V de Cramér para other_debtors vs default: 0.082
## V de Cramér para residence_history vs default: 0.027
## V de Cramér para property vs default: 0.154
## V de Cramér para installment_plan vs default: 0.113
## V de Cramér para housing vs default: 0.135
## V de Cramér para existing_credits vs default: 0.052
## V de Cramér para dependents vs default: 0.003
## V de Cramér para telephone vs default: 0.036
## V de Cramér para foreign_worker vs default: 0.082
## V de Cramér para job vs default: 0.043El análisis de la matriz de correlaciones para las variables numéricas (, y ) muestra que la única relación destacable se produce entre y , con un coeficiente de correlación de 0.62. Esto sugiere que, a mayor importe solicitado, suele estar asociado a préstamos de mayor duración. Por el contrario, la edad presenta correlaciones muy bajas tanto con el importe solicitado como con la duración del préstamo, lo que indica independencia entre estos factores.
Para evaluar la relación entre variables categóricas y la variable objetivo (), hemos empleado la V de Cramér. Esta medida es especialmente adecuada para cuantificar la fuerza de la asociación entre variables categóricas, independientemente de su número de niveles. En este contexto, la V de Cramér permite identificar qué variables aportan información relevante sobre el riesgo crediticio.
Los valores próximos a 1 indican una relación fuerte entre las variables. Valores inferiores a 0.10 se interpreta como una asociación muy baja, valores entre 0.10 y 0.30 indican asociación débil, entre 0.30 y 0.50 asociación moderada y valores superiores a 0.50 reflejan una asociación fuerte.
En nuestro caso, los resultados obtenidos muestran que las variables (V=0.352) y (V=0.248) son las que presentan mayor asociación con el riesgo de impago, seguidas por y , aunque con asociaciones moderadas. El resto de variables categóricas muestran valores bajos de V de Cramér, lo que indica que, su capacidad explicativa respecto al riesgo de crédito es limitada o casi nula.
…
Modelado con árbol de decisión (C5.0)
El algoritmo C5.0 es una versión mejorada de los árboles de decisión tradicionales, especialmente diseñada para clasificar y predecir una variable objetivo utilizando múltiples variables explicativas. Su funcionamiento se basa en dividir los datos de manera secuencial, eligiendo en cada paso las variables que mejor separan las clases. De este modo, construye un árbol de decisión compuesto por reglas simples que automatizan la toma de decisiones. Por defecto, C5.0 emplea el criterio de ganancia de información para identificar las mejores particiones y permite controlar la complejidad del modelo ajustando parámetros como la profundidad del árbol o el número de reglas generadas.
# Entrenamiento y visualización del modelo
# Fijamos la semilla para reproducibilidad
set.seed(2024)
# Variable objetivo (y) y predictoras (X)
y <- df_credit$default
X <- df_credit[, setdiff(names(df_credit), "default")]
# Proporción de split
split_prop <- 3 # para 2/3 train, 1/3 test
indexes <- sample(seq_len(nrow(df_credit)), size = floor(((split_prop-1)/split_prop) * nrow(df_credit)))
trainX <- X[indexes, ]
trainy <- y[indexes]
testX <- X[-indexes, ]
testy <- y[-indexes]
# Aseguramos que sean factor
trainy <- as.factor(trainy)
testy <- as.factor(testy)
# Comprobamos la proporción de defaults en train y test
cat("Proporción en train:\n"); print(prop.table(table(trainy)))## Proporción en train:## trainy
## 1 2
## 0.7252252 0.2747748cat("Proporción en test:\n"); print(prop.table(table(testy)))## Proporción en test:## testy
## 1 2
## 0.6497006 0.3502994…
# Entrenamiento del modelo C5.0 (usamos rules=TRUE para extraer reglas)
modelo_c50 <- C5.0(trainX, trainy, rules=TRUE)
# Resumen del modelo y reglas aprendidas
summary(modelo_c50)##
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Mon May 19 05:09:57 2025
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 666 cases (21 attributes) from undefined.data
##
## Rules:
##
## Rule 1: (311/32, lift 1.2)
## checking_balance in {> 200 DM, unknown}
## -> class 1 [0.895]
##
## Rule 2: (121/14, lift 1.2)
## credit_history in {critical, delayed, repaid}
## savings_balance = unknown
## -> class 1 [0.878]
##
## Rule 3: (611/153, lift 1.0)
## months_loan_duration <= 39
## -> class 1 [0.749]
##
## Rule 4: (15, lift 3.4)
## checking_balance in {< 0 DM, 1 - 200 DM}
## credit_history in {fully repaid, fully repaid this bank}
## other_debtors = none
## housing in {for free, rent}
## -> class 2 [0.941]
##
## Rule 5: (15, lift 3.4)
## checking_balance in {< 0 DM, 1 - 200 DM}
## credit_history in {fully repaid, fully repaid this bank}
## amount <= 3148
## telephone = none
## -> class 2 [0.941]
##
## Rule 6: (15, lift 3.4)
## checking_balance in {< 0 DM, 1 - 200 DM}
## credit_history in {fully repaid, fully repaid this bank}
## other_debtors = none
## age > 31
## -> class 2 [0.941]
##
## Rule 7: (8, lift 3.3)
## checking_balance in {< 0 DM, 1 - 200 DM}
## purpose = car (new)
## savings_balance = < 100 DM
## residence_history = 2
## age <= 30
## -> class 2 [0.900]
##
## Rule 8: (17/1, lift 3.3)
## checking_balance in {< 0 DM, 1 - 200 DM}
## amount > 7485
## savings_balance = < 100 DM
## other_debtors = none
## -> class 2 [0.895]
##
## Rule 9: (7, lift 3.2)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration <= 22
## purpose = education
## savings_balance in {< 100 DM, > 1000 DM}
## -> class 2 [0.889]
##
## Rule 10: (7, lift 3.2)
## checking_balance = < 0 DM
## months_loan_duration > 22
## amount <= 2150
## savings_balance = < 100 DM
## other_debtors = none
## -> class 2 [0.889]
##
## Rule 11: (7, lift 3.2)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 22
## purpose in {education, others, radio/tv}
## savings_balance = 101 - 500 DM
## -> class 2 [0.889]
##
## Rule 12: (6, lift 3.2)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 22
## purpose = business
## savings_balance = < 100 DM
## existing_credits = 2
## -> class 2 [0.875]
##
## Rule 13: (16/2, lift 3.0)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 22
## purpose in {car (new), others, repairs}
## savings_balance = < 100 DM
## other_debtors = none
## -> class 2 [0.833]
##
## Rule 14: (9/1, lift 3.0)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration <= 22
## purpose = car (new)
## installment_plan = bank
## -> class 2 [0.818]
##
## Rule 15: (8/1, lift 2.9)
## checking_balance = < 0 DM
## months_loan_duration > 22
## credit_history = repaid
## savings_balance = unknown
## -> class 2 [0.800]
##
## Rule 16: (12/2, lift 2.9)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 22
## purpose = furniture
## savings_balance = < 100 DM
## personal_status in {female, single male}
## other_debtors = none
## -> class 2 [0.786]
##
## Rule 17: (6/1, lift 2.7)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 22
## other_debtors = co-applicant
## -> class 2 [0.750]
##
## Rule 18: (9/2, lift 2.6)
## checking_balance = < 0 DM
## months_loan_duration > 22
## credit_history in {critical, repaid}
## savings_balance = unknown
## -> class 2 [0.727]
##
## Rule 19: (355/204, lift 1.5)
## checking_balance in {< 0 DM, 1 - 200 DM}
## -> class 2 [0.426]
##
## Default class: 1
##
##
## Evaluation on training data (666 cases):
##
## Rules
## ----------------
## No Errors
##
## 19 82(12.3%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 470 13 (a): class 1
## 69 114 (b): class 2
##
##
## Attribute usage:
##
## 100.00% checking_balance
## 93.69% months_loan_duration
## 28.68% savings_balance
## 22.52% credit_history
## 10.96% other_debtors
## 9.46% purpose
## 5.86% amount
## 3.45% age
## 2.25% housing
## 2.25% telephone
## 1.80% personal_status
## 1.35% installment_plan
## 1.20% residence_history
## 0.90% existing_credits
##
##
## Time: 0.0 secsTras entrenar el modelo C5.0 con los datos de entrenamiento, se han obtenido 19 reglas de decisión. Las reglas más representativas permiten distinguir entre clientes de bajo y alto riesgo en función de variables clave como el saldo en cuenta corriente, la duración del préstamo, el historial de crédito y el saldo en cuentas de ahorro.
Las tres reglas principales identifican a los buenos pagadores (clase 1) principalmente por la presencia de saldos elevados o desconocidos en la cuenta corriente, historial crediticio menos problemático y préstamos de corta o media duración. Por ejemplo, los clientes con saldo superior a 200 DM o saldo desconocido en la cuenta corriente tienen una probabilidad de buen pago del 89,5%. Asimismo, clientes con historial de crédito crítico, demorado o simplemente repagado, y saldo de ahorros desconocido, también presentan una probabilidad elevada de no incurrir en impago (87,8%).
Por otro lado, el modelo identifica a los malos pagadores (clase 2) principalmente entre los clientes con saldo bajo en cuenta corriente, préstamos de larga duración, bajo saldo en ahorros y propósitos de préstamo como coche nuevo, educación o muebles. Algunas reglas específicas indican que clientes con saldo negativo, duración del préstamo mayor a 22 meses, bajo saldo de ahorros y sin otros deudores presentan hasta un 88,9% de probabilidad de impago.
La tasa de error sobre los datos de entrenamiento es del 12,3%, lo que indica una adecuada capacidad de discriminación del modelo. Además, el análisis de uso de atributos revela que las variables más relevantes para el modelo son el saldo en cuenta corriente, la duración del préstamo y el saldo en cuentas de ahorro, seguidas por el historial de crédito y la presencia de otros deudores.
Estas reglas permiten a la entidad financiera justificar la concesión o denegación de créditos y fundamentar estrategias para mitigar el riesgo de impago.
# Visualización del árbol de decisión
# Entrena el modelo (por defecto)
modelo_c50_tree <- C5.0(trainX, trainy)
plot(modelo_c50_tree, main="Árbol de Decisión C5.0", gp=gpar(fontsize=9.5))
install.packages("C:/Users/Sue Nav/Downloads/rpart_4.1.23.zip", repos = NULL, type = "win.binary")
library(rpart)La librería () se utiliza en R para la construcción y visualización de árboles de decisión, tanto en problemas de clasificación como de regresión. Permite ajustar la complejidad del árbol, lo que facilitará la obtención de modelos más interpretables. En este análisis, recurrimos a y a la función para generar y visualizar árboles de decisión más manejables, permitiendo comparar la lógica de clasificación con la obtenida mediante otros algoritmos.
if (!require("rpart")) install.packages("rpart")
library(rpart)
# Instala y carga el paquete 'rpart.plot'
if (!require("rpart.plot")) install.packages("rpart.plot")## Cargando paquete requerido: rpart.plotlibrary(rpart.plot)…
library()
# Entrenamos el árbol de decisión
modelo_rpart <- rpart(default ~ ., data = df_credit, method = "class")
pred_rpart <- predict(modelo_rpart, testX, type = "class")
table(testy, Predicho = pred_rpart)## Predicho
## testy 1 2
## 1 190 27
## 2 51 66cat(sprintf("Precisión RPART: %.2f %%\n", mean(pred_rpart == testy) * 100))## Precisión RPART: 76.65 %Con el árbol de decisión obtenemos una precisión global del 76,65%. La matriz de confusión obtenida es la siguiente:
El modelo clasifica correctamente 190 clientes que no presentan impago y 66 clientes que sí presentan impago. Por otro lado, existen 27 clientes sin impago clasificados erróneamente como impago y 51 clientes con impago que no fueron identificados como tales.
Estos resultados muestran que el árbol RPART es capaz de distinguir razonablemente bien entre clientes solventes y clientes con riesgo de impago. Sin embargo, sigue existiendo errores en la identificación de clientes con impago, lo cual es habitual en problemas de scoring crediticio donde las clases suelen estar desbalanceadas.
Los modelos de clasificación tienden a favorecer la clase mayoritaria y pueden tener dificultades para identificar correctamente la clase minoritaria (la de impagos)
# Graficamos el árbol
rpart.plot(modelo_rpart,
type = 2, # Muestra las variables en los nodos
extra = 101, # Muestra el número y porcentaje de casos en cada nodo
fallen.leaves = TRUE,
digits = 3, # Número de decimales
cex = 0.56,
box.palette = "BuGn", # Colores suaves
under = TRUE,
tweak = 1.2, # Ajusta tamaño general
main = "Árbol de Decisión (rpart)")
La variable más importante es : el árbol primero divide a los clientes según el saldo en cuenta corriente. Aquellos con saldo alto o desconocido presentan un perfil más seguro (nodo izquierdo).
Posteriormente, el modelo considera la duración del préstamo (), el historial crediticio (), el saldo en cuentas de ahorro (), el propósito del crédito () y la cantidad solicitada () para refinar la clasificación de los clientes.
A medida que descendemos en el árbol, las divisiones sucesivas agrupan a los clientes en perfiles de mayor o menor riesgo en función de las combinaciones.
En conclusión, el árbol de decisión identifica que el riesgo de crédito depende principalmente del saldo en cuenta corriente, la duración del préstamo y el historial crediticio, junto con otras variables financieras. Este modelo permite segmentar a los clientes y anticipar la probabilidad de impago de forma visual.
…
Validación y evaluación de los modelos
# Predicción sobre el conjunto test
pred_c50 <- predict(modelo_c50, newdata = testX, type = "class")
# 4. Matriz de confusión y precisión global
mat_conf_c50 <- table(Real = testy, Predicho = pred_c50)
print(mat_conf_c50)## Predicho
## Real 1 2
## 1 188 29
## 2 65 52accuracy_c50 <- mean(pred_c50 == testy) * 100
cat(sprintf("Precisión global (C5.0): %.2f %%\n", accuracy_c50))## Precisión global (C5.0): 71.86 %El modelo alcanza una precisión global del 71,86% en el conjunto de test. La matriz de confusión obtenida es la siguiente:
El modelo clasifica correctamente la mayoría de los clientes sin impago (188 de 217), pero para identificar correctamente a los clientes con impago (52 de 117) tiene dificultad. Esto indica que el modelo es más fiable detectando perfiles de bajo riesgo, mientras que la identificación de perfiles de alto riesgo (impago).
# Modelo C5.0 con boosting
modelo_boost <- C5.0(trainX, trainy, trials = 10)
pred_boost <- predict(modelo_boost, testX, type = "class")
mat_conf_boost <- table(testy, Predicho = pred_boost)
cat(sprintf("Precisión Boosting: %.2f %%\n", mean(pred_boost == testy) * 100))## Precisión Boosting: 70.96 %print(mat_conf_boost)## Predicho
## testy 1 2
## 1 186 31
## 2 66 51\text{Comparación de resultados: C5.0 vs C5.0 + Boosting}
Se han evaluado ambos modelos utilizando el conjunto de test, obteniéndose los siguientes resultados:
Ambos modelos presentan un comportamiento muy similar en términos de precisión y distribución de errores. No se observa una mejora significativa al aplicar boosting sobre el modelo base en este conjunto de datos. El principal reto sigue siendo la identificación correcta de los clientes con impago.
# Regresión logística binaria
modelo_logit <- glm(default ~ ., data = data.frame(trainX, default=trainy), family = binomial)
prob_logit <- predict(modelo_logit, newdata=testX, type="response")
# Codifica: 1 = No default, 2 = Default
pred_logit <- as.factor(ifelse(prob_logit > 0.5, 2, 1))
cat(sprintf("Precisión Regresión Logística: %.2f %%\n", mean(pred_logit == testy) * 100))## Precisión Regresión Logística: 72.16 %table(testy, Predicho = pred_logit)## Predicho
## testy 1 2
## 1 191 26
## 2 67 50if(!require(xgboost)) install.packages('xgboost')## Cargando paquete requerido: xgboost##
## Adjuntando el paquete: 'xgboost'## The following object is masked from 'package:dplyr':
##
## slicelibrary(xgboost)
if(!require(caret)) install.packages('caret')## Cargando paquete requerido: caret##
## Adjuntando el paquete: 'caret'## The following object is masked from 'package:httr':
##
## progress## The following object is masked from 'package:generics':
##
## train## The following objects are masked from 'package:Metrics':
##
## precision, recall## The following object is masked from 'package:purrr':
##
## lift## The following object is masked from 'package:survival':
##
## cluster## The following object is masked from 'package:future':
##
## cluster## The following objects are masked from 'package:DescTools':
##
## MAE, RMSElibrary(caret)
if(!require(randomForest)) install.packages('randomForest')
library(randomForest)# randomForest
modelo_rf <- randomForest(x = trainX, y = trainy, ntree = 100)
pred_rf <- predict(modelo_rf, testX)
cat(sprintf("Precisión Random Forest: %.2f %%\n", mean(pred_rf == testy) * 100))## Precisión Random Forest: 72.16 %table(testy, Predicho = pred_rf)## Predicho
## testy 1 2
## 1 204 13
## 2 80 37El modelo de regresión logística binaria fue entrenado y evaluado sobre el conjunto de test. Se obtuvo una precisión global del 72,16%. La matriz de confusión es la siguiente:
El modelo clasifica correctamente 191 clientes sin impago y 50 clientes con impago. Se produjeron 26 falsos positivos (clientes sin impago clasificados erróneamente como impago) y 67 falsos negativos (clientes con impago no detectados). El resultado es coherente con el desempeño habitual de la regresión logística en problemas de scoring crediticio, logrando un equilibrio razonable entre la identificación de ambas clases.
# XGBoost requiere datos numéricos
X_all <- rbind(trainX, testX)
dummies <- dummyVars(~ ., data = X_all)
X_all_mat <- predict(dummies, X_all)
X_train <- X_all_mat[1:nrow(trainX), ]
X_test <- X_all_mat[(nrow(trainX)+1):nrow(X_all_mat), ]
# Codificación: 0 = No default, 1 = Default
y_train_xgb <- as.numeric(trainy) - 1
y_test_xgb <- as.numeric(testy) - 1
dtrain <- xgb.DMatrix(data = X_train, label = y_train_xgb)
dtest <- xgb.DMatrix(data = X_test, label = y_test_xgb)
modelo_xgb <- xgboost(data = dtrain, objective = "binary:logistic",
nrounds = 100, verbose = 0)
prob_xgb <- predict(modelo_xgb, dtest)
pred_xgb <- as.factor(ifelse(prob_xgb > 0.5, 1, 0))
cat(sprintf("Precisión XGBoost: %.2f %%\n", mean(pred_xgb == y_test_xgb) * 100))## Precisión XGBoost: 71.86 %table(y_test_xgb, Predicho = pred_xgb)## Predicho
## y_test_xgb 0 1
## 0 190 27
## 1 67 50El modelo XGBoost fue entrenado y evaluado sobre el conjunto de test, alcanzando una precisión global del 71,86%. La matriz de confusión es la siguiente:
El modelo clasifica correctamente 190 clientes sin impago y 50 clientes con impago. Presenta 27 falsos positivos (clientes solventes clasificados como impago) y 67 falsos negativos (clientes con impago no identificados). El comportamiento de XGBoost es similar al de la regresión logística, con un equilibrio razonable entre ambas clases, aunque el mayor desafío sigue siendo la correcta detección de los impagos (clase minoritaria).
if (!require("gmodels")) install.packages("gmodels")
library(gmodels)La función CrossTable del paquete gmodels permite obtener un resumen visual y porcentual de los aciertos y errores del modelo sobre el conjunto de test. Además se puede ver las proporciones relativas, lo que ayuda a interpretar mejor la bondad del modelo y su sesgo
CrossTable(testy, pred_c50, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE,
dnn=c("Realidad", "Predicción C5.0"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción C5.0
## Realidad | 1 | 2 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 188 | 29 | 217 |
## | 0.563 | 0.087 | |
## -------------|-----------|-----------|-----------|
## 2 | 65 | 52 | 117 |
## | 0.195 | 0.156 | |
## -------------|-----------|-----------|-----------|
## Column Total | 253 | 81 | 334 |
## -------------|-----------|-----------|-----------|
##
## CrossTable(testy, pred_boost, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE, dnn=c("Realidad", "Predicción Boosting"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción Boosting
## Realidad | 1 | 2 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 186 | 31 | 217 |
## | 0.557 | 0.093 | |
## -------------|-----------|-----------|-----------|
## 2 | 66 | 51 | 117 |
## | 0.198 | 0.153 | |
## -------------|-----------|-----------|-----------|
## Column Total | 252 | 82 | 334 |
## -------------|-----------|-----------|-----------|
##
## CrossTable(testy, pred_xgb, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE,
dnn=c("Realidad", "Predicción Boosting"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción Boosting
## Realidad | 0 | 1 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 190 | 27 | 217 |
## | 0.569 | 0.081 | |
## -------------|-----------|-----------|-----------|
## 2 | 67 | 50 | 117 |
## | 0.201 | 0.150 | |
## -------------|-----------|-----------|-----------|
## Column Total | 257 | 77 | 334 |
## -------------|-----------|-----------|-----------|
##
## CrossTable(testy, pred_rpart, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE,
dnn=c("Realidad", "Predicción Boosting"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción Boosting
## Realidad | 1 | 2 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 190 | 27 | 217 |
## | 0.569 | 0.081 | |
## -------------|-----------|-----------|-----------|
## 2 | 51 | 66 | 117 |
## | 0.153 | 0.198 | |
## -------------|-----------|-----------|-----------|
## Column Total | 241 | 93 | 334 |
## -------------|-----------|-----------|-----------|
##
## CrossTable(testy, pred_rf, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE,
dnn=c("Realidad", "Predicción Boosting"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción Boosting
## Realidad | 1 | 2 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 204 | 13 | 217 |
## | 0.611 | 0.039 | |
## -------------|-----------|-----------|-----------|
## 2 | 80 | 37 | 117 |
## | 0.240 | 0.111 | |
## -------------|-----------|-----------|-----------|
## Column Total | 284 | 50 | 334 |
## -------------|-----------|-----------|-----------|
##
## CrossTable(testy, pred_logit, prop.chisq=FALSE, prop.c=FALSE, prop.r=FALSE,
dnn=c("Realidad", "Predicción Boosting"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Predicción Boosting
## Realidad | 1 | 2 | Row Total |
## -------------|-----------|-----------|-----------|
## 1 | 191 | 26 | 217 |
## | 0.572 | 0.078 | |
## -------------|-----------|-----------|-----------|
## 2 | 67 | 50 | 117 |
## | 0.201 | 0.150 | |
## -------------|-----------|-----------|-----------|
## Column Total | 258 | 76 | 334 |
## -------------|-----------|-----------|-----------|
##
## El análisis de las matrices de confusión muestra que todos los modelos tienden a identificar con mayor facilidad a los clientes solventes (clase 1) que a los clientes con impago (clase 2).
El modelo destaca por lograr el mayor porcentaje de aciertos en la clase minoritaria (impagos), con un 19,8% del total correctamente clasificados, mientras que prioriza la identificación de la clase mayoritaria, alcanzando un 61,1% de acierto en solventes pero reduciendo la detección de impagos a un 11,1%. Los modelos , , y presentan resultados similares, con un equilibrio entre ambas clases pero una sensibilidad limitada para la detección de impagos.
Este comportamiento es habitual en conjuntos de datos desbalanceados y refleja la dificultad de identificar correctamente a los clientes de mayor riesgo. La elección del modelo óptimo dependerá del objetivo prioritario: minimizar los impagos no detectados o reducir los falsos positivos, debiendo analizar adicionalmente métricas como sensibilidad, especificidad y el coste asociado a cada tipo de error.
Information Value (IV) y Weight of Evidence (WOE) son herramientas clásicas en el scoring bancario para seleccionar y transformar variables explicativas en modelos de crédito.
WOE (Weight of Evidence): Mide la relación entre una categoría de una variable y el target binario (default), permitiendo convertir variables categóricas en variables numéricas interpretables para modelos lineales y de scoring.
IV (Information Value): Resume la capacidad predictiva de una variable para separar las clases (en tu caso, “1 = No Default” vs. “2 = Default”). Valores de IV altos indican variables muy informativas.
# Libreria IV y WOE para variables categóricas
if(!require(scorecard)) install.packages("scorecard")## Cargando paquete requerido: scorecard##
## Adjuntando el paquete: 'scorecard'## The following object is masked from 'package:tidyr':
##
## replace_na## The following object is masked from 'package:car':
##
## viflibrary(scorecard)# Convertimos 'default' a binario (0,1)
df_credit$default_bin <- ifelse(df_credit$default == 2, 1, 0)
table(df_credit$default_bin)##
## 0 1
## 700 300# Selecciona variables categóricas
cat_vars <- names(df_credit)[sapply(df_credit, is.factor)]
# Aplica woebin para todas las categóricas
bins <- woebin(df_credit, y = "default_bin", x = cat_vars)## ℹ Creating woe binning ...## ✔ Binning on 1000 rows and 19 columns in 00:00:01# Extrae el Information Value (IV) de cada variable
iv_vec <- sapply(bins, function(x) unique(x$total_iv))
iv_df <- data.frame(variable = names(iv_vec), IV = iv_vec)
# Ordena por IV descendente
iv_df <- iv_df[order(-iv_df$IV), ]
print(iv_df)## variable IV
## checking_balance checking_balance 6.345968e-01
## credit_history credit_history 2.918299e-01
## savings_balance savings_balance 1.543801e-01
## purpose purpose 1.482895e-01
## property property 1.126383e-01
## employment_length employment_length 8.643363e-02
## housing housing 8.329343e-02
## personal_status personal_status 4.461469e-02
## installment_plan installment_plan 4.151102e-02
## installment_rate installment_rate 2.556886e-02
## existing_credits existing_credits 1.008356e-02
## job job 8.511139e-03
## telephone telephone 6.377605e-03
## residence_history residence_history 3.588773e-03
## dependents dependents 4.339223e-05
## other_debtors other_debtors 2.685797e-06
## default default 0.000000e+00
## foreign_worker foreign_worker 0.000000e+00ggplot(iv_df, aes(x = reorder(variable, IV), y = IV)) +
geom_bar(stat = "identity", fill = "#0072B2") +
coord_flip() +
labs(title = "Information Value por variable", x = "Variable", y = "IV") +
theme_minimal(base_size = 13)
El análisis del Information Value (IV) permite cuantificar la capacidad predictiva de las variables categóricas respecto al riesgo de impago () en el conjunto de datos. Tras aplicar la función del paquete a las variables categóricas de nuestro dataset, observamos que la mayoría de las variables presentan un valor de IV muy próximo a cero.
De acuerdo con la literatura especializada, un valor de IV inferior a 0.02 indica que la variable no aporta información relevante para discriminar entre clientes con y sin impago. Por tanto, los resultados sugieren que las variables categóricas analizadas no contienen información predictiva significativa respecto a la variable objetivo . Esta conclusión es relevante, ya que justifica la posible exclusión de estas variables en la construcción de modelos de scoring, priorizando aquellas variables que sí muestran mayor capacidad discriminante.
En consecuencia, el análisis de IV nos ayuda a seleccionar de forma objetiva las variables más relevantes, contribuyendo así a la mejora de la interpretabilidad y rendimiento de los modelos predictivos de riesgo crediticio.
En nuestro caso, el gráfico de (IV) muestra los siguientes resultados:
El análisis de Information Value permite identificar de manera objetiva las variables más relevantes para explicar el riesgo de crédito, siendo el saldo en cuenta corriente, el historial crediticio y el saldo en cuentas de ahorro los factores determinantes en la predicción de impagos.
str(bins)## List of 18
## $ checking_balance :Classes 'data.table' and 'data.frame': 3 obs. of 12 variables:
## ..$ variable : chr [1:3] "checking_balance" "checking_balance" "checking_balance"
## ..$ bin : chr [1:3] "< 0 DM" "> 200 DM%,%1 - 200 DM" "unknown"
## ..$ count : int [1:3] 274 332 394
## ..$ count_distr : num [1:3] 0.274 0.332 0.394
## ..$ neg : int [1:3] 139 213 348
## ..$ pos : int [1:3] 135 119 46
## ..$ posprob : num [1:3] 0.493 0.358 0.117
## ..$ woe : num [1:3] 0.818 0.265 -1.176
## ..$ bin_iv : num [1:3] 0.2057 0.0245 0.4044
## ..$ total_iv : num [1:3] 0.635 0.635 0.635
## ..$ breaks : chr [1:3] "< 0 DM" "> 200 DM%,%1 - 200 DM" "unknown"
## ..$ is_special_values: logi [1:3] FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ credit_history :Classes 'data.table' and 'data.frame': 4 obs. of 12 variables:
## ..$ variable : chr [1:4] "credit_history" "credit_history" "credit_history" "credit_history"
## ..$ bin : chr [1:4] "critical" "delayed" "fully repaid%,%fully repaid this bank" "repaid"
## ..$ count : int [1:4] 293 88 89 530
## ..$ count_distr : num [1:4] 0.293 0.088 0.089 0.53
## ..$ neg : int [1:4] 243 60 36 361
## ..$ pos : int [1:4] 50 28 53 169
## ..$ posprob : num [1:4] 0.171 0.318 0.596 0.319
## ..$ woe : num [1:4] -0.7337 0.0852 1.2341 0.0883
## ..$ bin_iv : num [1:4] 0.132423 0.000649 0.154553 0.004206
## ..$ total_iv : num [1:4] 0.292 0.292 0.292 0.292
## ..$ breaks : chr [1:4] "critical" "delayed" "fully repaid%,%fully repaid this bank" "repaid"
## ..$ is_special_values: logi [1:4] FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ purpose :Classes 'data.table' and 'data.frame': 5 obs. of 12 variables:
## ..$ variable : chr [1:5] "purpose" "purpose" "purpose" "purpose" ...
## ..$ bin : chr [1:5] "business%,%car (new)" "car (used)" "domestic appliances%,%education" "furniture%,%others" ...
## ..$ count : int [1:5] 331 103 62 193 311
## ..$ count_distr : num [1:5] 0.331 0.103 0.062 0.193 0.311
## ..$ neg : int [1:5] 208 86 36 130 240
## ..$ pos : int [1:5] 123 17 26 63 71
## ..$ posprob : num [1:5] 0.372 0.165 0.419 0.326 0.228
## ..$ woe : num [1:5] 0.322 -0.774 0.522 0.123 -0.371
## ..$ bin_iv : num [1:5] 0.03633 0.05122 0.01839 0.00298 0.03936
## ..$ total_iv : num [1:5] 0.148 0.148 0.148 0.148 0.148
## ..$ breaks : chr [1:5] "business%,%car (new)" "car (used)" "domestic appliances%,%education" "furniture%,%others" ...
## ..$ is_special_values: logi [1:5] FALSE FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ savings_balance :Classes 'data.table' and 'data.frame': 4 obs. of 12 variables:
## ..$ variable : chr [1:4] "savings_balance" "savings_balance" "savings_balance" "savings_balance"
## ..$ bin : chr [1:4] "< 100 DM" "> 1000 DM%,%101 - 500 DM" "501 - 1000 DM" "unknown"
## ..$ count : int [1:4] 603 151 63 183
## ..$ count_distr : num [1:4] 0.603 0.151 0.063 0.183
## ..$ neg : int [1:4] 386 111 52 151
## ..$ pos : int [1:4] 217 40 11 32
## ..$ posprob : num [1:4] 0.36 0.265 0.175 0.175
## ..$ woe : num [1:4] 0.271 -0.173 -0.706 -0.704
## ..$ bin_iv : num [1:4] 0.04665 0.00438 0.02656 0.0768
## ..$ total_iv : num [1:4] 0.154 0.154 0.154 0.154
## ..$ breaks : chr [1:4] "< 100 DM" "> 1000 DM%,%101 - 500 DM" "501 - 1000 DM" "unknown"
## ..$ is_special_values: logi [1:4] FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ employment_length:Classes 'data.table' and 'data.frame': 5 obs. of 12 variables:
## ..$ variable : chr [1:5] "employment_length" "employment_length" "employment_length" "employment_length" ...
## ..$ bin : chr [1:5] "> 7 yrs" "0 - 1 yrs" "1 - 4 yrs" "4 - 7 yrs" ...
## ..$ count : int [1:5] 253 172 339 174 62
## ..$ count_distr : num [1:5] 0.253 0.172 0.339 0.174 0.062
## ..$ neg : int [1:5] 189 102 235 135 39
## ..$ pos : int [1:5] 64 70 104 39 23
## ..$ posprob : num [1:5] 0.253 0.407 0.307 0.224 0.371
## ..$ woe : num [1:5] -0.2356 0.4708 0.0321 -0.3944 0.3192
## ..$ bin_iv : num [1:5] 0.013349 0.041253 0.000352 0.024792 0.006689
## ..$ total_iv : num [1:5] 0.0864 0.0864 0.0864 0.0864 0.0864
## ..$ breaks : chr [1:5] "> 7 yrs" "0 - 1 yrs" "1 - 4 yrs" "4 - 7 yrs" ...
## ..$ is_special_values: logi [1:5] FALSE FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ installment_rate :Classes 'data.table' and 'data.frame': 3 obs. of 12 variables:
## ..$ variable : chr [1:3] "installment_rate" "installment_rate" "installment_rate"
## ..$ bin : chr [1:3] "1%,%2" "3" "4"
## ..$ count : int [1:3] 367 157 476
## ..$ count_distr : num [1:3] 0.367 0.157 0.476
## ..$ neg : int [1:3] 271 112 317
## ..$ pos : int [1:3] 96 45 159
## ..$ posprob : num [1:3] 0.262 0.287 0.334
## ..$ woe : num [1:3] -0.1905 -0.0645 0.1573
## ..$ bin_iv : num [1:3] 0.012789 0.000645 0.012135
## ..$ total_iv : num [1:3] 0.0256 0.0256 0.0256
## ..$ breaks : chr [1:3] "1%,%2" "3" "4"
## ..$ is_special_values: logi [1:3] FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ personal_status :Classes 'data.table' and 'data.frame': 3 obs. of 12 variables:
## ..$ variable : chr [1:3] "personal_status" "personal_status" "personal_status"
## ..$ bin : chr [1:3] "divorced male" "female" "married male%,%single male"
## ..$ count : int [1:3] 50 310 640
## ..$ count_distr : num [1:3] 0.05 0.31 0.64
## ..$ neg : int [1:3] 30 201 469
## ..$ pos : int [1:3] 20 109 171
## ..$ posprob : num [1:3] 0.4 0.352 0.267
## ..$ woe : num [1:3] 0.442 0.235 -0.162
## ..$ bin_iv : num [1:3] 0.0105 0.0179 0.0162
## ..$ total_iv : num [1:3] 0.0446 0.0446 0.0446
## ..$ breaks : chr [1:3] "divorced male" "female" "married male%,%single male"
## ..$ is_special_values: logi [1:3] FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ other_debtors :Classes 'data.table' and 'data.frame': 2 obs. of 12 variables:
## ..$ variable : chr [1:2] "other_debtors" "other_debtors"
## ..$ bin : chr [1:2] "co-applicant%,%guarantor" "none"
## ..$ count : int [1:2] 93 907
## ..$ count_distr : num [1:2] 0.093 0.907
## ..$ neg : int [1:2] 65 635
## ..$ pos : int [1:2] 28 272
## ..$ posprob : num [1:2] 0.301 0.3
## ..$ woe : num [1:2] 0.005115 -0.000525
## ..$ bin_iv : num [1:2] 2.44e-06 2.50e-07
## ..$ total_iv : num [1:2] 2.69e-06 2.69e-06
## ..$ breaks : chr [1:2] "co-applicant%,%guarantor" "none"
## ..$ is_special_values: logi [1:2] FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ residence_history:Classes 'data.table' and 'data.frame': 4 obs. of 12 variables:
## ..$ variable : chr [1:4] "residence_history" "residence_history" "residence_history" "residence_history"
## ..$ bin : chr [1:4] "1" "2" "3" "4"
## ..$ count : int [1:4] 130 308 149 413
## ..$ count_distr : num [1:4] 0.13 0.308 0.149 0.413
## ..$ neg : int [1:4] 94 211 106 289
## ..$ pos : int [1:4] 36 97 43 124
## ..$ posprob : num [1:4] 0.277 0.315 0.289 0.3
## ..$ woe : num [1:4] -0.11248 0.07015 -0.05494 0.00115
## ..$ bin_iv : num [1:4] 1.61e-03 1.54e-03 4.45e-04 5.49e-07
## ..$ total_iv : num [1:4] 0.00359 0.00359 0.00359 0.00359
## ..$ breaks : chr [1:4] "1" "2" "3" "4"
## ..$ is_special_values: logi [1:4] FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ property :Classes 'data.table' and 'data.frame': 4 obs. of 12 variables:
## ..$ variable : chr [1:4] "property" "property" "property" "property"
## ..$ bin : chr [1:4] "building society savings" "other" "real estate" "unknown/none"
## ..$ count : int [1:4] 232 332 282 154
## ..$ count_distr : num [1:4] 0.232 0.332 0.282 0.154
## ..$ neg : int [1:4] 161 230 222 87
## ..$ pos : int [1:4] 71 102 60 67
## ..$ posprob : num [1:4] 0.306 0.307 0.213 0.435
## ..$ woe : num [1:4] 0.0286 0.0342 -0.461 0.5861
## ..$ bin_iv : num [1:4] 0.00019 0.000391 0.054007 0.05805
## ..$ total_iv : num [1:4] 0.113 0.113 0.113 0.113
## ..$ breaks : chr [1:4] "building society savings" "other" "real estate" "unknown/none"
## ..$ is_special_values: logi [1:4] FALSE FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ installment_plan :Classes 'data.table' and 'data.frame': 2 obs. of 12 variables:
## ..$ variable : chr [1:2] "installment_plan" "installment_plan"
## ..$ bin : chr [1:2] "bank" "none%,%stores"
## ..$ count : int [1:2] 139 861
## ..$ count_distr : num [1:2] 0.139 0.861
## ..$ neg : int [1:2] 82 618
## ..$ pos : int [1:2] 57 243
## ..$ posprob : num [1:2] 0.41 0.282
## ..$ woe : num [1:2] 0.4836 -0.0861
## ..$ bin_iv : num [1:2] 0.03524 0.00628
## ..$ total_iv : num [1:2] 0.0415 0.0415
## ..$ breaks : chr [1:2] "bank" "none%,%stores"
## ..$ is_special_values: logi [1:2] FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ housing :Classes 'data.table' and 'data.frame': 3 obs. of 12 variables:
## ..$ variable : chr [1:3] "housing" "housing" "housing"
## ..$ bin : chr [1:3] "for free" "own" "rent"
## ..$ count : int [1:3] 108 713 179
## ..$ count_distr : num [1:3] 0.108 0.713 0.179
## ..$ neg : int [1:3] 64 527 109
## ..$ pos : int [1:3] 44 186 70
## ..$ posprob : num [1:3] 0.407 0.261 0.391
## ..$ woe : num [1:3] 0.473 -0.194 0.404
## ..$ bin_iv : num [1:3] 0.0261 0.0258 0.0314
## ..$ total_iv : num [1:3] 0.0833 0.0833 0.0833
## ..$ breaks : chr [1:3] "for free" "own" "rent"
## ..$ is_special_values: logi [1:3] FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ existing_credits :Classes 'data.table' and 'data.frame': 2 obs. of 12 variables:
## ..$ variable : chr [1:2] "existing_credits" "existing_credits"
## ..$ bin : chr [1:2] "1" "2%,%3%,%4"
## ..$ count : int [1:2] 633 367
## ..$ count_distr : num [1:2] 0.633 0.367
## ..$ neg : int [1:2] 433 267
## ..$ pos : int [1:2] 200 100
## ..$ posprob : num [1:2] 0.316 0.272
## ..$ woe : num [1:2] 0.0749 -0.1348
## ..$ bin_iv : num [1:2] 0.0036 0.00648
## ..$ total_iv : num [1:2] 0.0101 0.0101
## ..$ breaks : chr [1:2] "1" "2%,%3%,%4"
## ..$ is_special_values: logi [1:2] FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ default :Classes 'data.table' and 'data.frame': 1 obs. of 12 variables:
## ..$ variable : chr "default"
## ..$ bin : chr "1%,%2"
## ..$ count : int 1000
## ..$ count_distr : num 1
## ..$ neg : int 700
## ..$ pos : int 300
## ..$ posprob : num 0.3
## ..$ woe : num 0
## ..$ bin_iv : num 0
## ..$ total_iv : num 0
## ..$ breaks : chr "1%,%2"
## ..$ is_special_values: logi FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ dependents :Classes 'data.table' and 'data.frame': 2 obs. of 12 variables:
## ..$ variable : chr [1:2] "dependents" "dependents"
## ..$ bin : chr [1:2] "1" "2"
## ..$ count : int [1:2] 845 155
## ..$ count_distr : num [1:2] 0.845 0.155
## ..$ neg : int [1:2] 591 109
## ..$ pos : int [1:2] 254 46
## ..$ posprob : num [1:2] 0.301 0.297
## ..$ woe : num [1:2] 0.00282 -0.01541
## ..$ bin_iv : num [1:2] 6.71e-06 3.67e-05
## ..$ total_iv : num [1:2] 4.34e-05 4.34e-05
## ..$ breaks : chr [1:2] "1" "2"
## ..$ is_special_values: logi [1:2] FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ telephone :Classes 'data.table' and 'data.frame': 2 obs. of 12 variables:
## ..$ variable : chr [1:2] "telephone" "telephone"
## ..$ bin : chr [1:2] "none" "yes"
## ..$ count : int [1:2] 596 404
## ..$ count_distr : num [1:2] 0.596 0.404
## ..$ neg : int [1:2] 409 291
## ..$ pos : int [1:2] 187 113
## ..$ posprob : num [1:2] 0.314 0.28
## ..$ woe : num [1:2] 0.0647 -0.0986
## ..$ bin_iv : num [1:2] 0.00253 0.00385
## ..$ total_iv : num [1:2] 0.00638 0.00638
## ..$ breaks : chr [1:2] "none" "yes"
## ..$ is_special_values: logi [1:2] FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ foreign_worker :Classes 'data.table' and 'data.frame': 1 obs. of 12 variables:
## ..$ variable : chr "foreign_worker"
## ..$ bin : chr "no%,%yes"
## ..$ count : int 1000
## ..$ count_distr : num 1
## ..$ neg : int 700
## ..$ pos : int 300
## ..$ posprob : num 0.3
## ..$ woe : num 0
## ..$ bin_iv : num 0
## ..$ total_iv : num 0
## ..$ breaks : chr "no%,%yes"
## ..$ is_special_values: logi FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>
## $ job :Classes 'data.table' and 'data.frame': 3 obs. of 12 variables:
## ..$ variable : chr [1:3] "job" "job" "job"
## ..$ bin : chr [1:3] "mangement self-employed" "skilled employee%,%unemployed non-resident" "unskilled resident"
## ..$ count : int [1:3] 148 652 200
## ..$ count_distr : num [1:3] 0.148 0.652 0.2
## ..$ neg : int [1:3] 97 459 144
## ..$ pos : int [1:3] 51 193 56
## ..$ posprob : num [1:3] 0.345 0.296 0.28
## ..$ woe : num [1:3] 0.2044 -0.0191 -0.0972
## ..$ bin_iv : num [1:3] 0.006424 0.000236 0.001851
## ..$ total_iv : num [1:3] 0.00851 0.00851 0.00851
## ..$ breaks : chr [1:3] "mangement self-employed" "skilled employee%,%unemployed non-resident" "unskilled resident"
## ..$ is_special_values: logi [1:3] FALSE FALSE FALSE
## ..- attr(*, ".internal.selfref")=<externalptr>La instrucción permite inspeccionar la estructura del objeto generado por la función . El objeto es una lista donde cada elemento corresponde a una variable categórica tratada, y cada uno es un con información sobre los bins generados por el algoritmo de binning supervisado.
Cada contiene, para cada bin:En resumen, muestra la codificación WOE y el desglose de la importancia predictiva (IV) de cada categoría o intervalo, aportando una visión granular del proceso de transformación supervisada aplicada a cada predictor categórico.
…
A lo largo del proceso, se evaluaron varios modelos y técnicas para la predicción del riesgo de impago default. La justificación de la selección final se apoya en la robustez, interpretabilidad y capacidad predictiva de los modelos probados:
Selección de variables: El análisis de correlaciones, V de Cramér e Information Value (IV) identificó consistentemente cinco variables clave: checking_balance, credit_history, savings_balance, purpose y months_loan_duration}. Estas variables concentran la mayor parte de la información predictiva y su interpretación es relevante en la toma de decisiones bancarias.
Justificación del número de variables: La inclusión exclusiva de variables con mayor IV y significancia estadística simplifica el modelo, mejora su interpretabilidad y reduce el riesgo de sobreajuste, sin perder precisión.
Comparativa de modelos: Se testearon los modelos C5.0, C5.0 con boosting, rpart, randomForest, XGBoost y regresión logística, todos ellos con precisión similar (72–77%). El modelo rpart alcanzó la mayor precisión en test 76.65%, aunque las diferencias fueron mínimas.
Fiabilidad y eficiencia: El modelo rpart} se selecciona como el más eficiente y recomendable, porque: Genera reglas claras y fácilmente interpretables. Permite identificar factores de riesgo concretos en cada predicción. Presenta un rendimiento competitivo, bajo coste computacional y alta transparencia.
Capacidad predictiva: Aunque la precisión del 72–77% es adecuada en un entorno realista, la discriminación de la clase minoritaria default podría mejorarse con técnicas de balanceo y ajuste de umbrales.
- Aplicar técnicas de balanceo (SMOTE, submuestreo, ponderación) para mejorar la predicción de impagos. - Ajustar hiperparámetros mediante validación cruzada y grid search, tanto en árboles como en modelos de ensamblado. - Explorar reducción de dimensionalidad (PCA) y profundizar en la selección de variables. - Incorporar herramientas de explicabilidad avanzada (SHAP, LIME) para modelos complejos. - Automatizar el pipeline analítico y crear dashboards interactivos para los equipos de negocio.
En conclusión, el proyecto permitió construir y validar modelos robustos y explicables, sentando las bases para futuras mejoras y demostrando la utilidad de la minería de datos en el ámbito financiero.