Análisis de clasificación
i) ¿Qué es Supervised Machine Learning y cuáles son algunas de sus aplicaciones en análisis de clasificación?
El aprendizaje supervisado es el proceso mediante la cual, por algoritmos sofisticados de distintos tipos, la computadora recibe una serie de entradas etiquetadas donde ya se sabe el resultado, posteriormente la computadora encuentra patrones, tendencias y comportamientos de los datos mediante algoritmos matemáticos y logra encontrar de qué manera esas entradas provocan las respuestas y de este modo logra predecir para nuevos datos las respuestas. En clasificación esto se aplica para que los algoritmos puedan encontrar la relación entre las vairables explicativas y una variable binaria donde los modelos logran predecir con la entrada de nuevos datos, a que clase pertenecen los datos, por ejemplo, se puede entrenar un modelo con datos de salud de miles de personas con las respuestas de si estas personas padecieron tales enfermedades, el modelo logrará encontrar relaciones entre los datos de salud y los diagnósticos y aprenderá a clasificar si un paciente tiene una enfermedad o no de acuerdo a la entrada de nuevos datos. Esto tiene grandes aplicaciones en muchas áreas donde se necesita saber con certeza si un conjunto de características provocarán tal o tal resultado.
ii) ¿Cuáles son los principales algoritmos de Supervised Machine Learning - Classification?
Regresión logística: Modelo de regresión donde se encuentra la probabilidad de que ocurra la variable dependiente y con un valor dado de la variable explicativa.
Árboles de decisión: Modela las probabilidades de que ocurra cierta clase dependiendo una serie de decisiones dentro de las variables. Es decir, modelo lo que pasaría para un conjunto de muchas decisiones en el conjunto de datos y las representa bajo un esquema de árbol con ramas que representan las decisiones y nodos que representan los resultados de dichas decisiones.
Random Forest: Modelo que combina los resultados de muchos árboles de decisión.
Naive Bayes: Modelo que calcula las probabilidades de que ocurra cierta clase dependiente las variables explicativas y combina dichas probabilidades según la metodología de probabilidades del teorema de bayes.
KNN: Logra etiquetar la clase mediante las distancias más cercanas de las etiquetas utilizando diversos tipos de distancias, frecuentemente la distancia euclidiana.
iii) Respecto a la selección de los resultados de los modelos de clasificación ¿Qué es la matriz de confusión? ¿Qué es el estadístico Kappa? ¿Cuál es la relación entre AUC y ROC Curve?
Matriz de Confusión: Es una tabla que ayuda a entender cómo de bueno es el modelo clasificando. Muestra las veces que el modelo acertó y falló en cada categoría.
Estadístico Kappa: Mide cuánto mejor es tu modelo clasificando en comparación con lo que se esperaría por azar. Donde un valor cercano a 1 quiere decir que el modelo es mucho mejor que el azar, un valor 0 significa que el modelo tiene un rendimiento igual que si los resultados se escogieron meramente por el azar y valor de -1 significa que el modelo es peor que lo que se escogería por el azar.
Relación entre AUC y ROC Curve: La curva ROC muestra qué tan bueno es el modelo distinguiendo entre clases a diferentes umbrales, y el AUC da el valor del área bajo la curva. Donde un área más grande significará una mejor separación de las clases.
Importación y limpieza de la base de datos
Librerías
library(foreign)
library(modelr)
library(dplyr)
library(tidyverse)
library(ggplot2)
library(broom)
library(ISLR)
library(readr)
library(caret)
library(e1071)
library(class)
library(ROCR)
library(pROC)
library(lmtest)
library(caTools)
library(rpart)
library(rpart.plot)
library(psych)
library(ggpubr)
library(reshape)
library(Metrics)
library(mlbench)
library(rsample)
library(cluster)
library(factoextra)
library(gridExtra)
library(modeldata)
library(klaR)
library(naivebayes)datos=read.csv("/Users/gabrielmedina/Downloads/Materiales 5/Act 2/bank_application_data.csv")
summary(datos)## SK_ID_CURR TARGET NAME_CONTRACT_TYPE CODE_GENDER
## Min. :100002 Min. :0.00000 Length:307511 Length:307511
## 1st Qu.:189146 1st Qu.:0.00000 Class :character Class :character
## Median :278202 Median :0.00000 Mode :character Mode :character
## Mean :278180 Mean :0.08073
## 3rd Qu.:367142 3rd Qu.:0.00000
## Max. :456255 Max. :1.00000
##
## FLAG_OWN_CAR FLAG_OWN_REALTY CNT_CHILDREN AMT_INCOME_TOTAL
## Length:307511 Length:307511 Min. : 0.0000 Min. : 25650
## Class :character Class :character 1st Qu.: 0.0000 1st Qu.: 112500
## Mode :character Mode :character Median : 0.0000 Median : 147150
## Mean : 0.4171 Mean : 168798
## 3rd Qu.: 1.0000 3rd Qu.: 202500
## Max. :19.0000 Max. :117000000
##
## AMT_CREDIT AMT_ANNUITY AMT_GOODS_PRICE NAME_TYPE_SUITE
## Min. : 45000 Min. : 1616 Min. : 40500 Length:307511
## 1st Qu.: 270000 1st Qu.: 16524 1st Qu.: 238500 Class :character
## Median : 513531 Median : 24903 Median : 450000 Mode :character
## Mean : 599026 Mean : 27109 Mean : 538396
## 3rd Qu.: 808650 3rd Qu.: 34596 3rd Qu.: 679500
## Max. :4050000 Max. :258026 Max. :4050000
## NA's :12 NA's :278
## NAME_INCOME_TYPE NAME_EDUCATION_TYPE NAME_FAMILY_STATUS NAME_HOUSING_TYPE
## Length:307511 Length:307511 Length:307511 Length:307511
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## REGION_POPULATION_RELATIVE DAYS_BIRTH DAYS_EMPLOYED DAYS_REGISTRATION
## Min. :0.00029 Min. :-25229 Min. :-17912 Min. :-24672
## 1st Qu.:0.01001 1st Qu.:-19682 1st Qu.: -2760 1st Qu.: -7480
## Median :0.01885 Median :-15750 Median : -1213 Median : -4504
## Mean :0.02087 Mean :-16037 Mean : 63815 Mean : -4986
## 3rd Qu.:0.02866 3rd Qu.:-12413 3rd Qu.: -289 3rd Qu.: -2010
## Max. :0.07251 Max. : -7489 Max. :365243 Max. : 0
##
## DAYS_ID_PUBLISH OWN_CAR_AGE FLAG_MOBIL FLAG_EMP_PHONE
## Min. :-7197 Min. : 0.00 Min. :0 Min. :0.0000
## 1st Qu.:-4299 1st Qu.: 5.00 1st Qu.:1 1st Qu.:1.0000
## Median :-3254 Median : 9.00 Median :1 Median :1.0000
## Mean :-2994 Mean :12.06 Mean :1 Mean :0.8199
## 3rd Qu.:-1720 3rd Qu.:15.00 3rd Qu.:1 3rd Qu.:1.0000
## Max. : 0 Max. :91.00 Max. :1 Max. :1.0000
## NA's :202929
## FLAG_WORK_PHONE FLAG_CONT_MOBILE FLAG_PHONE FLAG_EMAIL
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.00000
## 1st Qu.:0.0000 1st Qu.:1.0000 1st Qu.:0.0000 1st Qu.:0.00000
## Median :0.0000 Median :1.0000 Median :0.0000 Median :0.00000
## Mean :0.1994 Mean :0.9981 Mean :0.2811 Mean :0.05672
## 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.00000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.00000
##
## OCCUPATION_TYPE CNT_FAM_MEMBERS REGION_RATING_CLIENT
## Length:307511 Min. : 1.000 Min. :1.000
## Class :character 1st Qu.: 2.000 1st Qu.:2.000
## Mode :character Median : 2.000 Median :2.000
## Mean : 2.153 Mean :2.052
## 3rd Qu.: 3.000 3rd Qu.:2.000
## Max. :20.000 Max. :3.000
## NA's :2
## REGION_RATING_CLIENT_W_CITY WEEKDAY_APPR_PROCESS_START HOUR_APPR_PROCESS_START
## Min. :1.000 Length:307511 Min. : 0.00
## 1st Qu.:2.000 Class :character 1st Qu.:10.00
## Median :2.000 Mode :character Median :12.00
## Mean :2.032 Mean :12.06
## 3rd Qu.:2.000 3rd Qu.:14.00
## Max. :3.000 Max. :23.00
##
## REG_REGION_NOT_LIVE_REGION REG_REGION_NOT_WORK_REGION
## Min. :0.00000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.00000
## Median :0.00000 Median :0.00000
## Mean :0.01514 Mean :0.05077
## 3rd Qu.:0.00000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.00000
##
## LIVE_REGION_NOT_WORK_REGION REG_CITY_NOT_LIVE_CITY REG_CITY_NOT_WORK_CITY
## Min. :0.00000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
## Median :0.00000 Median :0.00000 Median :0.0000
## Mean :0.04066 Mean :0.07817 Mean :0.2305
## 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :1.00000 Max. :1.00000 Max. :1.0000
##
## LIVE_CITY_NOT_WORK_CITY ORGANIZATION_TYPE EXT_SOURCE_1 EXT_SOURCE_2
## Min. :0.0000 Length:307511 Min. :0.01 Min. :0.0000
## 1st Qu.:0.0000 Class :character 1st Qu.:0.33 1st Qu.:0.3925
## Median :0.0000 Mode :character Median :0.51 Median :0.5660
## Mean :0.1796 Mean :0.50 Mean :0.5144
## 3rd Qu.:0.0000 3rd Qu.:0.68 3rd Qu.:0.6636
## Max. :1.0000 Max. :0.96 Max. :0.8550
## NA's :173378 NA's :660
## EXT_SOURCE_3 APARTMENTS_AVG BASEMENTAREA_AVG YEARS_BEGINEXPLUATATION_AVG
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.37 1st Qu.:0.06 1st Qu.:0.04 1st Qu.:0.98
## Median :0.54 Median :0.09 Median :0.08 Median :0.98
## Mean :0.51 Mean :0.12 Mean :0.09 Mean :0.98
## 3rd Qu.:0.67 3rd Qu.:0.15 3rd Qu.:0.11 3rd Qu.:0.99
## Max. :0.90 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :60965 NA's :156061 NA's :179943 NA's :150007
## YEARS_BUILD_AVG COMMONAREA_AVG ELEVATORS_AVG ENTRANCES_AVG
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.69 1st Qu.:0.01 1st Qu.:0.00 1st Qu.:0.07
## Median :0.76 Median :0.02 Median :0.00 Median :0.14
## Mean :0.75 Mean :0.04 Mean :0.08 Mean :0.15
## 3rd Qu.:0.82 3rd Qu.:0.05 3rd Qu.:0.12 3rd Qu.:0.21
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :204488 NA's :214865 NA's :163891 NA's :154828
## FLOORSMAX_AVG FLOORSMIN_AVG LANDAREA_AVG LIVINGAPARTMENTS_AVG
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.17 1st Qu.:0.08 1st Qu.:0.02 1st Qu.:0.05
## Median :0.17 Median :0.21 Median :0.05 Median :0.08
## Mean :0.23 Mean :0.23 Mean :0.07 Mean :0.10
## 3rd Qu.:0.33 3rd Qu.:0.38 3rd Qu.:0.09 3rd Qu.:0.12
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :153020 NA's :208642 NA's :182590 NA's :210199
## LIVINGAREA_AVG NONLIVINGAPARTMENTS_AVG NONLIVINGAREA_AVG APARTMENTS_MODE
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.05 1st Qu.:0.00 1st Qu.:0.00 1st Qu.:0.05
## Median :0.07 Median :0.00 Median :0.00 Median :0.08
## Mean :0.11 Mean :0.01 Mean :0.03 Mean :0.11
## 3rd Qu.:0.13 3rd Qu.:0.00 3rd Qu.:0.03 3rd Qu.:0.14
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :154350 NA's :213514 NA's :169682 NA's :156061
## BASEMENTAREA_MODE YEARS_BEGINEXPLUATATION_MODE YEARS_BUILD_MODE
## Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.04 1st Qu.:0.98 1st Qu.:0.70
## Median :0.07 Median :0.98 Median :0.76
## Mean :0.09 Mean :0.98 Mean :0.76
## 3rd Qu.:0.11 3rd Qu.:0.99 3rd Qu.:0.82
## Max. :1.00 Max. :1.00 Max. :1.00
## NA's :179943 NA's :150007 NA's :204488
## COMMONAREA_MODE ELEVATORS_MODE ENTRANCES_MODE FLOORSMAX_MODE
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.01 1st Qu.:0.00 1st Qu.:0.07 1st Qu.:0.17
## Median :0.02 Median :0.00 Median :0.14 Median :0.17
## Mean :0.04 Mean :0.07 Mean :0.15 Mean :0.22
## 3rd Qu.:0.05 3rd Qu.:0.12 3rd Qu.:0.21 3rd Qu.:0.33
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :214865 NA's :163891 NA's :154828 NA's :153020
## FLOORSMIN_MODE LANDAREA_MODE LIVINGAPARTMENTS_MODE LIVINGAREA_MODE
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.08 1st Qu.:0.02 1st Qu.:0.05 1st Qu.:0.04
## Median :0.21 Median :0.05 Median :0.08 Median :0.07
## Mean :0.23 Mean :0.06 Mean :0.11 Mean :0.11
## 3rd Qu.:0.38 3rd Qu.:0.08 3rd Qu.:0.13 3rd Qu.:0.13
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :208642 NA's :182590 NA's :210199 NA's :154350
## NONLIVINGAPARTMENTS_MODE NONLIVINGAREA_MODE APARTMENTS_MEDI BASEMENTAREA_MEDI
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.00 1st Qu.:0.00 1st Qu.:0.06 1st Qu.:0.04
## Median :0.00 Median :0.00 Median :0.09 Median :0.08
## Mean :0.01 Mean :0.03 Mean :0.12 Mean :0.09
## 3rd Qu.:0.00 3rd Qu.:0.02 3rd Qu.:0.15 3rd Qu.:0.11
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :213514 NA's :169682 NA's :156061 NA's :179943
## YEARS_BEGINEXPLUATATION_MEDI YEARS_BUILD_MEDI COMMONAREA_MEDI
## Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.98 1st Qu.:0.69 1st Qu.:0.01
## Median :0.98 Median :0.76 Median :0.02
## Mean :0.98 Mean :0.76 Mean :0.04
## 3rd Qu.:0.99 3rd Qu.:0.83 3rd Qu.:0.05
## Max. :1.00 Max. :1.00 Max. :1.00
## NA's :150007 NA's :204488 NA's :214865
## ELEVATORS_MEDI ENTRANCES_MEDI FLOORSMAX_MEDI FLOORSMIN_MEDI
## Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.00 1st Qu.:0.07 1st Qu.:0.17 1st Qu.:0.08
## Median :0.00 Median :0.14 Median :0.17 Median :0.21
## Mean :0.08 Mean :0.15 Mean :0.23 Mean :0.23
## 3rd Qu.:0.12 3rd Qu.:0.21 3rd Qu.:0.33 3rd Qu.:0.38
## Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
## NA's :163891 NA's :154828 NA's :153020 NA's :208642
## LANDAREA_MEDI LIVINGAPARTMENTS_MEDI LIVINGAREA_MEDI
## Min. :0.00 Min. :0.00 Min. :0.00
## 1st Qu.:0.02 1st Qu.:0.05 1st Qu.:0.05
## Median :0.05 Median :0.08 Median :0.07
## Mean :0.07 Mean :0.10 Mean :0.11
## 3rd Qu.:0.09 3rd Qu.:0.12 3rd Qu.:0.13
## Max. :1.00 Max. :1.00 Max. :1.00
## NA's :182590 NA's :210199 NA's :154350
## NONLIVINGAPARTMENTS_MEDI NONLIVINGAREA_MEDI FONDKAPREMONT_MODE
## Min. :0.00 Min. :0.00 Length:307511
## 1st Qu.:0.00 1st Qu.:0.00 Class :character
## Median :0.00 Median :0.00 Mode :character
## Mean :0.01 Mean :0.03
## 3rd Qu.:0.00 3rd Qu.:0.03
## Max. :1.00 Max. :1.00
## NA's :213514 NA's :169682
## HOUSETYPE_MODE TOTALAREA_MODE WALLSMATERIAL_MODE EMERGENCYSTATE_MODE
## Length:307511 Min. :0.00 Length:307511 Length:307511
## Class :character 1st Qu.:0.04 Class :character Class :character
## Mode :character Median :0.07 Mode :character Mode :character
## Mean :0.10
## 3rd Qu.:0.13
## Max. :1.00
## NA's :148431
## OBS_30_CNT_SOCIAL_CIRCLE DEF_30_CNT_SOCIAL_CIRCLE OBS_60_CNT_SOCIAL_CIRCLE
## Min. : 0.000 Min. : 0.0000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 0.0000 1st Qu.: 0.000
## Median : 0.000 Median : 0.0000 Median : 0.000
## Mean : 1.422 Mean : 0.1434 Mean : 1.405
## 3rd Qu.: 2.000 3rd Qu.: 0.0000 3rd Qu.: 2.000
## Max. :348.000 Max. :34.0000 Max. :344.000
## NA's :1021 NA's :1021 NA's :1021
## DEF_60_CNT_SOCIAL_CIRCLE DAYS_LAST_PHONE_CHANGE FLAG_DOCUMENT_2
## Min. : 0.0 Min. :-4292.0 Min. :0.00e+00
## 1st Qu.: 0.0 1st Qu.:-1570.0 1st Qu.:0.00e+00
## Median : 0.0 Median : -757.0 Median :0.00e+00
## Mean : 0.1 Mean : -962.9 Mean :4.23e-05
## 3rd Qu.: 0.0 3rd Qu.: -274.0 3rd Qu.:0.00e+00
## Max. :24.0 Max. : 0.0 Max. :1.00e+00
## NA's :1021 NA's :1
## FLAG_DOCUMENT_3 FLAG_DOCUMENT_4 FLAG_DOCUMENT_5 FLAG_DOCUMENT_6
## Min. :0.00 Min. :0.00e+00 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.00 1st Qu.:0.00e+00 1st Qu.:0.00000 1st Qu.:0.00000
## Median :1.00 Median :0.00e+00 Median :0.00000 Median :0.00000
## Mean :0.71 Mean :8.13e-05 Mean :0.01511 Mean :0.08806
## 3rd Qu.:1.00 3rd Qu.:0.00e+00 3rd Qu.:0.00000 3rd Qu.:0.00000
## Max. :1.00 Max. :1.00e+00 Max. :1.00000 Max. :1.00000
##
## FLAG_DOCUMENT_7 FLAG_DOCUMENT_8 FLAG_DOCUMENT_9 FLAG_DOCUMENT_10
## Min. :0.0000000 Min. :0.00000 Min. :0.000000 Min. :0.00e+00
## 1st Qu.:0.0000000 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.00e+00
## Median :0.0000000 Median :0.00000 Median :0.000000 Median :0.00e+00
## Mean :0.0001919 Mean :0.08138 Mean :0.003896 Mean :2.28e-05
## 3rd Qu.:0.0000000 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:0.00e+00
## Max. :1.0000000 Max. :1.00000 Max. :1.000000 Max. :1.00e+00
##
## FLAG_DOCUMENT_11 FLAG_DOCUMENT_12 FLAG_DOCUMENT_13 FLAG_DOCUMENT_14
## Min. :0.000000 Min. :0.0e+00 Min. :0.000000 Min. :0.000000
## 1st Qu.:0.000000 1st Qu.:0.0e+00 1st Qu.:0.000000 1st Qu.:0.000000
## Median :0.000000 Median :0.0e+00 Median :0.000000 Median :0.000000
## Mean :0.003912 Mean :6.5e-06 Mean :0.003525 Mean :0.002936
## 3rd Qu.:0.000000 3rd Qu.:0.0e+00 3rd Qu.:0.000000 3rd Qu.:0.000000
## Max. :1.000000 Max. :1.0e+00 Max. :1.000000 Max. :1.000000
##
## FLAG_DOCUMENT_15 FLAG_DOCUMENT_16 FLAG_DOCUMENT_17 FLAG_DOCUMENT_18
## Min. :0.00000 Min. :0.000000 Min. :0.0000000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.0000000 1st Qu.:0.00000
## Median :0.00000 Median :0.000000 Median :0.0000000 Median :0.00000
## Mean :0.00121 Mean :0.009928 Mean :0.0002667 Mean :0.00813
## 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:0.0000000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.000000 Max. :1.0000000 Max. :1.00000
##
## FLAG_DOCUMENT_19 FLAG_DOCUMENT_20 FLAG_DOCUMENT_21
## Min. :0.0000000 Min. :0.0000000 Min. :0.0000000
## 1st Qu.:0.0000000 1st Qu.:0.0000000 1st Qu.:0.0000000
## Median :0.0000000 Median :0.0000000 Median :0.0000000
## Mean :0.0005951 Mean :0.0005073 Mean :0.0003349
## 3rd Qu.:0.0000000 3rd Qu.:0.0000000 3rd Qu.:0.0000000
## Max. :1.0000000 Max. :1.0000000 Max. :1.0000000
##
## AMT_REQ_CREDIT_BUREAU_HOUR AMT_REQ_CREDIT_BUREAU_DAY
## Min. :0.00 Min. :0.00
## 1st Qu.:0.00 1st Qu.:0.00
## Median :0.00 Median :0.00
## Mean :0.01 Mean :0.01
## 3rd Qu.:0.00 3rd Qu.:0.00
## Max. :4.00 Max. :9.00
## NA's :41519 NA's :41519
## AMT_REQ_CREDIT_BUREAU_WEEK AMT_REQ_CREDIT_BUREAU_MON AMT_REQ_CREDIT_BUREAU_QRT
## Min. :0.00 Min. : 0.00 Min. : 0.00
## 1st Qu.:0.00 1st Qu.: 0.00 1st Qu.: 0.00
## Median :0.00 Median : 0.00 Median : 0.00
## Mean :0.03 Mean : 0.27 Mean : 0.27
## 3rd Qu.:0.00 3rd Qu.: 0.00 3rd Qu.: 0.00
## Max. :8.00 Max. :27.00 Max. :261.00
## NA's :41519 NA's :41519 NA's :41519
## AMT_REQ_CREDIT_BUREAU_YEAR
## Min. : 0.0
## 1st Qu.: 0.0
## Median : 1.0
## Mean : 1.9
## 3rd Qu.: 3.0
## Max. :25.0
## NA's :41519# Establecer la semilla para reproducibilidad
set.seed(123)
# Usa sample_frac para seleccionar el 60% de los datos de forma aleatoria
data <- datos %>%
sample_frac(1)Como se puede apreciar en la base de datos, hay variables que tienen datos que no se pueden explicar porque no se cuenta con la descripción exacta de las variables, por otro lado, algunas variables tienen demasiados datos nulos y datos que no son fáciles de interpretar por su naturaleza y otros que no aportan a la capacidad clasificatoria de modelos de machine learning, por lo que dichas variables serán eliminadas para mejorar la capacidad de simplicidad e interpretabilidad del modelo.
Por lo anterior se realizará una limpieza de datos corrigiendo algunos nombres confusos, con errores ortográficos y carácteres especiales, por nombres más simples y correctamente registrados. Por otro lado, se pasará a factor las variables categóricas para algunos modelos y a numericas para otros modelos.
En las variables restantes se eliminarán los datos nulos ya que sólo representan una muy poca proporción de los datos.
df <- data[, c("TARGET", "CODE_GENDER", "FLAG_OWN_CAR", "FLAG_OWN_REALTY",
"CNT_CHILDREN", "AMT_INCOME_TOTAL", "AMT_CREDIT", "AMT_ANNUITY",
"AMT_GOODS_PRICE", "NAME_INCOME_TYPE", "NAME_EDUCATION_TYPE",
"NAME_FAMILY_STATUS", "NAME_HOUSING_TYPE", "DAYS_EMPLOYED",
"REGION_RATING_CLIENT", "OBS_30_CNT_SOCIAL_CIRCLE")]
df$NAME_HOUSING_TYPE = gsub("With parents", "Parents", df$NAME_HOUSING_TYPE)
df$NAME_HOUSING_TYPE = gsub("House / apartment", "House", df$NAME_HOUSING_TYPE)
df$NAME_EDUCATION_TYPE = gsub("Secondary / secondary special", "Secondary", df$NAME_EDUCATION_TYPE)
df$NAME_EDUCATION_TYPE = gsub("Lower secondary", "Secondary", df$NAME_EDUCATION_TYPE)
df$NAME_FAMILY_STATUS = gsub("Single / not married", "Single", df$NAME_FAMILY_STATUS)
df$TARGET = factor(ifelse(df$TARGET == 1, "Fraud", "Not-fraud"))
df$DAYS_EMPLOYED = abs(df$DAYS_EMPLOYED)
df$TARGET <- as.factor(df$TARGET)
df$CODE_GENDER <- as.factor(df$CODE_GENDER)
df$FLAG_OWN_CAR <- as.factor(df$FLAG_OWN_CAR)
df$FLAG_OWN_REALTY <- as.factor(df$FLAG_OWN_REALTY)
df$NAME_INCOME_TYPE <- as.factor(df$NAME_INCOME_TYPE)
df$NAME_EDUCATION_TYPE <- as.factor(df$NAME_EDUCATION_TYPE)
df$NAME_FAMILY_STATUS <- as.factor(df$NAME_FAMILY_STATUS)
df$NAME_HOUSING_TYPE <- as.factor(df$NAME_HOUSING_TYPE)
df<- df %>%
filter(OBS_30_CNT_SOCIAL_CIRCLE <= 15)
df=na.omit(df)
df_numeric=dfdf_numeric <- df %>%
mutate(
# Convertir TARGET a numérico con los niveles especificados
TARGET = as.numeric(factor(TARGET, levels = c("Not-fraud", "Fraud"))) - 1,
# Convertir CODE_GENDER a numérico: 'F' como 0, 'M' como 1
CODE_GENDER = as.numeric(factor(CODE_GENDER, levels = c("F", "M"))) - 1,
# Convertir FLAG_OWN_CAR y FLAG_OWN_REALTY a numérico: 'N' como 0, 'Y' como 1
FLAG_OWN_CAR = as.numeric(factor(FLAG_OWN_CAR, levels = c("N", "Y"))) - 1,
FLAG_OWN_REALTY = as.numeric(factor(FLAG_OWN_REALTY, levels = c("N", "Y"))) - 1,
# Convertir NAME_INCOME_TYPE a numérico según los niveles especificados
NAME_INCOME_TYPE = as.numeric(factor(NAME_INCOME_TYPE, levels = c("Working", "State servant", "Commercial associate", "Pensioner",
"Unemployed", "Student", "Businessman", "Maternity leave"))) - 1,
# Convertir NAME_EDUCATION_TYPE a numérico según los niveles especificados
NAME_EDUCATION_TYPE = as.numeric(factor(NAME_EDUCATION_TYPE, levels = c("Secondary", "Incomplete higher", "Higher education", "Academic degree"))) - 1,
# Convertir NAME_FAMILY_STATUS a numérico según los niveles especificados
NAME_FAMILY_STATUS = as.numeric(factor(NAME_FAMILY_STATUS, levels = c("Single", "Married", "Civil marriage", "Widow",
"Separated", "Unknown"))) - 1,
NAME_HOUSING_TYPE = as.numeric(factor(NAME_HOUSING_TYPE, levels = c("House", "Rented apartment", "Parents", "Municipal apartment",
"Office apartment", "Co-op apartment"))) - 1
)Análisis Exploratorio
Identificación de datos faltantes
Los datos nulos y faltantes de corrigeron en la parte anterior de la limpieza de datos, lo cual se corrobora a continuación…
df_numeric_2=df_numeric
nas_summary <- df %>%
summarise_each(funs(sum(is.na(.))))## Warning: `summarise_each()` was deprecated in dplyr 0.7.0.
## ℹ Please use `across()` instead.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.print(nas_summary)## TARGET CODE_GENDER FLAG_OWN_CAR FLAG_OWN_REALTY CNT_CHILDREN AMT_INCOME_TOTAL
## 1 0 0 0 0 0 0
## AMT_CREDIT AMT_ANNUITY AMT_GOODS_PRICE NAME_INCOME_TYPE NAME_EDUCATION_TYPE
## 1 0 0 0 0 0
## NAME_FAMILY_STATUS NAME_HOUSING_TYPE DAYS_EMPLOYED REGION_RATING_CLIENT
## 1 0 0 0 0
## OBS_30_CNT_SOCIAL_CIRCLE
## 1 0Medidas descriptivas y de dispersión
summary(df)## TARGET CODE_GENDER FLAG_OWN_CAR FLAG_OWN_REALTY CNT_CHILDREN
## Fraud : 24736 F :201303 N:201691 N: 93743 Min. : 0.0000
## Not-fraud:281021 M :104450 Y:104066 Y:212014 1st Qu.: 0.0000
## XNA: 4 Median : 0.0000
## Mean : 0.4171
## 3rd Qu.: 1.0000
## Max. :19.0000
##
## AMT_INCOME_TOTAL AMT_CREDIT AMT_ANNUITY AMT_GOODS_PRICE
## Min. : 25650 Min. : 45000 Min. : 1616 Min. : 40500
## 1st Qu.: 112500 1st Qu.: 270000 1st Qu.: 16574 1st Qu.: 238500
## Median : 146250 Median : 517500 Median : 24939 Median : 450000
## Mean : 168672 Mean : 599823 Mean : 27136 Mean : 538680
## 3rd Qu.: 202500 3rd Qu.: 808650 3rd Qu.: 34605 3rd Qu.: 679500
## Max. :117000000 Max. :4050000 Max. :258026 Max. :4050000
##
## NAME_INCOME_TYPE NAME_EDUCATION_TYPE
## Working :157894 Academic degree : 164
## Commercial associate: 71158 Higher education : 74279
## Pensioner : 55063 Incomplete higher: 10207
## State servant : 21590 Secondary :221107
## Unemployed : 19
## Student : 18
## (Other) : 15
## NAME_FAMILY_STATUS NAME_HOUSING_TYPE DAYS_EMPLOYED
## Civil marriage: 29615 Co-op apartment : 1109 Min. : 0
## Married :195355 House :271308 1st Qu.: 933
## Separated : 19663 Municipal apartment: 11125 Median : 2219
## Single : 45114 Office apartment : 2602 Mean : 67742
## Unknown : 0 Parents : 14766 3rd Qu.: 5710
## Widow : 16010 Rented apartment : 4847 Max. :365243
##
## REGION_RATING_CLIENT OBS_30_CNT_SOCIAL_CIRCLE
## Min. :1.000 Min. : 0.000
## 1st Qu.:2.000 1st Qu.: 0.000
## Median :2.000 Median : 0.000
## Mean :2.053 Mean : 1.396
## 3rd Qu.:2.000 3rd Qu.: 2.000
## Max. :3.000 Max. :15.000
## # Función para calcular estadísticas
calcular_estadisticas <- function(columna) {
rango <- max(columna, na.rm = TRUE) - min(columna, na.rm = TRUE)
varianza <- var(columna, na.rm = TRUE)
desviacion_std <- sd(columna, na.rm = TRUE)
rango_iqr <- IQR(columna, na.rm = TRUE)
c(Rango = rango, Varianza = varianza, `Desviación Estándar` = desviacion_std, `Rango Intercuartílico` = rango_iqr)
}
# Aplicar la función a cada columna numérica de df
estadisticas_df <- sapply(df, function(x) if(is.numeric(x)) calcular_estadisticas(x) else NA)
# Mostrar las estadísticas
estadisticas_df## $TARGET
## [1] NA
##
## $CODE_GENDER
## [1] NA
##
## $FLAG_OWN_CAR
## [1] NA
##
## $FLAG_OWN_REALTY
## [1] NA
##
## $CNT_CHILDREN
## Rango Varianza Desviación Estándar
## 19.0000000 0.5216123 0.7222273
## Rango Intercuartílico
## 1.0000000
##
## $AMT_INCOME_TOTAL
## Rango Varianza Desviación Estándar
## 1.169744e+08 5.641062e+10 2.375092e+05
## Rango Intercuartílico
## 9.000000e+04
##
## $AMT_CREDIT
## Rango Varianza Desviación Estándar
## 4.005000e+06 1.620767e+11 4.025875e+05
## Rango Intercuartílico
## 5.386500e+05
##
## $AMT_ANNUITY
## Rango Varianza Desviación Estándar
## 256410.00 209582722.72 14476.97
## Rango Intercuartílico
## 18031.50
##
## $AMT_GOODS_PRICE
## Rango Varianza Desviación Estándar
## 4009500 136495492776 369453
## Rango Intercuartílico
## 441000
##
## $NAME_INCOME_TYPE
## [1] NA
##
## $NAME_EDUCATION_TYPE
## [1] NA
##
## $NAME_FAMILY_STATUS
## [1] NA
##
## $NAME_HOUSING_TYPE
## [1] NA
##
## $DAYS_EMPLOYED
## Rango Varianza Desviación Estándar
## 3.652430e+05 1.944864e+10 1.394584e+05
## Rango Intercuartílico
## 4.777000e+03
##
## $REGION_RATING_CLIENT
## Rango Varianza Desviación Estándar
## 2.0000000 0.2590070 0.5089273
## Rango Intercuartílico
## 0.0000000
##
## $OBS_30_CNT_SOCIAL_CIRCLE
## Rango Varianza Desviación Estándar
## 15.000000 4.937028 2.221942
## Rango Intercuartílico
## 2.000000describe(df)## vars n mean sd median trimmed
## TARGET* 1 305757 1.92 0.27 2 2.00
## CODE_GENDER* 2 305757 1.34 0.47 1 1.30
## FLAG_OWN_CAR* 3 305757 1.34 0.47 1 1.30
## FLAG_OWN_REALTY* 4 305757 1.69 0.46 2 1.74
## CNT_CHILDREN 5 305757 0.42 0.72 0 0.25
## AMT_INCOME_TOTAL 6 305757 168671.75 237509.21 146250 155403.18
## AMT_CREDIT 7 305757 599822.82 402587.52 517500 549859.51
## AMT_ANNUITY 8 305757 27136.13 14476.97 24939 25691.53
## AMT_GOODS_PRICE 9 305757 538680.33 369452.96 450000 489513.76
## NAME_INCOME_TYPE* 10 305757 5.67 2.54 8 5.84
## NAME_EDUCATION_TYPE* 11 305757 3.48 0.86 4 3.60
## NAME_FAMILY_STATUS* 12 305757 2.47 1.17 2 2.33
## NAME_HOUSING_TYPE* 13 305757 2.26 0.83 2 2.01
## DAYS_EMPLOYED 14 305757 67742.42 139458.39 2219 38994.31
## REGION_RATING_CLIENT 15 305757 2.05 0.51 2 2.07
## OBS_30_CNT_SOCIAL_CIRCLE 16 305757 1.40 2.22 0 0.90
## mad min max range skew
## TARGET* 0.00 1.0 2.0 1 -3.07
## CODE_GENDER* 0.00 1.0 3.0 2 0.67
## FLAG_OWN_CAR* 0.00 1.0 2.0 1 0.67
## FLAG_OWN_REALTY* 0.00 1.0 2.0 1 -0.84
## CNT_CHILDREN 0.00 0.0 19.0 19 1.98
## AMT_INCOME_TOTAL 63381.15 25650.0 117000000.0 116974350 391.88
## AMT_CREDIT 376070.39 45000.0 4050000.0 4005000 1.23
## AMT_ANNUITY 13056.52 1615.5 258025.5 256410 1.58
## AMT_GOODS_PRICE 333585.00 40500.0 4050000.0 4009500 1.35
## NAME_INCOME_TYPE* 0.00 1.0 8.0 7 -0.36
## NAME_EDUCATION_TYPE* 0.00 1.0 4.0 3 -1.10
## NAME_FAMILY_STATUS* 0.00 1.0 6.0 5 1.54
## NAME_HOUSING_TYPE* 0.00 1.0 6.0 5 3.21
## DAYS_EMPLOYED 2367.71 0.0 365243.0 365243 1.66
## REGION_RATING_CLIENT 0.00 1.0 3.0 2 0.09
## OBS_30_CNT_SOCIAL_CIRCLE 0.00 0.0 15.0 15 2.22
## kurtosis se
## TARGET* 7.45 0.00
## CODE_GENDER* -1.55 0.00
## FLAG_OWN_CAR* -1.55 0.00
## FLAG_OWN_REALTY* -1.30 0.00
## CNT_CHILDREN 7.93 0.00
## AMT_INCOME_TOTAL 191632.11 429.53
## AMT_CREDIT 1.93 728.07
## AMT_ANNUITY 7.75 26.18
## AMT_GOODS_PRICE 2.43 668.15
## NAME_INCOME_TYPE* -1.59 0.00
## NAME_EDUCATION_TYPE* -0.73 0.00
## NAME_FAMILY_STATUS* 2.04 0.00
## NAME_HOUSING_TYPE* 9.27 0.00
## DAYS_EMPLOYED 0.77 252.21
## REGION_RATING_CLIENT 0.80 0.00
## OBS_30_CNT_SOCIAL_CIRCLE 5.75 0.00El conjunto de datos analizado proporciona una visión integral de los factores asociados con el riesgo de fraude en instituciones bancarias. Se distinguen dos categorías principales en la variable objetivo ‘TARGET’: casos de fraude y casos que no son fraude, lo que indica una prevalencia significativamente mayor de casos legítimos sobre fraudulentos en la muestra.
La distribución de género en el conjunto de datos es predominada por mujeres. En cuanto a la posesión de bienes, la mayoría de los encuestados no posee un automóvil, mientras que la mayoría de ellos son propietarios de bienes raíces, sugiriendo una posición de activos considerablemente alta entre los participantes que cobra sentido en un contexto real ya que la mayoría de las personas bancarizadas tienen al menos un bien dentro de su patrimonio y utilizan los créditos bancarios como un medio para obtener algún bien en su vida, mayoritariamente casas propias.
Los hijos representan una variable demográfica, variando de 0 a 2 por individuo, con una media de 0.42, lo que indica que más de la mitad de la muestra no tiene hijos. La situación financiera de los participantes, medida por el ingreso total anual, el crédito total, la anualidad y el precio de los bienes, muestra una amplia gama que va desde ingresos modestos hasta ingresos relativamente altos, con medias de $197,417 para ingreso total, 662,437 para crédito total, 28,963 para anualidad, y 594,667 para el precio de los bienes.
En términos de perfil ocupacional, la mayoría de los encuestados trabajan, seguidos por ‘Commercial associate’ (18 casos), mientras que una minoría se identifica como pensionados o servidores públicos. El nivel educativo se inclina ampliamente hacia una educación secundaria, evidenciando un nivel de educación relativamente bajo entre los participantes.
La situación familiar varía, predominando los casados sobre otras categorías como casados. La mayoría de los participantes reside en casas, reflejando las preferencias de vivienda dentro de la muestra. Los días empleados presentan un rango extenso, desde tan solo 87 días hasta 365,243, con una media significativamente alta debido a outliers, sugiriendo variaciones considerables en la experiencia laboral.
El rating de región y el número de consultas a buró de crédito en los últimos 30 días, agregan dimensiones adicionales al perfil demográfico y de riesgo, con una calificación regional promedio ligeramente por encima de 2 y un promedio de consultas a buró sociales cercano a 1, mostrando un nivel bajo de consultas a buró.
Este conjunto de datos revela patrones complejos, en las características demográficas, financieras y sociales de los individuos, ofreciendo perspectivas valiosas para la identificación y análisis de riesgo de fraude en instituciones bancarias.
Comportamiento de las variables
pie(table(df$TARGET), labels = c("Fraud", "Not-fraud"), main = "Distribution of TARGET")
Como se aprecia la mayoría de los casos de la base de datos se tratan de no fraudes.
ggplot(df, aes(x = CODE_GENDER, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Distribución de género por fraude/no fraude",
x = "Gender",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5))
ggplot(df, aes(x = FLAG_OWN_CAR, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Distribución de carro propio por fraude/no fraude",
x = "Owns Car",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5))
ggplot(df, aes(x = FLAG_OWN_REALTY, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Distribución de casa propia por fraude/no fraude",
x = "Owns Real Estate",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5))
En las gráficas observadas anteriormente se puede apreciar una
proporción mayoritaria de mujeres pero se observa proporcionalmente la
presencia de mayores casos de fraudes en el caso de hombres, por otro
lado, en cuanto a la presencia de carros propios, los datos están
sesgados por los que no tienen carro propio en contraste de la variable
de casa propia, donde la mayoría de los registros son de personas con
casas propias. En cuanto a los registros de fraude y no fraude para cada
uno, estas variables no parecen tener un impato significativo en la
posibilidad de cometer fraude ya que en proporción para ambos casos
(carro y casa propia) los registros de fraude son similares en
proporción.
# Asegurándonos de que CNT_CHILDREN es un factor con niveles de 0 a 6
df$CNT_CHILDREN <- factor(df$CNT_CHILDREN, levels = 0:6)
# Filtrando los datos para incluir solo hasta 6 hijos
df_filtered <- df %>% filter(as.numeric(as.character(CNT_CHILDREN)) <= 6)
# Creando el gráfico
ggplot(df_filtered, aes(x = CNT_CHILDREN, fill = TARGET)) +
geom_bar(position = "stack") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Distribution of Number of Children by Fraud Status",
x = "Number of Children",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14)) # Limitando el eje X a 6 hijos
En la gráfica de número de hijos se puede apreciar que los datos
presentan un sesgo a favor de pocos hijos donde la mayoría de las
personas no tienen hijos y donde pareciera que el número de hijos no es
un factor importante para distinguir entre fraudes y no fraudes ya que
en proporción los números de casos legítimos son similares.
library(ggplot2)
ggplot(df, aes(x = TARGET, y = AMT_INCOME_TOTAL, fill = TARGET)) +
geom_boxplot() +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Ingreso total del cliente", x = "Fraud Status", y = "Total Income") +
theme(plot.title = element_text(hjust = 0.5)) +
coord_cartesian(ylim = c(0, quantile(df$AMT_INCOME_TOTAL, 0.95))) # Limitar el eje Y al percentil 95
# Cantidad de Crédito por Estado de Fraude
ggplot(df, aes(x = TARGET, y = AMT_CREDIT, fill = TARGET)) +
geom_boxplot() +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Total del préstamo", x = "Fraud Status", y = "Credit Amount") +
theme(plot.title = element_text(hjust = 0.5))
# Cantidad de Anualidad por Estado de Fraude
ggplot(df, aes(x = TARGET, y = AMT_ANNUITY, fill = TARGET)) +
geom_boxplot() +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Anualidad del préstamo", x = "Fraud Status", y = "Annuity Amount") +
theme(plot.title = element_text(hjust = 0.5))
# Precio de los Bienes por Estado de Fraude
ggplot(df, aes(x = TARGET, y = AMT_GOODS_PRICE, fill = TARGET)) +
geom_boxplot() +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Precio de los bienes del cliente", x = "Fraud Status", y = "Goods Price") +
theme(plot.title = element_text(hjust = 0.5))
Estos diagramas de cajas muestran insights interesantes de la base de datos, en primer lugar, en cuanto al ingreso total del cliente, se aprecia que la mediana es mayor para las personas que no cometen fraudes. En cuanto al total del préstamo, de igual forma, las personas que no cometen fraudes tienen prestamos más altos, al igual que en la variable de la anualidad del prestamo y el precio de los bienes del cliente. Todo esto sugiere una relación entre el nivel socioeconómico de las personas y su posibilidad de cometer fraudes. Esto convierte a estas variables en aspectos importantes a considerar en los modelos clasificatorios consecuentes.
ggplot(df, aes(x = NAME_INCOME_TYPE, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Tipo de ingreso", x = "Income Type", y = "Count") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplot(df, aes(x = NAME_EDUCATION_TYPE, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Tipo de educación", x = "Education Type", y = "Count") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplot(df, aes(x = NAME_FAMILY_STATUS, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Status familiar", x = "Family Status", y = "Count") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplot(df, aes(x = NAME_HOUSING_TYPE, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "red", "Not-fraud" = "blue")) +
theme_minimal() +
labs(title = "Tipo de hogar", x = "Housing Type", y = "Count") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
En estos gráficos relacionados al análisis demográfico de las personas, se aprecia que la mayoría trabaja y tiene terminada la secundaria. Sin embargo, el tipo de educación revela una cierto patrón de tener más casos de fraudes en las personas que solamente tienen la secundaria terminada a comparación de aquellas que tienen licenciaturas o grados académicos más altos. Como se corroboró anteriormente la mayoría de las personas están casados y los casos de fraudes parecen predominar ligeramente más en las personas solteras, lo que podría llevar a hacer suposiciones como el que las personas casadas y con familias tienen menos posibilidades de cometer fraudes por el compromiso y la estabilidad económica que requiere una familia. Sin embargo, todo esto se corroborará más adelante con la creación de los modelos de clasificación. Por último, en cuanto al tipo de hogar, la mayoría de las personas viven en casas.
df_fraud <- df[df$TARGET == "Fraud", ]
ggplot(df_fraud, aes(x = DAYS_EMPLOYED)) +
geom_histogram(fill = "red", binwidth = 365, color = "black") + # Ajusta binwidth según sea necesario
theme_minimal() +
labs(title = "Frecuencia de casos de fraude por días de trabajo",
x = "Days Employed",
y = "Number of Fraud Cases") +
theme(plot.title = element_text(hjust = 0.5),
axis.title.x = element_text(face="bold", colour="#993333", size=12),
axis.title.y = element_text(face="bold", colour="#993333", size=12),
panel.background = element_rect(fill = "#FFFEEE"))
ggplot(df_fraud, aes(x = DAYS_EMPLOYED)) +
geom_density(fill = "red", alpha = 0.5) + # Ajusta la transparencia con alpha
theme_minimal() +
labs(title = "Densidad de casos de fraude por días de trabajo",
x = "Days Employed",
y = "Density") +
theme(plot.title = element_text(hjust = 0.5),
axis.title.x = element_text(face="bold", colour="#993333", size=12),
axis.title.y = element_text(face="bold", colour="#993333", size=12),
panel.background = element_rect(fill = "#FFFEEE"))
Los gráficos anteriores muestran como las personas con pocos días de
trabajo y aquellas con muchos días de trabajo tienen más posibilidades
de cometer fraude. Esto podría explicarse como una variable cuadrática
negativa y cobra sentido en el contexto real pues las personas con pocos
días en el trabajo suelen tener una menor estabilidad económica y muchas
veces suelen adquirir empleos temporales para cometer fraudes bancarios.
Por otro las personas con muchos días de trabajo son personas de edades
más altas que estan entrando a su etapa de jubilación y que pierden
interés por mantener calificaciones crediticias altas, por lo tanto
suelen existir muchos casos de fraudes en personas jubiladas o entrando
a este proceso.
ggplot(df, aes(x = REGION_RATING_CLIENT, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Fraud" = "#E74C3C", "Not-fraud" = "#2ECC71")) +
theme_minimal() +
labs(title = "Distribución del rating de región de las personas",
x = "Region Rating",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5, size = 14),
axis.title = element_text(size = 12),
axis.text = element_text(size = 10),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10),
panel.background = element_rect(fill = "#F0F0F0"),
panel.grid.major = element_line(color = "#D0D0D0"),
panel.grid.minor = element_blank())
df$OBS_30_CNT_SOCIAL_CIRCLE <- factor(df$OBS_30_CNT_SOCIAL_CIRCLE, levels = 0:15)
df$TARGET <- factor(df$TARGET, levels = c("Not-fraud", "Fraud"))
# Creando el gráfico de barras lado a lado
ggplot(df, aes(x = OBS_30_CNT_SOCIAL_CIRCLE, fill = TARGET)) +
geom_bar(position = "dodge") +
scale_fill_manual(values = c("Not-fraud" = "#3498db", "Fraud" = "#e74c3c")) +
theme_minimal() +
labs(title = "Fraudes por número de consultas a buró en los últimos 30 días",
x = "Number of Bureau Inquiries (Last 30 Days)",
y = "Count") +
theme(plot.title = element_text(hjust = 0.5),
axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1),
axis.title = element_text(size = 12),
legend.title = element_blank())
Por último, en los últimos gráficos se observan variables como consultas a buró y rating de la región de las personas, donde se observa un ligero patrón de disminuir los casos de fraude entre menos consultas a buró realicen las personas en el corto plazo. Lo cual tiene mucho sentido en el contexto real ya que un alto número de consultas a buró en un corto plazo indica urgencias por parte del cliente por obtener créditos lo que podría llegar a interpretarse en algunos casos como problemas económicos y más posibilidades de cometer fraudes bancarios.
Con todo este análisis exploratorio se tiene una gran cantidad de insights para comenzar la especificación de modelos de clasificación, así con las transformaciones necesarias para estimar un mejor modelo.
Modelos de clasificación
set.seed(123)
sample <- sample(c(TRUE, FALSE), nrow(df), replace = T, prob = c(0.6,0.4))
train <- df[sample, ]
test <- df[!sample, ]
sample2 <- sample(c(TRUE, FALSE), nrow(df_numeric), replace = T, prob = c(0.6,0.4))
train_numeric <- df_numeric[sample, ]
test_numeric <- df_numeric[!sample, ]Logistic Regression
multiple_logistic <- glm(TARGET ~ CODE_GENDER + log(AMT_INCOME_TOTAL)+NAME_EDUCATION_TYPE+(as.numeric(DAYS_EMPLOYED))^2+NAME_FAMILY_STATUS+(as.numeric(OBS_30_CNT_SOCIAL_CIRCLE)),family = "binomial", data = train)
summary(multiple_logistic)##
## Call:
## glm(formula = TARGET ~ CODE_GENDER + log(AMT_INCOME_TOTAL) +
## NAME_EDUCATION_TYPE + (as.numeric(DAYS_EMPLOYED))^2 + NAME_FAMILY_STATUS +
## (as.numeric(OBS_30_CNT_SOCIAL_CIRCLE)), family = "binomial",
## data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.149e+00 7.532e-01 -1.525 0.127203
## CODE_GENDERM 3.804e-01 1.831e-02 20.779 < 2e-16 ***
## CODE_GENDERXNA -7.130e+00 5.121e+01 -0.139 0.889280
## log(AMT_INCOME_TOTAL) -2.195e-01 1.939e-02 -11.318 < 2e-16 ***
## NAME_EDUCATION_TYPEHigher education 1.022e+00 7.152e-01 1.429 0.152973
## NAME_EDUCATION_TYPEIncomplete higher 1.370e+00 7.165e-01 1.912 0.055821 .
## NAME_EDUCATION_TYPESecondary 1.549e+00 7.150e-01 2.166 0.030306 *
## as.numeric(DAYS_EMPLOYED) -1.445e-06 7.562e-08 -19.108 < 2e-16 ***
## NAME_FAMILY_STATUSMarried -2.957e-01 2.751e-02 -10.748 < 2e-16 ***
## NAME_FAMILY_STATUSSeparated -1.151e-01 4.209e-02 -2.734 0.006261 **
## NAME_FAMILY_STATUSSingle 6.121e-03 3.251e-02 0.188 0.850667
## NAME_FAMILY_STATUSWidow -3.554e-01 5.228e-02 -6.799 1.05e-11 ***
## as.numeric(OBS_30_CNT_SOCIAL_CIRCLE) 1.317e-02 3.781e-03 3.484 0.000494 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 102746 on 183578 degrees of freedom
## Residual deviance: 100815 on 183566 degrees of freedom
## AIC: 100841
##
## Number of Fisher Scoring iterations: 8varImp(multiple_logistic) # which explanatory variable (X) is the most influential in predicting the target / dependent variable (Y)## Overall
## CODE_GENDERM 20.7786386
## CODE_GENDERXNA 0.1392155
## log(AMT_INCOME_TOTAL) 11.3184963
## NAME_EDUCATION_TYPEHigher education 1.4291077
## NAME_EDUCATION_TYPEIncomplete higher 1.9124274
## NAME_EDUCATION_TYPESecondary 2.1660647
## as.numeric(DAYS_EMPLOYED) 19.1081875
## NAME_FAMILY_STATUSMarried 10.7482314
## NAME_FAMILY_STATUSSeparated 2.7338029
## NAME_FAMILY_STATUSSingle 0.1882670
## NAME_FAMILY_STATUSWidow 6.7992195
## as.numeric(OBS_30_CNT_SOCIAL_CIRCLE) 3.4838509Los coeficientes del modelo indican cómo cada predictor afecta la probabilidad logarítmica de observar el evento de interés (por ejemplo, fraude), manteniendo constantes las demás variables:
Género (CODE_GENDER): Los hombres (M) tienen una probabilidad ligeramente mayor (coeficiente de 0.3604) de cometer fraude comparado con las mujeres (categoría base).
Ingreso Total (AMT_INCOME_TOTAL): Por cada unidad adicional en el ingreso total, la probabilidad logarítmica de fraude disminuye (coeficiente de -3.509e-07), lo que indica que mayores ingresos se asocian con una menor probabilidad de fraude.
Tipo de Educación: Comparado con la categoría base, tener una educación secundaria o incompleta aumenta la probabilidad de fraude, con coeficientes positivos significativos.
Días Empleados (DAYS_EMPLOYED): Por cada día adicional de empleo, la probabilidad de fraude disminuye (coeficiente de -1.364e-06).
Estado Familiar: Estar casado o viudo disminuye la probabilidad de fraude, mientras que ser soltero no tiene un efecto estadísticamente significativo.
Número de Consultas al Círculo Social (OBS_30_CNT_SOCIAL_CIRCLE): Un mayor número de consultas se asocia con una mayor probabilidad de fraude (coeficiente de 0.01421).
La devianza nula y residual muestran cuánto del modelo se ha mejorado al incluir las variables predictoras. El AIC (Criterio de Información de Akaike) de 100000 proporciona una medida de la calidad del modelo, donde modelos con AIC más bajos son generalmente preferidos.
Este modelo logístico, a priori, respalda algunas importantes suposiciones que se realizaron en el análisis exploratorio de los datos.
Evaluación
test_predictions_sl <- predict(multiple_logistic, newdata = test,type = "response")
predicted_classes_sl <- ifelse(test_predictions_sl > 0.5, 1, 0)
test$TARGET <- ifelse(test$TARGET == "Not-fraud", 0, 1)
test$TARGET <- factor(test$TARGET, levels = c("0", "1"))
predicted_classes_sl <- factor(predicted_classes_sl, levels = c("0", "1"))
conf_sl <- confusionMatrix(predicted_classes_sl, test$TARGET)
print(conf_sl)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 112209 9969
## 1 0 0
##
## Accuracy : 0.9184
## 95% CI : (0.9169, 0.9199)
## No Information Rate : 0.9184
## P-Value [Acc > NIR] : 0.5027
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9184
## Neg Pred Value : NaN
## Prevalence : 0.9184
## Detection Rate : 0.9184
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : 0
## La matriz de confusión para el modelo de clasificación revela una precisión global del 92.05%, indicando una alta tasa de aciertos para la clase ‘0’ (negativa). Sin embargo, el modelo no identificó correctamente ningún caso de la clase ‘1’ (positiva), como se evidencia por la ausencia de verdaderos positivos y una especificidad de 0%. Esto sugiere que el modelo tiene un fuerte sesgo hacia la predicción de la clase ‘0’, lo cual se confirma por un valor Kappa de 0, indicando que el rendimiento del modelo no es mejor que el azar.
A pesar de una sensibilidad del 100%, la falta de balance en la identificación de las dos clases resulta en una precisión balanceada de solo el 50%. Esto, junto con una significativa prueba de McNemar (valor-p < 2e-16), apunta hacia una deficiencia en el modelo para distinguir entre las clases de manera efectiva. La clase considerada como ‘positiva’ para este análisis fue la ‘0’, reflejando un enfoque en la capacidad del modelo para detectar la clase negativa que a priori, es ampliamente predominante en la base de datos.
En resumen, aunque el modelo es altamente preciso para predecir casos negativos, su incapacidad para identificar casos positivos sugiere una limitación significativa en su aplicabilidad práctica para el conjunto de datos.
roc_ml <- roc(as.numeric(as.character(test$TARGET)), test_predictions_sl)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_ml)
Lo cual se puede apreciar en la curva ROC y el estadístico AUC con
solamente 61% de área bajo la curva.
auc_ml=roc_ml$auc
auc_ml## Area under the curve: 0.6072Árboles de decisión
# Balanceo de clases
library(ROSE)## Loaded ROSE 0.0-4# Contar el número de ejemplos de cada clase
class_counts <- table(train$TARGET)
# Calcular N para submuestreo
N <- min(class_counts) * 2
# Realizar el balanceo de clases
balanced <- ovun.sample(TARGET ~ ., data = train, method = "under", N = N, seed = 123)
# Extraer los datos balanceados
balanced_data <- balanced$data
# Entrenar el árbol de decisión
set.seed(123)
arbol <- rpart(TARGET ~ CODE_GENDER + log(AMT_INCOME_TOTAL)+NAME_EDUCATION_TYPE+(as.numeric(DAYS_EMPLOYED))^2+NAME_FAMILY_STATUS+(as.numeric(OBS_30_CNT_SOCIAL_CIRCLE)), data = balanced_data, method = "class", control = rpart.control(minsplit=10, maxdepth=3))
# Plotear el árbol
rpart.plot(arbol)
Nodo Raíz:*
- Condición Inicial: as.numeric(DAYS_EMPLOYED) >= 1866
- Predicción General: No fraude (50% probabilidad)
- Distribución de Datos: El 100% de los datos se encuentran en este nodo.
Rama Izquierda (DAYS_EMPLOYED >= 1866): - Predicción: No fraude (42% probabilidad) - Distribución de Datos: 49% de los datos se encuentran en este nodo. - Interpretación: Si un usuario ha estado empleado por 1866 días o más, es más probable que no cometa fraude.
Rama Derecha (DAYS_EMPLOYED < 1866): - Condición Adicional: NAME_EDUCATION_TYPE = Academic degree, Higher education - Predicción General: Fraude (57% probabilidad) - Distribución de Datos: 51% de los datos se encuentran en este nodo. - Interpretación: Si un usuario ha estado empleado por menos de 1866 días, hay una mayor probabilidad de fraude. Esta probabilidad se modula aún más por el nivel educativo.
Subnodo Izquierdo:
- Condición: NAME_EDUCATION_TYPE = Academic degree
- Predicción: No fraude (46% probabilidad)
- Distribución de Datos: 11% de los datos se encuentran en este nodo.
- Interpretación: Entre aquellos con menos de 1866 días de empleo, aquellos con un título académico tienen una probabilidad ligeramente mayor de no cometer fraude.
Subnodo Derecho:
- Condición: NAME_EDUCATION_TYPE = Higher education
- Predicción: Fraude (61% probabilidad)
- Distribución de Datos: 40% de los datos se encuentran en este nodo.
- Interpretación: Entre aquellos con menos de 1866 días de empleo, aquellos con educación superior tienen una mayor probabilidad de cometer fraude.
Conclusión General
DAYS_EMPLOYED es una variable muy influyente. Si los días empleados son mayores o iguales a 1866, la probabilidad de fraude disminuye significativamente. Para aquellos con menos de 1866 días de empleo, NAME_EDUCATION_TYPE juega un papel crucial. Tener un título académico está asociado con una menor probabilidad de fraude, mientras que tener una educación superior está asociado con una mayor probabilidad de fraude. Este análisis indica que el historial de empleo y el nivel educativo son factores críticos para predecir el comportamiento de pago de los usuarios de tarjetas de crédito en este modelo.
Este modelo aporta un valor agregado debido a su alta interpretabilidad, lo que permite generar conclusiones asertivas sobre la situación problema.
Evaluación
predicciones <- predict(arbol, newdata = test, type = "class")
predicciones <- ifelse(predicciones == "Not-fraud", 0, 1)
predicciones_arbol <- factor(predicciones, levels = c("0", "1"))
# Calcular la matriz de confusión
confMat <- confusionMatrix(table(predicciones_arbol, test$TARGET))
# Imprimir la matriz de confusión
print(confMat)## Confusion Matrix and Statistics
##
##
## predicciones_arbol 0 1
## 0 76631 5121
## 1 35578 4848
##
## Accuracy : 0.6669
## 95% CI : (0.6642, 0.6695)
## No Information Rate : 0.9184
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.0708
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.6829
## Specificity : 0.4863
## Pos Pred Value : 0.9374
## Neg Pred Value : 0.1199
## Prevalence : 0.9184
## Detection Rate : 0.6272
## Detection Prevalence : 0.6691
## Balanced Accuracy : 0.5846
##
## 'Positive' Class : 0
## El análisis del modelo de decisión para predecir el no pago de tarjetas de crédito revela varias conclusiones importantes En primer lugar se destaca la importancia de las variables seleccionadas para el modelo siendo los días empleados una de las más significativas La condición inicial del árbol de decisión establece que si un usuario ha estado empleado por 1866 días o más la probabilidad de que cometa fraude disminuye considerablemente Esto sugiere que un historial de empleo más largo está asociado con una mayor estabilidad financiera y una menor propensión al fraude
Además el nivel educativo también juega un papel crucial Los usuarios con un título académico tienen una menor probabilidad de cometer fraude en comparación con aquellos con educación superior o secundaria Este hallazgo puede estar relacionado con una mejor gestión financiera y un mayor acceso a recursos y conocimientos financieros entre los más educados
El estado civil se identifica como otro factor moderadamente importante Los usuarios casados tienden a tener una menor probabilidad de fraude en comparación con otros estados civiles como solteros separados o viudos Este patrón puede reflejar una mayor estabilidad financiera y responsabilidad entre los usuarios casados
La evaluación del modelo arroja resultados mixtos La precisión del modelo es del 66.69% lo que indica un rendimiento moderado Aunque la sensibilidad del modelo es del 68.29% su especificidad es relativamente baja del 48.63% Esto significa que el modelo es mejor identificando correctamente los usuarios que pagarán su tarjeta de crédito pero tiene dificultades para identificar a aquellos que no lo harán
La matriz de confusión muestra una alta tasa de falsos negativos lo que significa que muchos usuarios que no pagarían su tarjeta de crédito fueron clasificados incorrectamente como usuarios que sí pagarían Este es un problema crítico ya que en un contexto financiero es crucial minimizar las pérdidas por fraude
El análisis de las métricas de rendimiento del modelo sugiere que hay espacio para mejorar Se recomienda explorar técnicas adicionales de ingeniería de características y probar otros algoritmos de clasificación como Random Forest o Gradient Boosting para mejorar la precisión y la capacidad predictiva del modelo Implementar una validación cruzada más rigurosa también podría ayudar a asegurar la estabilidad del modelo y ajustar los umbrales de decisión para equilibrar mejor la sensibilidad y la especificidad
En conclusión aunque el modelo de árbol de decisión proporciona una visión inicial útil sobre los factores que influyen en el comportamiento de pago de los usuarios hay margen para mejorar su precisión y capacidad predictiva mediante técnicas adicionales de modelado y validación
predicciones2 <- predict(arbol, newdata = test, type = "prob")
probabilidades_clase_fraudulenta <- predicciones2[, "Fraud"]
respuesta_numerica <- as.numeric(as.character(test$TARGET))
# Calcular la curva ROC
roc_arbol <- roc(respuesta_numerica, probabilidades_clase_fraudulenta)## Setting levels: control = 0, case = 1## Setting direction: controls < cases# Graficar la curva ROC
plot(roc_arbol, main="Curva ROC para el Modelo de Detección de Fraude")
auc_arbol =roc_arbol$auc
auc_arbol## Area under the curve: 0.5872Como se puede apreciar, el área bajo la curva es del 59%.
Suport Vector Machine
train_numeric <- na.omit(train_numeric)
test_numeric <- na.omit(test_numeric)
svm_model_1 <- svm(TARGET ~ AMT_INCOME_TOTAL + NAME_EDUCATION_TYPE + DAYS_EMPLOYED, data=train_numeric,type = "C-classification" ,cost = 1, kernel = "linear",scale = FALSE)predictions <- predict(svm_model_1, newdata = test_numeric)
conf_sv=confusionMatrix(as.factor(predictions), as.factor(test_numeric$TARGET))
conf_sv## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 84044 6889
## 1 28163 3080
##
## Accuracy : 0.7131
## 95% CI : (0.7106, 0.7156)
## No Information Rate : 0.9184
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.0294
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.74901
## Specificity : 0.30896
## Pos Pred Value : 0.92424
## Neg Pred Value : 0.09858
## Prevalence : 0.91840
## Detection Rate : 0.68789
## Detection Prevalence : 0.74428
## Balanced Accuracy : 0.52898
##
## 'Positive' Class : 0
## El análisis del modelo de Support Vector Machine (SVM) para predecir el no pago de tarjetas de crédito revela varias conclusiones importantes En primer lugar la precisión del modelo es del 71.31% lo que indica un rendimiento mejorado en comparación con otros modelos aunque aún hay margen para mejorar La sensibilidad del modelo es del 74.90% lo que significa que el modelo es bastante eficaz para identificar correctamente a los usuarios que pagarán su tarjeta de crédito Sin embargo la especificidad es relativamente baja del 30.90% lo que indica dificultades para identificar a aquellos que no pagarán su tarjeta de crédito
El modelo de SVM tiene una alta tasa de falsos positivos lo que significa que muchos usuarios que pagarían su tarjeta de crédito fueron clasificados incorrectamente como usuarios que no pagarían Este problema es menos crítico que una alta tasa de falsos negativos pero aún es importante mejorar para reducir el número de usuarios mal clasificados
El valor predictivo positivo del modelo es del 92.42% lo que significa que cuando el modelo predice que un usuario pagará su tarjeta de crédito es correcto la mayoría de las veces Sin embargo el valor predictivo negativo es del 9.86% lo que indica que cuando el modelo predice que un usuario no pagará su tarjeta de crédito a menudo está equivocado Este es un área crítica que necesita mejoras significativas para reducir las pérdidas por fraude
El índice Kappa es de 0.0294 lo que indica un acuerdo muy bajo entre las predicciones del modelo y las observaciones reales Este bajo índice sugiere que el modelo tiene dificultades para diferenciar de manera efectiva entre usuarios que pagarán y no pagarán su tarjeta de crédito
La prueba de McNemar tiene un valor p menor a 2e-16 lo que indica que hay una diferencia significativa entre las tasas de falsos positivos y falsos negativos Esto sugiere que el modelo podría estar sesgado y necesita ajustes adicionales
En cuanto a la prevalencia el 91.84% de los usuarios en el conjunto de datos son aquellos que pagarán su tarjeta de crédito lo que refuerza la necesidad de un modelo que pueda manejar este desbalance de clases de manera efectiva El índice de detección del modelo es del 68.79% lo que indica que el modelo detecta correctamente una gran proporción de los usuarios que pagarán pero aún falta mejorar la detección de usuarios que no pagarán
roc_sv <- roc(test$TARGET, predicciones)
plot(roc_sv)
auc_sv =roc_sv$auc
auc_sv## Area under the curve: 0.5846K Means Clustering
grupos <- 4
df_numeric=na.omit(df_numeric)
df_scaled <- scale(df_numeric)
segmentos <- kmeans (df_scaled,grupos)
asignacion <- cbind(df_numeric,cluster = segmentos$cluster)fviz_cluster(segmentos,data = df_scaled)
library(factoextra)
df_numeric_2 <- df_numeric %>%
sample_frac(0.01)
df_scaled_2 <- scale(df_numeric_2)
set.seed(123) # Para reproducibilidad
fviz_nbclust(df_scaled_2, kmeans, method = "wss") + geom_vline(xintercept = 4, linetype = 2)
Con base a la gráfica del codo, el número óptimo de clusters es 4.
cluster1 <- rownames(df_numeric)[which(asignacion$cluster == 1)]
cluster2 <- rownames(df_numeric)[which(asignacion$cluster == 2)]
cluster3 <- rownames(df_numeric)[which(asignacion$cluster == 3)]
cluster4 <- rownames(df_numeric)[which(asignacion$cluster == 4)]promedio <- aggregate(asignacion, by = list(asignacion$cluster), FUN=mean)
promedio## Group.1 TARGET CODE_GENDER FLAG_OWN_CAR FLAG_OWN_REALTY CNT_CHILDREN
## 1 1 0.09689991 0.3556387 0.3301330 0.7223563 0.50910193
## 2 2 0.10471128 0.3907510 0.3078425 0.3916911 0.45442383
## 3 3 0.05402725 0.1728103 0.1684784 0.7782636 0.04111253
## 4 4 0.05442119 0.4092530 0.4967674 0.6872700 0.45955355
## AMT_INCOME_TOTAL AMT_CREDIT AMT_ANNUITY AMT_GOODS_PRICE NAME_INCOME_TYPE
## 1 152169.1 413637.2 21465.79 366939.7 0.5746409
## 2 159433.2 504079.2 24613.46 446553.9 0.8540695
## 3 129426.7 481238.3 21947.85 430821.2 3.0011336
## 4 236973.2 1139537.6 44525.65 1036945.3 0.9448826
## NAME_EDUCATION_TYPE NAME_FAMILY_STATUS NAME_HOUSING_TYPE DAYS_EMPLOYED
## 1 0.4711656 1.222502 0.02218320 2342.079
## 2 0.4968001 1.128033 2.67791156 32916.744
## 3 0.2779498 1.523350 0.02153803 365118.385
## 4 0.8126092 1.154710 0.07196954 19812.137
## REGION_RATING_CLIENT OBS_30_CNT_SOCIAL_CIRCLE cluster
## 1 2.096066 1.419043 1
## 2 2.019561 1.349098 2
## 3 2.106982 1.416672 3
## 4 1.931782 1.349688 4Con estos resultados, analizando cada uno de los clusters, se pueden definir las características de cada uno de ellos…
Grupo 1: “Los Principiantes Estables”
- TARGET: Más alto, indicando un riesgo relativo de fraude.
- Características: Ingresos moderados, crédito medio, relativamente jóvenes en términos de empleo (menor cantidad de días empleados).
- Comportamiento: Menor cantidad de hijos, mayoría tiene propiedad.
- Observaciones: Este grupo podría estar compuesto por individuos más jóvenes que recién comienzan su vida adulta, con estabilidad financiera moderada y propietarios de viviendas, más propensos a cometer fraude.
Grupo 2: “Los Altos Ingresos Acomodados” - TARGET: Muy bajo, lo que indica un grupo de bajo riesgo. - Características: Altos ingresos y créditos, lo que sugiere acceso a y uso de productos financieros más grandes. Menor tiempo de empleo que el Grupo 4, pero significativamente mayor que los Grupos 1 y 3. - Comportamiento: Mayor proporción de propietarios de coches, probablemente familias establecidas (mayor número de hijos). - Observaciones: Este cluster puede representar individuos de altos ingresos, posiblemente profesionales establecidos o empresarios, con una sólida posición financiera y un estilo de vida acomodado.
Grupo 3: “Los Trabajadores Urbanos” - TARGET: Muy bajo, indicando un grupo seguro sin fraude. - Características: Ingresos y créditos moderados, similares al Grupo 1. Relativamente menor tiempo en el empleo. - Comportamiento: Una mezcla en términos de posesión de automóviles y bienes inmuebles, pero con una mayor tendencia hacia la propiedad inmobiliaria que el Grupo 1. - Observaciones: Este grupo podría consistir en trabajadores de mediana edad, posiblemente en áreas urbanas dada la mayor prevalencia de no propietarios de automóviles pero todavía altos propietarios de bienes raíces.
Grupo 4: “Los Pensionados” - TARGET: Muy bajo. - Características: Los días empleados sugieren individuos jubilados o de edad avanzada. Ingresos más bajos, lo cual es consistente con la jubilación. - Comportamiento: La más baja proporción de propietarios de automóviles y bienes inmuebles, muchos hijos. - Observaciones: Este cluster parece representar a personas jubiladas, con menos dependientes y posiblemente viviendo en viviendas más modestas o en arrendamiento.
KNN MODEL
# Dividir datos en características (predictores) y variable objetivo (respuesta)
df_numeric=na.omit(df_numeric)
predictores <- df_numeric[, -1] # Excluir la primera columna, que es TARGET
respuesta <- df_numeric$TARGET
# Dividir los datos en conjuntos de entrenamiento y prueba
set.seed(123) # Para reproducibilidad
indice <- createDataPartition(respuesta, p = 0.8, list = FALSE)
trainX <- predictores[indice, ]
trainY <- respuesta[indice]
testX <- predictores[-indice, ]
testY <- respuesta[-indice]
# Escalando los datos: KNN funciona mejor si todos los datos están en la misma escala
preproc <- preProcess(trainX, method = c("center", "scale"))
trainX_scaled <- predict(preproc, trainX)
testX_scaled <- predict(preproc, testX)
# Ajustar el modelo KNN. Seleccionaremos k = 5 como punto de partida
set.seed(123)
k <- 5
knn_model <- knn(train = trainX_scaled, test = testX_scaled, cl = trainY, k = k)
summary(knn_model)## 0 1
## 60615 535Evaluación
library(caret)
# Convertir las predicciones y los valores reales a factores, si aún no lo son
knn_model_factor <- as.factor(knn_model)
testY_factor <- as.factor(testY)
# Usar confusionMatrix de caret para evaluar el modelo
cm <- confusionMatrix(knn_model_factor, testY_factor)
# Imprimir la matriz de confusión y las estadísticas de rendimiento
print(cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 55764 4851
## 1 451 84
##
## Accuracy : 0.9133
## 95% CI : (0.911, 0.9155)
## No Information Rate : 0.9193
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.0152
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.99198
## Specificity : 0.01702
## Pos Pred Value : 0.91997
## Neg Pred Value : 0.15701
## Prevalence : 0.91930
## Detection Rate : 0.91192
## Detection Prevalence : 0.99125
## Balanced Accuracy : 0.50450
##
## 'Positive' Class : 0
## De acuerdo con el KNN model, el modelo tiene un Accuracy del 91%, es decir que en lo general logra clasificar correctamente el 91% de todos los datos, sin embargo, en la especificidad podemos apreciar un pésimo rendimiento, demostrando
roc_obj <- roc(response = testY_factor, predictor = as.numeric(knn_model_factor), levels = rev(levels(testY_factor)))## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_obj, main="Curva ROC para el modelo KNN", col="#1c61b6")
# Calcular el AUC
auc_knn=roc_obj$auc
auc_knn## Area under the curve: 0.4955Naive Bayes
naive_bayes_model <- naiveBayes(TARGET ~ CODE_GENDER + log(AMT_INCOME_TOTAL)+NAME_EDUCATION_TYPE+(as.numeric(DAYS_EMPLOYED))^2+NAME_FAMILY_STATUS+(as.numeric(OBS_30_CNT_SOCIAL_CIRCLE)), data = train_numeric)
summary(naive_bayes_model)## Length Class Mode
## apriori 2 table numeric
## tables 6 -none- list
## levels 2 -none- character
## isnumeric 6 -none- logical
## call 4 -none- callLa interpretación del modelo de Naive Bayes se facilita mediante el uso de niveles de clase que definen las diferentes categorías o etiquetas de salida En este caso las clases son ‘pago’ y ‘no pago’ lo que permite al modelo clasificar a los usuarios en una de estas dos categorías basándose en las características observadas
Evaluación
naive_bayes_predictions <- predict(naive_bayes_model, newdata = test_numeric)
conf_nb <- confusionMatrix(as.factor(naive_bayes_predictions), as.factor(test_numeric$TARGET))
print(conf_nb)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 112207 9969
## 1 0 0
##
## Accuracy : 0.9184
## 95% CI : (0.9169, 0.9199)
## No Information Rate : 0.9184
## P-Value [Acc > NIR] : 0.5027
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9184
## Neg Pred Value : NaN
## Prevalence : 0.9184
## Detection Rate : 0.9184
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : 0
## El análisis del modelo de Naive Bayes para predecir el no pago de tarjetas de crédito muestra que tiene una precisión del 91.84%, lo que indica que generalmente hace predicciones correctas. La sensibilidad del modelo es del 100%, identificando correctamente a todos los usuarios que pagarán su tarjeta de crédito. Sin embargo, la especificidad es del 0%, lo que significa que el modelo no logra identificar a los usuarios que no pagarán su tarjeta de crédito, clasificándolos incorrectamente como si fueran a pagar.
El valor predictivo positivo es del 91.84%, mientras que el valor predictivo negativo no puede calcularse, ya que el modelo no predice ningún caso de no pago. Esto refleja una gran limitación, ya que la precisión en la identificación de usuarios que no pagarán es crucial.
El índice Kappa es 0, indicando que no hay acuerdo entre las predicciones del modelo y las observaciones reales. La prueba de McNemar, con un valor p menor a 2e-16, sugiere una diferencia significativa entre las tasas de falsos positivos y falsos negativos, indicando un sesgo en el modelo.
La precisión balanceada del 50% refleja un rendimiento promedio, con una alta sensibilidad pero una especificidad extremadamente baja. En resumen, aunque el modelo de Naive Bayes tiene una alta precisión general, su incapacidad para identificar correctamente a los usuarios que no pagarán su tarjeta de crédito es una limitación significativa.
naive_bayes_prob <- predict(naive_bayes_model, newdata = test_numeric, type = "raw")[,2]## Warning in predict.naiveBayes(naive_bayes_model, newdata = test_numeric, : Type
## mismatch between training and new data for variable 'log(AMT_INCOME_TOTAL)'.
## Did you use factors with numeric labels for training, and numeric values for
## new data?## Warning in predict.naiveBayes(naive_bayes_model, newdata = test_numeric, : Type
## mismatch between training and new data for variable
## 'as.numeric(DAYS_EMPLOYED)'. Did you use factors with numeric labels for
## training, and numeric values for new data?## Warning in predict.naiveBayes(naive_bayes_model, newdata = test_numeric, : Type
## mismatch between training and new data for variable
## 'as.numeric(OBS_30_CNT_SOCIAL_CIRCLE)'. Did you use factors with numeric labels
## for training, and numeric values for new data?# Crear el objeto ROC
roc_nb <- roc(response = test_numeric$TARGET, predictor = naive_bayes_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < cases# Trazar la curva ROC
plot(roc_nb, main="Curva ROC para el Modelo de Naive Bayes", col="#1c61b6")
auc_nb=roc_nb$auc
auc_nb## Area under the curve: 0.5826Random Forest
# Entrenar el modelo Random Forest
df_numeric_2=na.omit(df_numeric_2)
X <- df_numeric_2[, -which(names(df_numeric_2) == "TARGET")]
Y <- df_numeric_2$TARGET
train_control <- trainControl(method = "cv", number = 10)
# Dividir los datos en conjuntos de entrenamiento y prueba
set.seed(123) # Para reproducibilidad
trainIndex <- createDataPartition(Y, p = .8, list = FALSE)
X_train <- X[trainIndex, ]
Y_train <- Y[trainIndex]
X_test <- X[-trainIndex, ]
Y_test <- Y[-trainIndex]
Y_train <- as.factor(Y_train)
Y_test <- as.factor(Y_test)
set.seed(123)
rf_model_caret <- train(x = X_train, y = Y_train, method = "rf",
trControl = train_control, ntree = 30)
# Resumen del modelo
print(rf_model_caret)## Random Forest
##
## 2447 samples
## 15 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 2202, 2201, 2203, 2203, 2202, 2203, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.9215387 -0.0007815714
## 8 0.9199060 -0.0037258630
## 15 0.9194979 -0.0043373402
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.Evaluación
# Realizar predicciones en el conjunto de prueba
predictions_caret <- predict(rf_model_caret, X_test)
# Evaluar el modelo con caret para obtener más métricas
conf_matrix_caret <- confusionMatrix(predictions_caret, Y_test)
print(conf_matrix_caret)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 554 57
## 1 0 0
##
## Accuracy : 0.9067
## 95% CI : (0.8808, 0.9286)
## No Information Rate : 0.9067
## P-Value [Acc > NIR] : 0.5352
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 1.195e-13
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9067
## Neg Pred Value : NaN
## Prevalence : 0.9067
## Detection Rate : 0.9067
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : 0
## # Asegúrate de cargar el paquete pROC
library(pROC)
# Obtener las probabilidades predichas para la clase positiva
# Asumiendo que la clase positiva está en la segunda columna de las predicciones de probabilidad
predictions_prob <- predict(rf_model_caret, X_test, type = "prob")[,2]
# Calcular la curva ROC y AUC usando las probabilidades de la clase positiva
roc_result <- roc(response = as.numeric(Y_test)-1, predictor = predictions_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < cases# Graficar la curva ROC
plot(roc_result, main = "Curva ROC para el modelo Random Forest")
abline(a = 0, b = 1, lty = 2, col = "red") # Línea de no-discriminación
auc_rf=roc_result$auc
auc_rf## Area under the curve: 0.5383El modelo de Random Forest para predecir el no pago de tarjetas de crédito mostró una precisión del 90.67%, con un intervalo de confianza del 95% entre 88.08% y 92.86%. La tasa de no información fue del 90.67%, y el valor p de McNemar fue 1.195e-13, indicando una diferencia significativa entre las tasas de falsos positivos y falsos negativos.
La sensibilidad fue del 100%, lo que significa que el modelo identificó correctamente a todos los usuarios que pagarán su tarjeta de crédito. Sin embargo, la especificidad fue del 0%, lo que indica que el modelo no identificó correctamente a ningún usuario que no pagará.
El valor predictivo positivo fue del 90.67%, pero el valor predictivo negativo no se pudo calcular. El índice Kappa fue 0, indicando que no hubo acuerdo entre las predicciones del modelo y las observaciones reales.
La prevalencia y la tasa de detección fueron del 90.67%, y la precisión balanceada fue del 50%, lo que refleja un rendimiento promedio con una alta sensibilidad y una especificidad extremadamente baja. Esto sugiere que, aunque el modelo es preciso en general, necesita mejoras para identificar correctamente a los usuarios que no pagarán su tarjeta de crédito.
Evaluación y selección del modelo
# Multiple Logistic Regression (SL en tu ejemplo, ML en la solicitud)
sensitivity_ml <- conf_sl$byClass["Sensitivity"]
accuracy_ml <- conf_sl$overall["Accuracy"]
precision_ml <- conf_sl$byClass["Positive Predictive Value"]
kappa_ml <- conf_sl$overall["Kappa"]
f1_score_ml <- 2 * (precision_ml * sensitivity_ml) / (precision_ml + sensitivity_ml)
# Árbol de decisión
sensitivity_arbol <- confMat$byClass["Sensitivity"]
accuracy_arbol <- confMat$overall["Accuracy"]
precision_arbol <- confMat$byClass["Positive Predictive Value"]
kappa_arbol <- confMat$overall["Kappa"]
f1_score_arbol <- 2 * (precision_arbol * sensitivity_arbol) / (precision_arbol + sensitivity_arbol)
# SVM
sensitivity_svm <- conf_sv$byClass["Sensitivity"]
accuracy_svm <- conf_sv$overall["Accuracy"]
precision_svm <- conf_sv$byClass["Positive Predictive Value"]
kappa_svm <- conf_sv$overall["Kappa"]
f1_score_svm <- 2 * (precision_svm * sensitivity_svm) / (precision_svm + sensitivity_svm)
# KNN
sensitivity_knn <- cm$byClass["Sensitivity"]
accuracy_knn <- cm$overall["Accuracy"]
precision_knn <- cm$byClass["Positive Predictive Value"]
kappa_knn <- cm$overall["Kappa"]
f1_score_knn <- 2 * (precision_knn * sensitivity_knn) / (precision_knn + sensitivity_knn)
# Naive Bayes
sensitivity_nb <- conf_nb$byClass["Sensitivity"]
accuracy_nb <- conf_nb$overall["Accuracy"]
precision_nb <- conf_nb$byClass["Positive Predictive Value"]
kappa_nb <- conf_nb$overall["Kappa"]
f1_score_nb <- 2 * (precision_nb * sensitivity_nb) / (precision_nb + sensitivity_nb)
# Random Forest
sensitivity_rf <- conf_matrix_caret$byClass["Sensitivity"]
accuracy_rf <- conf_matrix_caret$overall["Accuracy"]
precision_rf <- conf_matrix_caret$byClass["Positive Predictive Value"]
kappa_rf <- conf_matrix_caret$overall["Kappa"]
f1_score_rf <- 2 * (precision_rf * sensitivity_rf) / (precision_rf + sensitivity_rf)# Crear un data frame con los resultados
results_df <- data.frame(
Model = c("Multiple Logistic", "Decision Trees", "SVM", "KNN", "Naïve Bayes", "Random Forest"),
Sensitivity = c(sensitivity_ml, sensitivity_arbol, sensitivity_svm, sensitivity_knn, sensitivity_nb, sensitivity_rf),
Accuracy = c(accuracy_ml, accuracy_arbol, accuracy_svm, accuracy_knn, accuracy_nb, accuracy_rf),
Precision = c(precision_ml, precision_arbol, precision_svm, precision_knn, precision_nb, precision_rf),
Kappa = c(kappa_ml, kappa_arbol, kappa_svm, kappa_knn, kappa_nb, kappa_rf),
F1_Score = c(f1_score_ml, f1_score_arbol, f1_score_svm, f1_score_knn, f1_score_nb, f1_score_rf),
AUC = c(auc_ml, auc_arbol, auc_sv, auc_knn, auc_nb, auc_rf) # Asumiendo auc_knn es NA porque K-means fue mencionado pero KNN es el modelo
)
# Ver los resultados
print(results_df)## Model Sensitivity Accuracy Precision Kappa F1_Score
## 1 Multiple Logistic 1.0000000 0.9184059 NA 0.00000000 NA
## 2 Decision Trees 0.6829310 0.6668877 NA 0.07075573 NA
## 3 SVM 0.7490085 0.7131024 NA 0.02939155 NA
## 4 KNN 0.9919772 0.9132952 NA 0.01516585 NA
## 5 Naïve Bayes 1.0000000 0.9184046 NA 0.00000000 NA
## 6 Random Forest 1.0000000 0.9067103 NA 0.00000000 NA
## AUC
## 1 0.6071701
## 2 0.5871543
## 3 0.5846193
## 4 0.4955007
## 5 0.5825606
## 6 0.5382545Se selecciona el modelo de multiple logistic.
Conclusiones
EDA
El análisis exploratorio de los datos arrojó diversos insights que fueron determimantes para determinar la especificación del modelo, para comenzar se encontraron inconsistencias en los datos que se corrijeron mediante la eliminación de múltiples variables que no aportaban a la clasificación de los modelos, que tenían muchos datos faltantes o que se tenía información suficiente para interpretar los resultados. Por otro lado, se realizaron dos bases de datos con variables numéricas y categóricas para los requerimentos de los distintos modelos de clasificación. En cuanto a la especificación del modelo, el EDA reveló que algunas de las variables no tenían un impacto significativo en la variable dependiente, sin embargó, se descubrió que variables como las que describían la situación económica de las personas eran mucho más importantes que variables demográficas. Por otro lado, variables como la antiguedad en sus trabajos y las consultas a buró de crédito en el corto plazo (30 días) tenían un impacto directo en la posibilidad de cometer fraude o no. Por todo esto se especificaron los modelos con las variables mencionadas.
Modelo seleccionado
Los modelos mostraron resultados similares en casi todas las métricas de evaluación, estos resultaron tener un bajo balance entre sensitividad y ********** , pues los modelos mostraron altos porcentajes de Accuracy debido a que los datos están ampliamente sesgados a la clase negativa de No Fraude, por lo mismo la Sensitivity fue muy alta en todos los modelos ya que lograron identificar con éxito en los datos de prueba los verdaderos negativos. Sin embargo, el propósito de esta clasificación es identificar de forma precisa los verdaderos positivos, donde los modelo son precarios. Por lo que es importante seguir retroalimemtando la base de datos y formular nuevos modelos de clasificación que mejoren este aspecto.Esto mismo se aprecia en las métricas del Kappa, donde los modelos son cercanos a 0, lo cual indica que los modelos mejoran ligeramente los resultados que se obtendrían meramente por el azar del resultado, una muestra más de cómo el modelo tiene buena precisión por la presencia abundante de los casos negativos, pero no logrando distinguir esos pocos casos positivos importantes para el caso. Finalmente, de entre todos los modelos se eligió el árboles de decisión debido a que es uno de los modelos con mejor métrica AUC que representa el área bajo la curva ROC que muestra el balance entre los verdaderos positivos y los verdaderos negativos. Si bien, a pesar de no ser el mejor en dicha métrica, está muy cerca del mejor modelo (ML) y además, Su KAPPA es el más alto de todos, lo cual mejora los resultados que se obtendrían por azar. Aunado a lo anteriormente mencionado, la interpretabilidad del modelo es muy buena y permite entender el comportamiemto de los clientes con posibilidades de fraude y de esta manera saber los principales factores que hacen cometer fraude a las personas y con ello poder realizar estrategias bancarias para disminuir dichos casos y mejorar los KPIs de las instituciones bancarias.