El dataset proporcionado, German Credit, tiene una estructura de 1000 registros con 21 filas distintas.
data<-read.csv("./credit.csv",header=T,sep=",")
attach(data)
# dimensiones
dim(data)## [1] 1000 21Una vez visualizado que, efectivamente tenemos 1000 registros con 21 filas distintas, queremos ver que tipo de variables tenemos y para ello usamos:
str(data)## '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" ...Vemos que la mayoria de las variables están definidas como caracter, asi que factorizaremos aquellas variables cualitativas y reconvertiremos las numéricas.
data[]<-lapply(data, factor)
str(data)## '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: Factor w/ 33 levels "4","5","6","7",..: 3 30 9 27 18 24 18 24 9 22 ...
## $ 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 : Factor w/ 921 levels "250","276","338",..: 143 771 391 849 735 870 534 814 563 748 ...
## $ 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 : Factor w/ 53 levels "19","20","21",..: 49 4 31 27 35 17 35 17 43 10 ...
## $ 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 ...Una vez factorizadas debemos mirar si tenemos valores nulos y la distribución de valores por variables. Mostraremos para cada atributo, la cantidad de valores perdidos usando la funcion summary().
summary(data)## checking_balance months_loan_duration credit_history
## < 0 DM :274 24 :184 critical :293
## > 200 DM : 63 12 :179 delayed : 88
## 1 - 200 DM:269 18 :113 fully repaid : 40
## unknown :394 36 : 83 fully repaid this bank: 49
## 6 : 75 repaid :530
## 15 : 64
## (Other):302
## purpose amount savings_balance employment_length
## radio/tv :280 1258 : 3 < 100 DM :603 > 7 yrs :253
## car (new) :234 1262 : 3 > 1000 DM : 48 0 - 1 yrs :172
## furniture :181 1275 : 3 101 - 500 DM :103 1 - 4 yrs :339
## car (used):103 1393 : 3 501 - 1000 DM: 63 4 - 7 yrs :174
## business : 97 1478 : 3 unknown :183 unemployed: 62
## education : 50 433 : 2
## (Other) : 55 (Other):983
## 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 27 : 51 bank :139 for free:108
## other :332 26 : 50 none :814 own :713
## real estate :282 23 : 48 stores: 47 rent :179
## unknown/none :154 24 : 44
## 28 : 43
## 25 : 41
## (Other):723
## 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
##
##
## Vemos que no tenemos ningun valor perdido y, finalmente, miraremos si hay valores faltantes.
missing <- data[is.na(data),]
dim(missing)## [1] 0 21Observamos que no nos falta ningun valor y, por lo tanto, no deberemos hacer modificaciones.
Por último, se nos exige un análisis de correlaciones:
if(!require(DescTools)){install.packages("DescTools"); library(DescTools)}## Loading required package: DescTools# calculamos la asociacion de las variables sospechosas con el target
asoc_checking <- CramerV(data$checking_balance, data$default)
asoc_history <- CramerV(data$credit_history, data$default)
print(paste("Asociación Checking vs Target:", round(asoc_checking, 4)))## [1] "Asociación Checking vs Target: 0.3517"print(paste("Asociación Historial vs Target:", round(asoc_history, 4)))## [1] "Asociación Historial vs Target: 0.2484"Valores de V de Crámer cercanos a 0.3 indican una asocicación media-alta y tenemos que Checking vs Target da 0.3517 que indica una asociación media-alta con el impago, lo cual confirma que es la variable con mayor poder predictivo e indica que debe ser la raiz de nuestro arbol de decisión.
Para hacer la visualización del conjunto de datos usaremos ggplot2, gridExtra y grid de R, aqui llamaremos a los repositorios pertinentes.
if(!require(ggplot2)){
install.packages('ggplot2', repos='http://cran.us.r-project.org')
library(ggplot2)
}## Loading required package: ggplot2if(!require(ggpubr)){
install.packages('ggpubr', repos='http://cran.us.r-project.org')
library(ggpubr)
}## Loading required package: ggpubrif(!require(grid)){
install.packages('grid', repos='http://cran.us.r-project.org')
library(grid)
}## Loading required package: gridif(!require(gridExtra)){
install.packages('gridExtra', repos='http://cran.us.r-project.org')
library(gridExtra)
}## Loading required package: gridExtraif(!require(C50)){
install.packages('C50', repos='http://cran.us.r-project.org')
library(C50)
}## Loading required package: C50Vamos a analizar los datos que tenemos ya que las conclusiones
dependerán de las caracteristicas de la muestra. Lo primero que haremos
es convertir el target en un factor más legible, No_Default
que significa buen pagador y Default que
significa mal pagador.
# convertimos el target a factor legible
data$default <- factor(data$default, levels = c(1, 2), labels = c("No_Default", "Default"))
# reconvertir variables numéricas
data$age <- as.numeric(as.character(data$age))
data$months_loan_duration <- as.numeric(as.character(data$months_loan_duration))
# saldo cuenta corriente vs Target
plotChecking <- ggplot(data, aes(x = checking_balance, fill = default)) +
geom_bar(position = "stack") +
labs(x = "Saldo cuenta", y = "Clientes") +
scale_fill_manual(values = c("steelblue", "firebrick")) +
ggtitle("Saldo en cuenta corriente") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# historial del credito vs Target
plotHistory <- ggplot(data, aes(x = credit_history, fill = default)) +
geom_bar(position = "stack") +
labs(x = "Historial", y = "Clientes") +
scale_fill_manual(values = c("steelblue", "firebrick")) +
ggtitle("Historial del crédito") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# propósito del crédito vs Target
plotPurpose <- ggplot(data, aes(x = purpose, fill = default)) +
geom_bar(position = "stack") +
labs(x = "Propósito", y = "Clientes") +
scale_fill_manual(values = c("steelblue", "firebrick")) +
ggtitle("Propósito del crédito") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# distribución por Edad vs Target
plotAge <- ggplot(data, aes(x = age, fill = default)) +
geom_histogram(bins = 15, color = "white", position = "stack") +
labs(x = "Edad (Años)", y = "Clientes") +
scale_fill_manual(values = c("steelblue", "firebrick")) +
ggtitle("Distribución por Edad") +
theme_minimal()
# distribución por Edad vs Target
plotDefault<-ggplot(data, aes(x = default, fill = default)) +
geom_bar() +
scale_fill_manual(values = c("steelblue", "firebrick")) +
labs(title = "No_Default vs Default",
x = "Estado del Crédito",
y = "Número de Clientes") +
theme_minimal() +
geom_text(stat='count', aes(label=..count..))
# renderizado final
grid.newpage()
grid.arrange(plotChecking, plotHistory, plotPurpose, plotDefault, ncol = 2)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Como ya hemos dicho, Default hace referencia al
incumplimiento de pago de un credito y con estas graficas podemos
hacernos una idea general de cuando hay un cliente que es buen
pagador en azul y un cliente que es
mal pagador en rojo, que podria
indicarnos un riesgo para la entidad financiera. Es muy importante
detectar aquellos que fallaran en sus pagos ya que el impacto de prestar
dinero a alguien que no lo vaya a devolver es mucho mayor que el
beneficio de prestarle a alguien que si.
De estos graficos podemos sacar que tenemos 700 buenos pagadores y
300 malos pagadores, lo que representa un 30% de la muestra total.
Podemos observar que los motivos más solicitados para pedir un prestamo
son para radio/tv y para coche. Teniendo el
primero unos 100 que han fallado en sus pagos respecto a los 230
totales, lo cual se adecúa al 30% visto anteriormente y en el segundo
unos 60 que han fallado en los pagos respecto a los 270 totales, que
equivale a un 22%, una media un poco menor a la vista anteriormente.
Para garantizar que el modelo es capaz de generalizar y no memorizar los datos, dividimos los datos en dos conjuntos, el de entrenamiento con un 70% de los datos y el de test con un 30%, donde garantizaremos que las reglas funcionan. Además, generaremos un modelo basado en reglas logicas que sea muy sencillo de integrar en los sistemas de decisión de un banco.
El algoritmo que usaremos, el C5.0, selecciona en cada nodo la
variable que mejor separa los clientes buenos, en cuanto a
pago recurrente, de los morosos.
set.seed(123) # garantiza que el analisis sea reproducible
idx <- sample(1:nrow(data), 0.7 * nrow(data))
train_data <- data[idx, ]
test_data <- data[-idx, ]
# usamos default como target
library(C50)
modelo_c50 <- C5.0(default ~ .,
data = train_data)
# visualización del arbol grafico
plot(modelo_c50, gp = gpar(fontsize = 8), main = "Estructura del Árbol C5.0")
# generacion de reglas de decision
modelo_reglas <- C5.0(default ~ .,
data = train_data,
rules = TRUE)
summary(modelo_reglas)##
## Call:
## C5.0.formula(formula = default ~ ., data = train_data, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Fri Dec 26 13:24:03 2025
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 700 cases (21 attributes) from undefined.data
##
## Rules:
##
## Default class: No_Default
##
##
## Evaluation on training data (700 cases):
##
## Rules
## ----------------
## No Errors
##
## 0 204(29.1%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 496 (a): class No_Default
## 204 (b): class Default
##
##
## Time: 0.0 secsAl llamar a la función summary(modelo_reglas) nos sale
que Rules: 0 y Errors: 204(29.1%), esto nos
indica que el algoritmo C5.0 ha decidido que ninguna variable es lo
suficientemente segura para crear una rama, asi que ha optado por
clasificar los 700 casos como default (a). Dado que si un patron no es
lo suficientemente fuerte, el algoritmo elige asignar todo a la clase
mayoritaria y como el 71% de los datos son No_Default, asi
lo hace.
Para solucionar este sesgo, aplicaremos una matriz de costes. En el sector bancario, el coste de prestar dinero a quien no pagará es muy superior al de denegar un crédito a quien sí pagaría. Por ello, hemos penalizado con un factor de x4 el error de no detectar a un moroso, obligando al árbol a ramificarse y generar una estructura de decisión real.
# penalizamos un x4 default no detectado
matrix_coste <- matrix(c(0, 1, 4, 0), nrow = 2)
colnames(matrix_coste) <- rownames(matrix_coste) <- levels(train_data$default)
library(C50)
# entrenamos de nuevo con C5.0
modelo_c50 <- C5.0(default ~ .,
data = train_data,
costs = matrix_coste,
control = C5.0Control(minCases = 10))
plot(modelo_c50, main = "Árbol de Decisión Ajustado", gp = gpar(fontsize = 6))
summary(modelo_reglas)##
## Call:
## C5.0.formula(formula = default ~ ., data = train_data, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Fri Dec 26 13:24:03 2025
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 700 cases (21 attributes) from undefined.data
##
## Rules:
##
## Default class: No_Default
##
##
## Evaluation on training data (700 cases):
##
## Rules
## ----------------
## No Errors
##
## 0 204(29.1%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 496 (a): class No_Default
## 204 (b): class Default
##
##
## Time: 0.0 secsAhora que hemos obligado al arbol de decisión a que encuentre las
diferencias dando un coste elevado sabiendo que dar dinero a quien no
pagará es más costoso que denegar un préstamo a un buen cliente. Por
ello, el modelo se ha vuelto más estricto y ha generado reglas basadas
en la variable critica, checking_balance.
Tras el ajuste, el modelo es más estricto y preventivo, basando su
logica en checking_balance:
modelo_reglas <- C5.0(default ~ .,
data = train_data,
rules = TRUE,
costs = matrix_coste)
summary(modelo_reglas)##
## Call:
## C5.0.formula(formula = default ~ ., data = train_data, rules = TRUE, costs
## = matrix_coste)
##
##
## C5.0 [Release 2.07 GPL Edition] Fri Dec 26 13:24:03 2025
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 700 cases (21 attributes) from undefined.data
## Read misclassification costs from undefined.costs
##
## Rules:
##
## Rule 1: (272/31, lift 1.2)
## checking_balance = unknown
## -> class No_Default [0.883]
##
## Rule 2: (428/255, lift 1.4)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## -> class Default [0.405]
##
## Default class: Default
##
##
## Evaluation on training data (700 cases):
##
## Rules
## -----------------------
## No Errors Cost
##
## 2 286(40.9%) 0.54 <<
##
##
## (a) (b) <-classified as
## ---- ----
## 241 255 (a): class No_Default
## 31 173 (b): class Default
##
##
## Attribute usage:
##
## 100.00% checking_balance
##
##
## Time: 0.0 secsLa regla 1 dice que si el balance es
unknown, se clasifica como No_Default,
clasificando 272 casos con una confianza del 83%. ¿Porque pasa esto? La
respuesta es sencilla, los clientes de los que no se tiene registro de
saldo suelen ser perfiles más estables, probablemente por
antiguedad.
La regla 2 dice que si el balance está en algun
rango conocido (<0, >200, 1-200DM), se clasifica como
Default ya que el modelo se vuelve preventivo y ante
cualquier fluctuación en el saldo, prefiere marcar el riesgo por impago
para proteger al banco. Clasifica 428 casos con una confianza del
40%.
Gracias a esta configuración, con checking_balance, se
detectan 173 morosos que pasaban desapercibidos en la primera versión.
Anque es un modelo muy sencillo, con una sola raiz, ya aporta un
conocimiento accionable para la prevención de riesgos del banco.
En este paso, observaremos si la precisión se mantienen con datos
nuevos de test_data.
# prediccion con datos de test
predicciones_test <- predict(modelo_c50, test_data)
tabla_final <- table(Realidad = test_data$default, Prediccion = predicciones_test)
# mostrar la tabla por consola
print(tabla_final)## Prediccion
## Realidad No_Default Default
## No_Default 95 109
## Default 10 86# calculo de la precision
accuracy_test <- sum(diag(tabla_final)) / sum(tabla_final)
print(paste("La precisión final en test es del:", round(accuracy_test * 100, 2), "%"))## [1] "La precisión final en test es del: 60.33 %"Observamos que la precisión final con el conjunto de datos
test_data es del 60.33%, lo cual es una caida respecto al
70% que da el modelo, aunque respecto a la estadistica sea un porcentaje
bajo, para el punto de vista bancario, es mejor que el modelo inicial.
Para el banco, un modelo que lo aprueba todo a ciegas no sería seguro
para sus intereses y este modelo al ser más desconfiado baja la
precisión porque deniega prestamos a buenos pagadores pero minimiza el
riesgo de pérdida de capital ante impagos reales.
Aunque el modelo es útil, no se deberia basar unicamente en el
checking_balance ya que es insuficiente para el veredicto
final, se deberían explorar otros modelos como
Random Forest.
Este modelo, crea un “bosque” de decisiones que votan el resultado final. Cada arbol mira un conjunto de datos random y combinando todos, votan y llegan a una decisión. Para el ejercicio, crearemos 500 arboles de decisión:
set.seed(123)
# reconvertir variables numéricas para entrenamiento (alguna ya la teniamos cambiada)
train_data$amount <- as.numeric(as.character(train_data$amount))
train_data$age <- as.numeric(as.character(train_data$age))
train_data$months_loan_duration <- as.numeric(as.character(train_data$months_loan_duration))
# reconvertir variables numéricas para test (alguna ya la teniamos cambiada)
test_data$amount <- as.numeric(as.character(test_data$amount))
test_data$age <- as.numeric(as.character(test_data$age))
test_data$months_loan_duration <- as.numeric(as.character(test_data$months_loan_duration))
# entrenamiento del Random Forest
if(!require(randomForest)){install.packages("randomForest"); library(randomForest)}## Loading required package: randomForest## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:gridExtra':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginmodelo_rf <- randomForest(default ~ ., data = train_data, ntree = 500, importance = TRUE)
# predicción y matriz de confusión
predicciones_rf <- predict(modelo_rf, test_data)
tabla_rf <- table(Realidad = test_data$default, Prediccion = predicciones_rf)
# resultados
print(tabla_rf)## Prediccion
## Realidad No_Default Default
## No_Default 191 13
## Default 56 40accuracy_rf <- sum(diag(tabla_rf)) / sum(tabla_rf)
print(paste("Precisión Random Forest:", round(accuracy_rf * 100, 2), "%"))## [1] "Precisión Random Forest: 77 %"Tras implementar el modelo de Random Forest con 500 árboles, los
resultados muestran una mejora en la capacidad predictiva. Hemos pasado
del 60.33% con C5.0 al 77% con Random Forest,
una subida de un 17% que indica que este modelo es mucho más capaz de
generalizar los patrones sin fijarse en una unca variable.
El modelo detecta 191 buenos pagadores y 40 morosos. Los falsos negativos se han reducido a 56 casos, siendo un modelo más equilibrado que el arbol simple. Random Forest combina decisiones de multiples arboles, lo que logra capturar la complejidad del riesgo crediticio.
Dado que Random Forest es un modelo de ensamble y no se puede visualizar directamente, he utilizado metricas de importancia para entender que factores han pesado más en la decisión final del algoritmo.
# visualizamos que variables son las mas importantes para el Random Forest
varImpPlot(modelo_rf,
main = "Importancia de Variables (Random Forest)",
col="darkblue",
pch=19)
Podemos ver que las metricas MeanDecreaseAccuracy y
MeanDeceaseGini coinciden en que
checking_balance, amount,
months_loan_duration son los predictores más criticos para
el banco. A diferencia de C5.0, Random Forest otorga un peso
signficiativo a amount y a la duración de éste, el sistema
entiende que el riesgo no depende del saldo actual sino del prestamo a
devolver y el tiempo que tiene para ello.
Los factores secundarios son variables como age,
purpose y el credit_history que aparecen con
una importancia media, ayudando a refinar la clasificación en casos
donde el saldo no es concluyente.
Pregunta: ¿Cómo solucionar el error “Can not handle categorical predictors with more than 53 categories” al ejecutar Random Forest?
Respuesta: La IA identificó que la variable
amount estaba siendo tratada como un factor con demasiados
niveles y sugirió convertirla a numérica.
Decisión: Se realizó una reconversión manual de
variables como amount y age a tipo numérico en
lugar de delegar en una automatización.
Reflexión Crítica: La IA identificó una limitación
técnica del paquete randomForest, pero decidí mantener el
criterio humano para decidir qué variables debían ser continuas y cuáles
categóricas para no perder interpretabilidad en el modelo.
En cuanto a evolución del modelo, hemos comenzado con un modelo C5.0 nulo que no aprendia nada y mediante una matriz de costes hemos logrado un modelo funcional sesgado con un 60.33% de precisión. Finalmente, con Random Forest, hemos conseguido una solución robusta con un 77% de acierto, una subida de un 17% de acierto, capaz de capturar la complejidad del riesgo crediticio.
El riesgo de impago en German Credit depende de muchos factores, un saldo desconocido/bajo indica una primera señal de alerta pero se debe contrastar con el importe del crédito solicitado para no tener un exceso de falsos positivos.