Fraud detection in Banking
Víctor López
30/6/2020
RESUMEN
El fraude con tarjetas de crédito le cuesta a los bancos millones de dólares al año en reembolsos, honorarios legales y mitigación. Negar las transacciones fraudulentas antes de que ocurran reduciría en gran medida los gastos.
En este documento, utilizo un conjunto de datos disponible públicamente de 6,3 millones de transacciones con tarjeta de crédito y cada uno se clasifica como Fraude o No Fraude.
La variable de resultado es categórica y binaria.
Según el tipo de variable Resultado, utilizo cuatro modelos diferentes de aprendizaje automático para determinar cuál se ajusta mejor al conjunto de prueba en función de la curva ROC y el Accuracy. Los falsos positivos son una preocupación importante ya que negaremos cualquier transacción que se marque de manera fraudulenta, obligando al cliente a llamar al servicio al cliente para completar la transacción. Pruebo cada modelo con 100,000 transacciones aleatorias clasificadas como Sin Fraude para estimar la tasa de falsos positivos. También capturo el tiempo para procesar las 100,000 transacciones para estimar la intensidad computacional de cada modelo.
Los resultados son increibles. Casi todos los modelos seleccionaron el 97% + de las transacciones de Fraude correctamente.
Exploratory Data Analysis
Cargamos librerias
library(plyr)
library(tidyverse)## ── Attaching packages ───────────────────────────────────────────────── tidyverse 1.3.0 ──## ✓ ggplot2 3.3.0 ✓ purrr 0.3.4
## ✓ tibble 2.1.3 ✓ dplyr 0.8.5
## ✓ tidyr 1.0.2 ✓ stringr 1.4.0
## ✓ readr 1.3.1 ✓ forcats 0.5.0## Warning: package 'purrr' was built under R version 3.6.2## ── Conflicts ──────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::arrange() masks plyr::arrange()
## x purrr::compact() masks plyr::compact()
## x dplyr::count() masks plyr::count()
## x dplyr::failwith() masks plyr::failwith()
## x dplyr::filter() masks stats::filter()
## x dplyr::id() masks plyr::id()
## x dplyr::lag() masks stats::lag()
## x dplyr::mutate() masks plyr::mutate()
## x dplyr::rename() masks plyr::rename()
## x dplyr::summarise() masks plyr::summarise()
## x dplyr::summarize() masks plyr::summarize()library(caret)## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## liftlibrary(GGally)## Warning: package 'GGally' was built under R version 3.6.2## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2##
## Attaching package: 'GGally'## The following object is masked from 'package:dplyr':
##
## nasalibrary(stringr)
library(rattle)## Warning: package 'rattle' was built under R version 3.6.2## Loading required package: bitops## Rattle: A free graphical interface for data science with R.
## Versión 5.4.0 Copyright (c) 2006-2020 Togaware Pty Ltd.
## Escriba 'rattle()' para agitar, sacudir y rotar sus datos.library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(ROCR)## Warning: package 'ROCR' was built under R version 3.6.2Plantamos semilla aleatoria para reproducibilidad
set.seed(317)Cargamos el dataset y hacemos un Glimpse
df <- read_csv("PS_20174392719_1491204439457_log.csv")## Parsed with column specification:
## cols(
## step = col_double(),
## type = col_character(),
## amount = col_double(),
## nameOrig = col_character(),
## oldbalanceOrg = col_double(),
## newbalanceOrig = col_double(),
## nameDest = col_character(),
## oldbalanceDest = col_double(),
## newbalanceDest = col_double(),
## isFraud = col_double(),
## isFlaggedFraud = col_double()
## )glimpse(df)## Observations: 6,362,620
## Variables: 11
## $ step <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ type <chr> "PAYMENT", "PAYMENT", "TRANSFER", "CASH_OUT", "PAYMENT…
## $ amount <dbl> 9839.64, 1864.28, 181.00, 181.00, 11668.14, 7817.71, 7…
## $ nameOrig <chr> "C1231006815", "C1666544295", "C1305486145", "C8400836…
## $ oldbalanceOrg <dbl> 170136.0, 21249.0, 181.0, 181.0, 41554.0, 53860.0, 183…
## $ newbalanceOrig <dbl> 160296.36, 19384.72, 0.00, 0.00, 29885.86, 46042.29, 1…
## $ nameDest <chr> "M1979787155", "M2044282225", "C553264065", "C38997010…
## $ oldbalanceDest <dbl> 0, 0, 0, 21182, 0, 0, 0, 0, 0, 41898, 10845, 0, 0, 0, …
## $ newbalanceDest <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, …
## $ isFraud <dbl> 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ isFlaggedFraud <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …Las variables nameOrig y nameDest son técnicamente categóricas, pero hay demasiadas para ser útiles para modelar. El prefijo de letra que tienen puede ser importante.
fraud_df <- df %>%
mutate(name_orig_first = str_sub(nameOrig,1,1)) %>%
mutate(name_dest_first = str_sub(nameDest, 1, 1)) %>%
select(-nameOrig, -nameDest)Cuantos prefijos tiene NameDest?
unique(fraud_df$name_dest_first)## [1] "M" "C"Hay dos prefijos en nameDest; “C” y “M”, por lo que se convertirá en un factor.
fraud_df$name_dest_first <- as.factor(fraud_df$name_dest_first)
table(fraud_df$name_dest_first)##
## C M
## 4211125 2151495Cuantos prefijos tiene NomOrig?
unique(fraud_df$name_orig_first)## [1] "C"Hay un solo prefijo “C” en nameOrig, por lo que no es útil y se eliminará junto con isFlaggedFraud, que se parece a la predicción de otra persona.
Reorganizo las columnas de una manera más lógica.
fraud_df2 <- fraud_df %>%
select(-name_orig_first, -isFlaggedFraud) %>%
select(isFraud, type, step, everything()) # El segundo select sirve para posicionar las variables al principio
glimpse(fraud_df2)## Observations: 6,362,620
## Variables: 9
## $ isFraud <dbl> 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ type <chr> "PAYMENT", "PAYMENT", "TRANSFER", "CASH_OUT", "PAYMEN…
## $ step <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ amount <dbl> 9839.64, 1864.28, 181.00, 181.00, 11668.14, 7817.71, …
## $ oldbalanceOrg <dbl> 170136.0, 21249.0, 181.0, 181.0, 41554.0, 53860.0, 18…
## $ newbalanceOrig <dbl> 160296.36, 19384.72, 0.00, 0.00, 29885.86, 46042.29, …
## $ oldbalanceDest <dbl> 0, 0, 0, 21182, 0, 0, 0, 0, 0, 41898, 10845, 0, 0, 0,…
## $ newbalanceDest <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,…
## $ name_dest_first <fct> M, M, C, C, M, M, M, M, M, C, C, M, M, M, M, C, M, M,…Las columnas type & isFraud son categóricas y se cambiarán a factores
fraud_df2$type <- as.factor(fraud_df2$type)
fraud_df2$isFraud <- as.factor(fraud_df2$isFraud)Algunos modelos que usaremos no tienen me gusta 1 y 0 en el resultado, por lo que los recodificaremos.
fraud_df2$isFraud <- recode_factor(fraud_df2$isFraud, `0` = "No", `1` = "Yes")
# Recodificamos los 0 por "No" y los 1 por "Yes"Vamos a hacer un Summary.
summary(fraud_df2)## isFraud type step amount
## No :6354407 CASH_IN :1399284 Min. : 1.0 Min. : 0
## Yes: 8213 CASH_OUT:2237500 1st Qu.:156.0 1st Qu.: 13390
## DEBIT : 41432 Median :239.0 Median : 74872
## PAYMENT :2151495 Mean :243.4 Mean : 179862
## TRANSFER: 532909 3rd Qu.:335.0 3rd Qu.: 208721
## Max. :743.0 Max. :92445517
## oldbalanceOrg newbalanceOrig oldbalanceDest newbalanceDest
## Min. : 0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 0 1st Qu.: 0 1st Qu.: 0 1st Qu.: 0
## Median : 14208 Median : 0 Median : 132706 Median : 214661
## Mean : 833883 Mean : 855114 Mean : 1100702 Mean : 1224996
## 3rd Qu.: 107315 3rd Qu.: 144258 3rd Qu.: 943037 3rd Qu.: 1111909
## Max. :59585040 Max. :49585040 Max. :356015889 Max. :356179279
## name_dest_first
## C:4211125
## M:2151495
##
##
##
## Solo hay 8213 registros donde isFraud es verdadero.
Lo tendré en cuenta al crear los conjuntos de entrenamiento y prueba.
Mi plan es crear un conjunto de datos de entrenamiento y prueba que sea 50% de fraude / 50% sin fraude.
Ahora vamos a observar mas de cerca las transacciones fraudulentas.
fraud_trans <- fraud_df2 %>%
filter(isFraud == "Yes")
summary(fraud_trans)## isFraud type step amount
## No : 0 CASH_IN : 0 Min. : 1.0 Min. : 0
## Yes:8213 CASH_OUT:4116 1st Qu.:181.0 1st Qu.: 127091
## DEBIT : 0 Median :367.0 Median : 441423
## PAYMENT : 0 Mean :368.4 Mean : 1467967
## TRANSFER:4097 3rd Qu.:558.0 3rd Qu.: 1517771
## Max. :743.0 Max. :10000000
## oldbalanceOrg newbalanceOrig oldbalanceDest newbalanceDest
## Min. : 0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 125822 1st Qu.: 0 1st Qu.: 0 1st Qu.: 0
## Median : 438983 Median : 0 Median : 0 Median : 4676
## Mean : 1649668 Mean : 192393 Mean : 544250 Mean : 1279708
## 3rd Qu.: 1517771 3rd Qu.: 0 3rd Qu.: 147829 3rd Qu.: 1058725
## Max. :59585040 Max. :49585040 Max. :236230517 Max. :236726495
## name_dest_first
## C:8213
## M: 0
##
##
##
## Interesante. Cuando el tipo es CASH_IN, DEBIT o PAYMENT, no hay casos de fraude. Esto debe tenerse en cuenta al preparar los datos de train y de test.
En cada caso de fraude, name_dest_first tenía un código de “C”. Podemos filtrar el conjunto de datos principal para eliminar todas las M
El monto del fraude alcanza un máximo de 10,000,000, por lo que también filtraremos cualquier transacción por encima de ese monto.
Reducimos el dataset
Eliminar variables insignificantes; filtrar solo por CASH_OUT y TRANSFERS. Tampoco hay transacciones superiores a 10,000,000, por lo que también se pueden filtrar.
fraud_df3 <- fraud_df2 %>%
filter(type %in% c("CASH_OUT", "TRANSFER")) %>%
filter(name_dest_first == "C") %>%
filter(amount <= 10000000) %>%
select(-name_dest_first)
summary(fraud_df3)## isFraud type step amount
## No :2759753 CASH_IN : 0 Min. : 1 Min. : 0
## Yes: 8213 CASH_OUT:2237500 1st Qu.:155 1st Qu.: 82900
## DEBIT : 0 Median :236 Median : 171092
## PAYMENT : 0 Mean :242 Mean : 300426
## TRANSFER: 530466 3rd Qu.:332 3rd Qu.: 306252
## Max. :743 Max. :10000000
## oldbalanceOrg newbalanceOrig oldbalanceDest newbalanceDest
## Min. : 0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 0 1st Qu.: 0 1st Qu.: 127785 1st Qu.: 326982
## Median : 311 Median : 0 Median : 554620 Median : 826727
## Mean : 47669 Mean : 16106 Mean : 1670726 Mean : 1998711
## 3rd Qu.: 31013 3rd Qu.: 0 3rd Qu.: 1730370 3rd Qu.: 2116020
## Max. :59585040 Max. :49585040 Max. :356015889 Max. :356179279Esto reduce el conjunto de datos completo a 2,8 millones de registros. Esa es una reducción del 56% en el conjunto de datos que debería eliminar mucho ruido.
Creamos un “Sample dataset”
not_fraud <- fraud_df3 %>%
filter(isFraud == "No") %>%
sample_n(8213)
is_fraud <- fraud_df3 %>%
filter(isFraud == "Yes")
full_sample <- rbind(not_fraud, is_fraud) %>%
arrange(step)¿Step tiene algún patrón claro en la distribución entre los casos de fraude?
Tenga en cuenta que el paso indica la hora dentro del mes en que se capturaron estos datos, por lo que estos gráficos deben considerarse series temporales.
ggplot(full_sample, aes(x = step, col = isFraud)) +
geom_histogram(bins = 743)
Hay un patrón para los casos de No Fraude, pero no hay un patrón discernible de los casos de Fraude de esta trama.
Vamos a ver solo los casos de fraude
ggplot(is_fraud, aes(x = step)) +
geom_histogram(bins = 743)
Nada…
Probamos mas cosas: Mire ggpairs para ver si hay correlaciones entre los predictores.
ggpairs(full_sample)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Existe una alta correlación positiva entre OldBalanceOrig y newBalanceOrig. También una alta correlación entre oldBalanceDest y newBalanceDest. Nos ocuparemos de ellos sistemáticamente más abajo.
Hay algun patron de fraude en funcion del importe de la transaccion?
ggplot(full_sample, aes(type, amount, color = isFraud)) +
geom_point(alpha = 0.01) +
geom_jitter()
Sin patron
summary(full_sample)## isFraud type step amount
## No :8213 CASH_IN : 0 Min. : 1.0 Min. : 0
## Yes:8213 CASH_OUT:10702 1st Qu.:160.0 1st Qu.: 97924
## DEBIT : 0 Median :282.0 Median : 234723
## PAYMENT : 0 Mean :304.5 Mean : 881574
## TRANSFER: 5724 3rd Qu.:406.0 3rd Qu.: 644315
## Max. :743.0 Max. :10000000
## oldbalanceOrg newbalanceOrig oldbalanceDest newbalanceDest
## Min. : 0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 307 1st Qu.: 0 1st Qu.: 0 1st Qu.: 0
## Median : 64726 Median : 0 Median : 131971 Median : 481431
## Mean : 845631 Mean : 103260 Mean : 1092197 Mean : 1623044
## 3rd Qu.: 461443 3rd Qu.: 0 3rd Qu.: 943131 3rd Qu.: 1691175
## Max. :59585040 Max. :49585040 Max. :236230517 Max. :236726495Full dataset para modelización
preproc_model <- preProcess(fraud_df3[, -1],
method = c("center", "scale", "nzv"))
fraud_preproc <- predict(preproc_model, newdata = fraud_df3[, -1])Vincula los resultados a los datos preprocesados
fraud_pp_w_result <- cbind(isFraud = fraud_df3$isFraud, fraud_preproc)
summary(fraud_pp_w_result)## isFraud type step amount
## No :2759753 CASH_IN : 0 Min. :-1.7008 Min. :-0.49551
## Yes: 8213 CASH_OUT:2237500 1st Qu.:-0.6138 1st Qu.:-0.35878
## DEBIT : 0 Median :-0.0420 Median :-0.21332
## PAYMENT : 0 Mean : 0.0000 Mean : 0.00000
## TRANSFER: 530466 3rd Qu.: 0.6357 3rd Qu.: 0.00961
## Max. : 3.5369 Max. :15.99817
## oldbalanceOrg oldbalanceDest newbalanceDest
## Min. : -0.18960 Min. :-0.42399 Min. :-0.47994
## 1st Qu.: -0.18960 1st Qu.:-0.39156 1st Qu.:-0.40142
## Median : -0.18836 Median :-0.28324 Median :-0.28142
## Mean : 0.00000 Mean : 0.00000 Mean : 0.00000
## 3rd Qu.: -0.06625 3rd Qu.: 0.01514 3rd Qu.: 0.02817
## Max. :236.80038 Max. :89.92368 Max. :85.04701Observe que la media de todos los campos numéricos es cero. La desviación estándar es 1. Este es el resultado del centrado y la escala que coloca todas las variables numéricas en la misma escala.
Encuentra predictores altamente correlacionados
Seleccionar solo columnas numéricas
Elimine la columna de resultados y las columnas categóricas (no se preocupe, las volveremos a colocar después de esta prueba)
fraud_numeric <- fraud_pp_w_result %>%
select(-isFraud, -type)Removemos las variables correlacionadas porque distorsionan el analisis
high_cor_cols <- findCorrelation(cor(fraud_numeric), cutoff = .75, verbose = TRUE,
names = TRUE, exact = TRUE)## Compare row 5 and column 4 with corr 0.975
## Means: 0.338 vs 0.149 so flagging column 5
## All correlations <= 0.75high_cor_removed <- fraud_pp_w_result %>%
select(-newbalanceDest)Miramos correlaciones lineales entre predictoras (No hay ninguna)
fraud_numeric <- high_cor_removed %>%
select(-isFraud, -type)
comboInfo <- findLinearCombos(fraud_numeric)
comboInfo## $linearCombos
## list()
##
## $remove
## NULLModelado
model_df <-high_cor_removedCree la misma cantidad de datos de Fraude y No Fraude para el entrenamiento
is_fraud <- model_df %>%
filter(isFraud == "Yes")
not_fraud <- model_df %>%
filter(isFraud == "No") %>%
sample_n(8213)
# To mix up the sample set I'll arrange by `step`
model_full_sample <- rbind(is_fraud, not_fraud) %>%
arrange(step)Dividir la muestra en train y conjuntos de prueba
in_train <- createDataPartition(y = model_full_sample$isFraud, p = .75,
list = FALSE)
train <- model_full_sample[in_train, ]
test <- model_full_sample[-in_train, ] Create control used to fit all models
control <- trainControl(method = "repeatedcv",
number = 10,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary)Approach
En todos los modelos seguiremos un patrón consistente.
El patrón es: 1. ajustar el modelo a los datos 2. modelo comparado con los datos en los que fue entrenado 3. modelo comparado con el conjunto de datos de prueba que era desconocido para la construcción del modelo 4. compare el modelo con una muestra de 100k de casos sin fraude para determinar los falsos positivos esperados.
En cada uno de los modelos también realizaremos un seguimiento del tiempo para crear el modelo.
Nota: la relación entre el tiempo para crear el modelo y aplicar el modelo a los datos nuevos es muy diferente.
El ajuste del modelo, especialmente para los modelos de tipo caja negra, como Support Vector Machines, puede llevar mucho tiempo, pero el tiempo para aplicar ese modelo a los datos nuevos suele ser insignificante.
No tengas miedo de usar mucho tiempo para entrenar a un modelo si da mejores resultados.
RPART MODEL
start_time <- Sys.time()
rpart_model = train(isFraud ~ .,
data = train,
method = "rpart",
tuneLength = 10,
metric = "ROC",
trControl = control,
parms=list(split='information'))
end_time <- Sys.time()
end_time - start_time## Time difference of 12.23713 secsPrediccion en el set de entrenamiento
rpart_train_pred <- predict(rpart_model, train)
confusionMatrix(train$isFraud, rpart_train_pred)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 5786 374
## Yes 101 6059
##
## Accuracy : 0.9614
## 95% CI : (0.9579, 0.9648)
## No Information Rate : 0.5222
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9229
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.9828
## Specificity : 0.9419
## Pos Pred Value : 0.9393
## Neg Pred Value : 0.9836
## Prevalence : 0.4778
## Detection Rate : 0.4696
## Detection Prevalence : 0.5000
## Balanced Accuracy : 0.9624
##
## 'Positive' Class : No
## Precisión = 0.9489; muchos falsos positivos Sensibilidad: 0.9832 Especificidad: 0.9191
Prediccion en el set de TEST
rpart_test_pred <- predict(rpart_model, test)
confusionMatrix(test$isFraud, rpart_test_pred)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1922 131
## Yes 50 2003
##
## Accuracy : 0.9559
## 95% CI : (0.9492, 0.962)
## No Information Rate : 0.5197
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9118
##
## Mcnemar's Test P-Value : 2.742e-09
##
## Sensitivity : 0.9746
## Specificity : 0.9386
## Pos Pred Value : 0.9362
## Neg Pred Value : 0.9756
## Prevalence : 0.4803
## Detection Rate : 0.4681
## Detection Prevalence : 0.5000
## Balanced Accuracy : 0.9566
##
## 'Positive' Class : No
## Prediccion en 100K de No Fraud
big_no_sample <- model_df %>%
filter(isFraud == "No") %>%
sample_n(100000)Tambien vamos a ver cuanto tiempo tarda en procesar 100K
start_time <- Sys.time()
rpart_big_no_pred <- predict(rpart_model, big_no_sample)
end_time <- Sys.time()
end_time - start_time## Time difference of 0.439199 secsconfusionMatrix(big_no_sample$isFraud, rpart_big_no_pred)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 93383 6617
## Yes 0 0
##
## Accuracy : 0.9338
## 95% CI : (0.9323, 0.9354)
## No Information Rate : 0.9338
## P-Value [Acc > NIR] : 0.5033
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9338
## Neg Pred Value : NaN
## Prevalence : 0.9338
## Detection Rate : 0.9338
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : No
## Accuracy : 0.9151 Sensitivity : 1.0000 Specificity : 0.0000 False-positives: 8488 Run-time: 0.2806261 secs
CURVA ROC VS DATOS DE TEST?
rpart_probs <- predict(rpart_model, test, type = "prob")
rpart_ROC <- roc(response = test$isFraud,
predictor = rpart_probs$Yes,
levels = levels(test$isFraud))## Setting direction: controls < casesplot(rpart_ROC, col = "blue")
auc(rpart_ROC)## Area under the curve: 0.9867RANDOM FOREST MODEL
https://cran.r-project.org/web/packages/randomForest/randomForest.pdf https://www.r-bloggers.com/random-forests-in-r/
grid <- expand.grid(.mtry = 5, .ntree = seq(25, 150, by = 25))
start_time <- Sys.time()
rf_model <- train(isFraud ~ .,
data = train,
method="rf",
metric = "Accuracy",
TuneGrid = grid,
trControl=control)## Warning in train.default(x, y, weights = w, ...): The metric "Accuracy" was not
## in the result set. ROC will be used instead.end_time <- Sys.time()
end_time - start_time## Time difference of 10.01177 minslibrary(randomForest)## randomForest 4.6-14## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:rattle':
##
## importance## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginprint(rf_model$finalModel)##
## Call:
## randomForest(x = x, y = y, mtry = param$mtry, TuneGrid = ..1)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 5
##
## OOB estimate of error rate: 2.22%
## Confusion matrix:
## No Yes class.error
## No 5971 189 0.03068182
## Yes 84 6076 0.01363636plot(rf_model$finalModel)
Esta es un plot importante. Observamos que el error se nivela en alrededor de 100 árboles. Esto muestra que el modelo Random Forest es un modelo efectivo en este conjunto de datos. Si estos datos contienen muchas más variables, se necesitarán más árboles para llegar a la meseta, pero generalmente ocurre antes de 500 árboles. El modelo puede reducir de forma segura los árboles a 100 sin ningún impacto negativo significativo en el rendimiento.
Esta parcela siempre debe usarse para bosques aleatorios para determinar el mejor punto de corte para los árboles.
Plot para ver la importancia de las variables
varImpPlot(rf_model$finalModel)
Me sorprende que oldBalanceOrig sea la información más importante. Amount y oldBalanceDest también son influyentes.
Prediccion con el set de entrenamiento
rf_train_pred <- predict(rf_model, train)
confusionMatrix(train$isFraud, rf_train_pred, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 6160 0
## Yes 0 6160
##
## Accuracy : 1
## 95% CI : (0.9997, 1)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.0
## Specificity : 1.0
## Pos Pred Value : 1.0
## Neg Pred Value : 1.0
## Prevalence : 0.5
## Detection Rate : 0.5
## Detection Prevalence : 0.5
## Balanced Accuracy : 1.0
##
## 'Positive' Class : Yes
## Accuracy : 1; Obviamente overfitting Sensitivity : 1.0 Specificity : 1.0
Prediccion con el set de Test
rf_test_pred <- predict(rf_model, test)
confusionMatrix(test$isFraud, rf_test_pred, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1995 58
## Yes 29 2024
##
## Accuracy : 0.9788
## 95% CI : (0.9739, 0.983)
## No Information Rate : 0.5071
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9576
##
## Mcnemar's Test P-Value : 0.002683
##
## Sensitivity : 0.9721
## Specificity : 0.9857
## Pos Pred Value : 0.9859
## Neg Pred Value : 0.9717
## Prevalence : 0.5071
## Detection Rate : 0.4929
## Detection Prevalence : 0.5000
## Balanced Accuracy : 0.9789
##
## 'Positive' Class : Yes
## Accuracy : 0.9783; No está nada mal. Sensitivity : 0.9709 Specificity : 0.9901
Prediccion con el set de No fraude
start_time <- Sys.time()
rf_big_no_pred <- predict(rf_model, big_no_sample)
end_time <- Sys.time()
end_time - start_time## Time difference of 5.360228 secsconfusionMatrix(big_no_sample$isFraud, rf_big_no_pred, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 96989 3011
## Yes 0 0
##
## Accuracy : 0.9699
## 95% CI : (0.9688, 0.9709)
## No Information Rate : 0.9699
## P-Value [Acc > NIR] : 0.5048
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.00000
## Specificity : 1.00000
## Pos Pred Value : NaN
## Neg Pred Value : 0.96989
## Prevalence : 0.03011
## Detection Rate : 0.00000
## Detection Prevalence : 0.00000
## Balanced Accuracy : 0.50000
##
## 'Positive' Class : Yes
## Accuracy : 0.97 Sensitivity : 0.00000 Specificity : 1.00000 False-positives: 3002 Run-time: 4.95 secs
Plot de la curva ROC
rf_probs <- predict(rf_model, test, type = "prob")
rf_ROC <- roc(response = test$isFraud,
predictor = rf_probs$Yes,
levels = levels(test$isFraud))## Setting direction: controls < casesplot(rf_ROC, col = "green")
Area bajo la curva
- El Area bajo la curva es:
Comparamos modelos a través de la ROC CURVE
plot(rpart_ROC, col = "blue")
plot(rf_ROC, col = "green", add = TRUE)
Por cada modelo se vería así
sort(c(rpart = auc(rpart_ROC), rf = auc(rf_ROC)))## rpart rf
## 0.9867197 0.9979305Como de costumbre, la decisión de qué modelo utilizar no es sencilla. El arbol de decisión discrimina y predice muy bien en los datos de testeo, hay una diferencia mínima con el RF. En este caso podríamos sacrificar algo de accuracy a favor de ganar explicabilidad.