Introducción ✋🏼
En esta publicación estaremos aplicando algunos algoritmos de Machine Learning para clasificar transacciones fraudulentas con tarjetas de crédito. Para ello, utilizaremos un dataset publicado en Kaggle que contiene 284.807 transacciones con tarjetas de crédito, de las cuáles 492 son fradulentas, lo que implica un conjunto de datos muy desbalanceado.
Por cuestiones relacionadas a la confidencialidad, todas las variables numéricas han sido transformadas mediante PCA, excepto por la variable Time y Amount.
Sin más nos adentramos en el ejercicio.
Análisis Exploratorio 📰
Primeramente vamos a cargar el dataset.
data <- readr::read_csv("data/creditcard.csv")
Como primer paso, con la librería DataExplorer observaremos si el dataset tiene valores pérdidos.
Como puede observarse no existen valores pérdidos en el dataset, por lo que ahora avanzaremos con la distribución de la variable target (Class).
Aquí puede observarse que sólo el 0,24% de las transacciones han sido fraudulentas, en tanto que más del 99% no lo fueron.
📊Distribución de las transacciones (fraudulentas y no) según la variable time
En el gráfico de densidad, puede observarse que las transacciones fraudulentas suelen darse en un periodo de tiempo menor. Asimismo, luego de los 100 mil segundos las transacciones no fradulentas caen, en cambio las fraudulentas se mantienen.
Descripción de la variable Amount
| Class | Mean | Median | Q1 | Q3 | Max |
|---|---|---|---|---|---|
| 0 | 88.29102 | 22.00 | 5.65 | 77.05 | 25691.16 |
| 1 | 122.21132 | 9.25 | 1.00 | 105.89 | 2125.87 |
Si miramos la distribución del amount entre las transacciones por Class, se puede apreciar que la distribución de los montos de las transacciones fraudulentas es más asimétrica en comparación con las no fraudulentas (ver la diferencia entre el promedio y la mediana). Más aún, si comparamos la mediana en este caso puede verse que las transacciones no fraudulentas muestran un valor más alto (22 vs 9.25).
Esto también puede verse en el siguiente gráfico, en dónde además removemos los valores atípicos (valores por encima del Q3 + (1.5 * IQR) o por debajo del Q1 - (1.5 * IQR)).
💻 Entrenamos los modelos
🔪 Dividimos el dataset en train y test
La distribución de la variable target (Class) en el dataset de train es 0.17 y en el dataset de test es 0.18
⚙️ Instanciamos los modelos a entrenar
Primeramente creamos la receta y luego instanciamos los modelos.
#Armamos la receta
fraud_rcp <- recipe(Class ~ ., data)
#Instanciamos los modelos
logistic <-
logistic_reg() %>%
set_engine('glm')
decision_tree <-
decision_tree() %>%
set_engine('rpart') %>%
set_mode('classification')
rand_forest <-
rand_forest() %>%
set_engine('ranger') %>%
set_mode('classification')
xgboost <-
boost_tree() %>%
set_engine('xgboost') %>%
set_mode('classification')
Creamos una función que nos permita evaluar los modelos instanciados en la etapa anterior y nos devuelva como resultado la matriz de confusión y las métricas. Se seleccionaron accuracy, recall y roc_auc para evaluar los modelos. La inclusión del roc_auc como métrica responde a que se ajusta de forma adecuada a la evaluación de modelos entrenados con conjuntos de datos desbalanceados.
#Creo una función para evaluar los modelos
run_exploration <- function(model, receta){
#Entrenamos el modelo
set.seed(123)
model.fit <- workflow()%>%
add_recipe(receta) %>%
add_model(model) %>%
fit(train)
#Obtenemos las métricas de error
set.seed(123)
#Predecimos los valores
y_predicha <- model.fit %>%
predict(test)
#Uno los valores predichos al test
result <- test %>%
select(Class)%>%
bind_cols(y_predicha) %>%
as.data.frame()
#Seteo las métricas
eval_metrics <- metric_set(recall, accuracy)
#Genero las métricas
metricas = eval_metrics(data = result, truth = Class, estimate = .pred_class)
metricas <- as.data.frame(metricas)
modelo = deparse(substitute(model))
metricas$model <- rep(modelo,nrow(metricas))
#Creo la matriz de confusión
cm <- conf_mat(data = result, truth = Class, estimate = .pred_class)
#Grafico la matriz
cm_graf <- autoplot(cm, type = "heatmap") +
scale_fill_gradient(low = "white", high = "#badb33")
#Obtenemos las probabilidades
y_predicha_prob <- model.fit %>%
predict(test, type= "prob")
# Unimos las probabilidades al test
result_prob <- test %>%
select(Class)%>%
bind_cols(y_predicha_prob) %>%
as.data.frame()
#Calculamos el ROC_AUC y se suma a metricas
roc_auc <- result_prob %>%
roc_auc(Class, .pred_1)
roc_auc$model <- rep(modelo,nrow(roc_auc))
#Uno el ROC_AUC al resto de las metricas
metricas <- rbind(metricas,roc_auc)
return(list("result" = result,"metricas"= metricas, "cm"= cm_graf))
}
📏 Evaluamos los modelos
test_log = run_exploration(logistic,fraud_rcp)
test_dt = run_exploration(decision_tree,fraud_rcp)
test_rf = run_exploration(rand_forest,fraud_rcp)
test_xgboost = run_exploration(xgboost,fraud_rcp)
decision_tree
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.728 | decision_tree |
| accuracy | binary | 0.999 | decision_tree |
| roc_auc | binary | 0.901 | decision_tree |
logistic
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.570 | logistic |
| accuracy | binary | 0.999 | logistic |
| roc_auc | binary | 0.973 | logistic |
rand_forest
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.755 | rand_forest |
| accuracy | binary | 1.000 | rand_forest |
| roc_auc | binary | 0.954 | rand_forest |
xgboost
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.755 | xgboost |
| accuracy | binary | 1.000 | xgboost |
| roc_auc | binary | 0.947 | xgboost |
Observaciones
- En los 4 modelos entrenados puede observarse el escenario de un valor alto de accuracy (precisión) pero bajo de recall (sensibilidad). Esto quiere decir que nuestro modelo es eficiente en clasificar correctamente los datos pero es deficiente para clasificar correctamente los casos (en nuestro conjunto la clase minoritaria).
- El modelo logistico fué el que peor recall mostró, en tanto que el modelo random forest com xgboost mostraron los mejores valores de recall.
- Todos los modelos presentaron valores alto de roc_auc.
⚖️ Estrategias para tratar con datos desbalanceados
Existen diversas estrategias para tratar con datos desbalanceados. Entre ellas, el sobremuestreo (Over-sampling) de la clase minoritariao el submuestreo (Under-sampling) de la clase mayoritaria.
En el ecosistema de tidymoldels contamos con el paquete themis que permite agregar pasos a la receta.
Veamos como funcionan algunas de estas estrategias.
Sobremuestreamos la clase minoritaria hasta igualar el 100% de la mayoritaria
recipe(Class ~ ., data) %>%
step_mutate_at(Class,fn = factor) %>%
step_relevel(Class,ref_level = "1") %>%
step_upsample(Class,over_ratio = 0.5) %>%
prep() %>%
bake(new_data = NULL) %>%
group_by(Class)%>%
summarise(n= n()) %>%
kableExtra::kbl() %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover"))
| Class | n |
|---|---|
| 1 | 142157 |
| 0 | 284315 |
Submuestreamos la clase mayoritaria hasta igual el 100% de la minoritaria
recipe(Class ~ ., data) %>%
step_mutate_at(Class,fn = factor) %>%
step_relevel(Class,ref_level = "1") %>%
step_downsample(Class,under_ratio = 1) %>%
prep() %>%
bake(new_data = NULL) %>%
group_by(Class)%>%
summarise(n= n()) %>%
kableExtra::kbl() %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover"))
| Class | n |
|---|---|
| 1 | 492 |
| 0 | 492 |
Sobremuestro utilizando el algoritmo SMOTE (Synthetic Minority Oversampling Technique)
Este algoritmo crea nuevos ejemplos de la clase minoritaria utilizando los k vecinos más cercanos.
recipe(Class ~ ., data) %>%
step_mutate_at(Class,fn = factor) %>%
step_relevel(Class,ref_level = "1") %>%
step_smote(Class,over_ratio = 1) %>%
prep() %>%
bake(new_data = NULL) %>%
group_by(Class)%>%
summarise(n= n()) %>%
kableExtra::kbl() %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover"))
| Class | n |
|---|---|
| 1 | 284315 |
| 0 | 284315 |
⚙️Re-entrenamos los modelos
Ahora suraremos a la receta un paso adicional, que es el sobremuestreo mediante el algrotimo SMOTE.
fraud_resample_rec <- recipe(Class ~ ., data) %>%
step_mutate_at(Class,fn = factor) %>%
step_relevel(Class,ref_level = "1") %>%
step_smote(Class,over_ratio = 1)
Obtenemos las métricas
test_log_resample = run_exploration(logistic,fraud_resample_rec)
test_dt_resample = run_exploration(decision_tree,fraud_resample_rec)
test_xgboost_resample = run_exploration(xgboost,fraud_resample_rec)
decision_tree
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.861 | decision_tree |
| accuracy | binary | 0.965 | decision_tree |
| roc_auc | binary | 0.914 | decision_tree |
logistic
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.854 | logistic |
| accuracy | binary | 0.993 | logistic |
| roc_auc | binary | 0.976 | logistic |
xgboost
| .metric | .estimator | .estimate | model |
|---|---|---|---|
| recall | binary | 0.841 | xgboost |
| accuracy | binary | 0.997 | xgboost |
| roc_auc | binary | 0.979 | xgboost |
Observaciones
- Los modelos reentrenados mostraron una mejoría sustancial en el recall,destacándose el modelo logístico que paso de un recall de 57% a 85%, pasando a ser el modelo con mayor recall de los entrenados.
- Lo que sí debemos considerar que esta mejoría en el recall trae aparejado un incremento en los Falsos positivos. Por ejemplo en el caso del modelo logístico el número de Falsos positivos pasó de 11 a 616.
- El modelo xgboost si bien tiene un menor recall que el anterior, genera menor cantidad de Falsos positivos (266), pero vale la pena plantear en escenarios el impacto en el negocio.
💵 Analizamos el impacto del reentrenamiento en el negocio
Para esto plantearemos 3 escenarios:
Escenario 1: Analizar el costo (Amount) de los Verdaderos positivos (Fraudes) en el modelo XGBoost sin la estrategia de sobremuestreo.
Escenario 2: Analizar el costo (Amount) de los Verdaderos positivos (Fraudes) en el modelo XGBoost con sobremuestreo. De esta forma sabremos si logramos evitar mayores pérdidas monetarias versus el escenario 1.
Escenario 3: Analizar el costo (Amount) de los Falsos positivos (Transacciones clasificadas como fraude sin serlo) en el modelo XGBoost con sobremuestreo.
Escenario 1
test %>%
select(Amount) %>%
bind_cols(test_xgboost$result) %>%
summarise(Amount = sum(Amount[.pred_class== 1 & Class == 1])) %>%
kableExtra::kbl(format.args = list(big.mark= ".", decimal.mark=","),
col.names = "Escenario 1")%>%
kableExtra::kable_classic_2(full_width= F)
| Escenario 1 |
|---|
| 11.767,1 |
Escenario 2
test %>%
select(Amount) %>%
bind_cols(test_xgboost_resample$result) %>%
summarise(Amount = sum(Amount[.pred_class== 1 & Class == 1])) %>%
kableExtra::kbl(format.args = list(big.mark= ".", decimal.mark=","),
col.names = "Escenario 2",)%>%
kableExtra::kable_classic_2(full_width= F)
| Escenario 2 |
|---|
| 13.424,04 |
Como se puede observar, la mejoría en el rendimiento del modelo nos permite evitar fraudes por 13.424,04, es decir 1.656,94 más que con el primer modelo. Pero cabe preguntarse ¿Que monto representan las transacciones clasificadas como fraude sin serlo?
Escenario 3
test %>%
select(Amount) %>%
bind_cols(test_xgboost_resample[1]) %>%
summarise(Amount = sum(Amount[.pred_class== 1 & Class == 0])) %>%
kableExtra::kbl(format.args = list(big.mark= ".", decimal.mark=","),
col.names = "Escenario 3")%>%
kableExtra::kable_classic_2(full_width= F)
| Escenario 3 |
|---|
| 56.508,75 |
👉 En el escenario 3 puede verse el impacto que tienen los falsos positivos clasificados por nuestro modelo. Recordemos que en nuestro conjunto de datos la mediana del monto de las transacciones fraudulentas es menor que el de las no fraudulentas. Es muy importante considerar todos los escenarios posibles y el impacto que el o los modelos pueden tener en el negocio.