library(C50)
library(caret)
library(tidyverse)En este análisis desarrollaremos un modelo simple de aprobación de crédito utilizando árboles de decisión C5.0. También veremos cómo se pueden ajustar los resultados del modelo para minimizar los errores que pueden dar lugar a pérdidas económicas para la institución.
El conjunto de datos de crédito incluye 1000 ejemplos de préstamos, más un conjunto de variables numéricas y nominales que indican las características del préstamo y del solicitante del préstamo. Una variable de clase indica si el préstamo entró en incumplimiento. Veamos si podemos determinar algún patrón que prediga este resultado.
archivo = "https://raw.githubusercontent.com/stedy/Machine-Learning-with-R-datasets/master/credit.csv"
file <- download.file(archivo, destfile = "credit.csv")
data <- read.csv("credit.csv", stringsAsFactors = T)Factorizamos la variable default, que indica si el solicitante del préstamo no pudo cumplir con los términos de pago acordados y entró en incumplimiento. Un total del 30% de los préstamos en este conjunto de datos entró en incumplimiento:
data$default <- factor(data$default, levels = c(2,1), labels = c("yes", "no"))
table(data$default)##
## yes no
## 300 700Existen un par de características que podrían predecir el incumplimiento del pago: el saldo de la cuenta corriente y de ahorro del solicitante (checking_balance y savings_balance).
summary(data$months_loan_duration)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.0 12.0 18.0 20.9 24.0 72.0summary(data$amount)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 250 1366 2320 3271 3972 18424También podemos observar que el préstamo mediano es de 2320 DM y tiene una duración de 18 meses.
No estamos seguros de que el orden de los registros sea aleatorio, por lo cual haremos una extracción aleatoria, asegurándonos de establecer una semilla para poder asegurar la replicabilidad del experimento. Daremos un 90% a training y un 10% a test.
set.seed(123)
training_sample <- sample(1000, 900)
data_training <- data[training_sample,]
data_test <- data[-training_sample,]Vamos a comprobar que la partición se ha hecho correctamente y tenemos similar proporción de defaults en ambos datasets.
prop.table(table(data_training$default))##
## yes no
## 0.2966667 0.7033333prop.table(table(data_test$default))##
## yes no
## 0.33 0.67Nos dan proporciones similares, en torno al 70/30, así que podemos proceder.
Utilizaremos el algoritmo c5.0 con sus parámetros por defecto. Hemos de aplicar este algoritmo a todas las columnas del dataset de training, a excepción de la número 17, que es la que queremos predecir
modeloc50 <- C5.0(data_training[-17], data_training$default)
summary(modeloc50)##
## Call:
## C5.0.default(x = data_training[-17], y = data_training$default)
##
##
## C5.0 [Release 2.07 GPL Edition] Thu Aug 1 18:19:23 2019
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 900 cases (21 attributes) from undefined.data
##
## Decision tree:
##
## checking_balance in {> 200 DM,unknown}: no (412/50)
## checking_balance in {< 0 DM,1 - 200 DM}:
## :...other_debtors = guarantor:
## :...months_loan_duration > 36: yes (4/1)
## : months_loan_duration <= 36:
## : :...installment_plan in {none,stores}: no (24)
## : installment_plan = bank:
## : :...purpose = car (new): yes (3)
## : purpose in {business,car (used),domestic appliances,education,
## : furniture,others,radio/tv,repairs,
## : retraining}: no (7/1)
## other_debtors in {co-applicant,none}:
## :...credit_history = critical: no (102/30)
## credit_history = fully repaid: yes (27/6)
## credit_history = fully repaid this bank:
## :...other_debtors = co-applicant: no (2)
## : other_debtors = none: yes (26/8)
## credit_history in {delayed,repaid}:
## :...savings_balance in {> 1000 DM,501 - 1000 DM}: no (19/3)
## savings_balance = 101 - 500 DM:
## :...other_debtors = co-applicant: yes (3)
## : other_debtors = none:
## : :...personal_status in {divorced male,
## : : married male}: yes (6/1)
## : personal_status = female:
## : :...installment_rate <= 3: no (4/1)
## : : installment_rate > 3: yes (4)
## : personal_status = single male:
## : :...age <= 41: no (15/2)
## : age > 41: yes (2)
## savings_balance = unknown:
## :...credit_history = delayed: no (8)
## : credit_history = repaid:
## : :...foreign_worker = no: no (2)
## : foreign_worker = yes:
## : :...checking_balance = < 0 DM:
## : :...telephone = none: yes (11/2)
## : : telephone = yes:
## : : :...amount <= 5045: no (5/1)
## : : amount > 5045: yes (2)
## : checking_balance = 1 - 200 DM:
## : :...residence_history > 3: no (9)
## : residence_history <= 3: [S1]
## savings_balance = < 100 DM:
## :...months_loan_duration > 39:
## :...residence_history <= 1: no (2)
## : residence_history > 1: yes (19/1)
## months_loan_duration <= 39:
## :...purpose in {car (new),retraining}: yes (47/16)
## purpose in {domestic appliances,others}: no (3)
## purpose = car (used):
## :...amount <= 8086: no (9/1)
## : amount > 8086: yes (5)
## purpose = education:
## :...checking_balance = < 0 DM: yes (5)
## : checking_balance = 1 - 200 DM: no (2)
## purpose = repairs:
## :...residence_history <= 3: yes (4/1)
## : residence_history > 3: no (3)
## purpose = business:
## :...credit_history = delayed: yes (2)
## : credit_history = repaid:
## : :...age <= 34: no (5)
## : age > 34: yes (2)
## purpose = radio/tv:
## :...employment_length in {0 - 1 yrs,
## : : unemployed}: yes (14/5)
## : employment_length = 4 - 7 yrs: no (3)
## : employment_length = > 7 yrs:
## : :...amount <= 932: yes (2)
## : : amount > 932: no (7)
## : employment_length = 1 - 4 yrs:
## : :...months_loan_duration <= 15: no (6)
## : months_loan_duration > 15:
## : :...amount <= 3275: yes (7)
## : amount > 3275: no (2)
## purpose = furniture:
## :...residence_history <= 1: no (8/1)
## residence_history > 1:
## :...installment_plan = bank: yes (2/1)
## installment_plan = stores: no (1)
## installment_plan = none:
## :...telephone = yes: yes (7/1)
## telephone = none:
## :...months_loan_duration > 27: yes (3)
## months_loan_duration <= 27: [S2]
##
## SubTree [S1]
##
## property in {building society savings,unknown/none}: yes (4)
## property = other: no (6)
## property = real estate:
## :...job in {mangement self-employed,skilled employee,
## : unskilled resident}: yes (2)
## job = unemployed non-resident: no (2)
##
## SubTree [S2]
##
## checking_balance = 1 - 200 DM: yes (5/2)
## checking_balance = < 0 DM:
## :...property in {building society savings,real estate,unknown/none}: no (8)
## property = other:
## :...installment_rate <= 1: no (2)
## installment_rate > 1: yes (4)
##
##
## Evaluation on training data (900 cases):
##
## Decision Tree
## ----------------
## Size Errors
##
## 55 135(15.0%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 177 90 (a): class yes
## 45 588 (b): class no
##
##
## Attribute usage:
##
## 100.00% checking_balance
## 54.22% other_debtors
## 50.00% credit_history
## 32.56% savings_balance
## 25.22% months_loan_duration
## 19.78% purpose
## 10.11% residence_history
## 7.33% installment_plan
## 5.22% telephone
## 4.78% foreign_worker
## 4.56% employment_length
## 4.33% amount
## 3.44% personal_status
## 3.11% property
## 2.67% age
## 1.56% installment_rate
## 0.44% job
##
##
## Time: 0.0 secsCon este modelo obtenemos un error del 15% en la predicción.
data_predicted <- predict(modeloc50, data_test)
confusionMatrix(data = data_predicted, reference = data_test$default, positive = "yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction yes no
## yes 14 8
## no 19 59
##
## Accuracy : 0.73
## 95% CI : (0.632, 0.8139)
## No Information Rate : 0.67
## P-Value [Acc > NIR] : 0.12002
##
## Kappa : 0.333
##
## Mcnemar's Test P-Value : 0.05429
##
## Sensitivity : 0.4242
## Specificity : 0.8806
## Pos Pred Value : 0.6364
## Neg Pred Value : 0.7564
## Prevalence : 0.3300
## Detection Rate : 0.1400
## Detection Prevalence : 0.2200
## Balanced Accuracy : 0.6524
##
## 'Positive' Class : yes
## Hemos obtenido una exactitud del 73%, con un error del 27%. Esta cifra es algo mayor que la obtenida al ajustar el modelo al dataset de training, lo cual era esperable. De cara al negocio, este modelo tiene una sensibilidad del 42%. Es decir, solamente somos capaces de predecir el 42% de los clientes que van a incurrir en incumplimiento de pago. Necesitamos mejorar este dato.
Para ello haremo uso del concepto de Boosting. El Boosting se basa en la noción de que al combinar una serie de learners con bajo rendimiento, se puede crear un equipo que sea mucho más fuerte que cualquiera de los learners solos. Cada uno de los modelos tiene un conjunto único de fortalezas y debilidades y pueden ser mejores o peores para resolver ciertos problemas. El uso de una combinación de varios learners con fortalezas y debilidades complementarias puede, por lo tanto, mejorar dramáticamente la precisión de un clasificador. La función C5.0 () facilita agregar el boosting a nuestro árbol de decisión C5.0. Simplemente necesitamos agregar un parámetro de prueba adicional que indique el número de árboles de decisión separados para usar en el equipo de boosting.
modeloc50_1 <- C5.0(data_training[-17], data_training$default, trials = 10)
data_predicted2 <- predict(modeloc50_1, data_test)
confusionMatrix(data = data_predicted2, reference = data_test$default, positive = "yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction yes no
## yes 15 5
## no 18 62
##
## Accuracy : 0.77
## 95% CI : (0.6751, 0.8483)
## No Information Rate : 0.67
## P-Value [Acc > NIR] : 0.01938
##
## Kappa : 0.4221
##
## Mcnemar's Test P-Value : 0.01234
##
## Sensitivity : 0.4545
## Specificity : 0.9254
## Pos Pred Value : 0.7500
## Neg Pred Value : 0.7750
## Prevalence : 0.3300
## Detection Rate : 0.1500
## Detection Prevalence : 0.2000
## Balanced Accuracy : 0.6900
##
## 'Positive' Class : yes
## La exactitud ha aumentado a un 77% y la sensibilidad a un 45%. Aunque ha mejorado, no ha sido gran cosa.
Vamos a especificar al árbol de decisión qué errores son más importantes evitar, para ello generamos una matriz de costes, en la cual indicamos que los falsos negativos ponderan 4 veces más que los falsos positivos.
matrix_dimensions <- list(c("yes", "no"), c("yes", "no"))
names(matrix_dimensions) <- c("prediction", "reference")
error_cost <- matrix(c(0, 4, 1, 0), nrow = 2, dimnames = matrix_dimensions)
error_cost## reference
## prediction yes no
## yes 0 1
## no 4 0modeloc50_costs <- C5.0(data_training[-17], data_training$default, costs = error_cost)
data_predicted_costs <- predict(modeloc50_costs, data_test)
confusionMatrix(data = data_predicted_costs, reference = data_test$default, positive = "yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction yes no
## yes 26 34
## no 7 33
##
## Accuracy : 0.59
## 95% CI : (0.4871, 0.6874)
## No Information Rate : 0.67
## P-Value [Acc > NIR] : 0.9629
##
## Kappa : 0.2322
##
## Mcnemar's Test P-Value : 4.896e-05
##
## Sensitivity : 0.7879
## Specificity : 0.4925
## Pos Pred Value : 0.4333
## Neg Pred Value : 0.8250
## Prevalence : 0.3300
## Detection Rate : 0.2600
## Detection Prevalence : 0.6000
## Balanced Accuracy : 0.6402
##
## 'Positive' Class : yes
## Con este cambio hemos variado la distribución de los errores. Se han reducido los falsos negativos, lo cual es una ventaja para el banco pero como contrapartida hemos aumentado los falsos positivos (lo cual redunda en un criterio más exigente para que el cliente pueda acceder al crédito).