Model H2O untuk analisa fraud

Melanjutkan postingan sebelumnya, di sini akan digunakan model H2O.

Apa yang membuat H2O lebih cepat?
H2O memiliki fitur yang bersih dan jelas untuk langsung menghubungkan tool baik R atau Python, dengan CPU yang ada di mesin anda. Dengan cara ini kita dapat menyalurkan lebih banyak memori, memproses dengan tool yang ada di R atau Python untuk membuat perhitungan lebih cepat.  Package H2O memungkinkan perhitungan berlangsung pada kapasitas CPU 100% . Di samping itu H2O juga dapat dihubungkan dengan cluster di platform cloud untuk melakukan perhitungan. H2O dapat mengkompresi data yang besar, juga melakukan proses secara paralel.

Fraud illustration

Split data
Data displit menjadi 3 bagian, 2 bagian train data dan 1 bagian test data.

splits <- h2o.splitFrame(creditcard_hf,

                         ratios = c(0.4, 0.4),

                         seed = 42)

train_unsupervised  <- splits[[1]]

train_supervised  <- splits[[2]]

test <- splits[[3]]

response <- "Class"

features <- setdiff(colnames(train_unsupervised), response)

Autoencoder
Pertama, menggunakan deep leatning autoencouder pada train_unsupervised  kita cukup mengatur autoencoder = TRUE.
Di sini, dipakai teknik "bottleneck", di mana lapisan tersembunyi di tengah sangat kecil. Ini berarti bahwa model harus dikurangi  dimensinay(dalam hal ini, hingga 2 node / dimensi).
Model autoencoder kemudian akan mempelajari pola input data terlepas dari label kelas yang diberikan. Akan dilihat transaksi credit card  mana yang serupa dan transaksi mana yang outlier atau anomali.

model_nn <- h2o.deeplearning(x = features,

                             training_frame = train_unsupervised,

                             model_id = "model_nn",

                             autoencoder = TRUE,

                             reproducible = TRUE, 
                             #slow - turn off for real problems

                             ignore_const_cols = FALSE,

                             seed = 42,

                             hidden = c(10, 2, 10),

                             epochs = 100,

                             activation = "Tanh")

Simpan model

h2o.saveModel(model_nn, path="model_nn", force = TRUE)

model_nn <- h2o.loadModel("model_nn")

model_nn

## Model Details:

## H2OAutoEncoderModel: deeplearning

## Model ID:  model_nn

## Status of Neuron Layers: auto-encoder, gaussian distribution, Quadratic loss, 776 weights/biases, 16.0 KB, 2,622,851 training samples, mini-batch size 1

##   layer units  type dropout       l1       l2 mean_rate rate_rms momentum

## 1     1    34 Input  0.00 %                                             

## 2     2    10  Tanh  0.00 % 0.000000 0.000000  0.709865 0.320108 0.000000

## 3     3     2  Tanh  0.00 % 0.000000 0.000000  0.048458 0.109033 0.000000

## 4     4    10  Tanh  0.00 % 0.000000 0.000000  0.164717 0.192053 0.000000

## 5     5    34  Tanh         0.000000 0.000000  0.369681 0.425672 0.000000

##   mean_weight weight_rms mean_bias bias_rms

## 1                                         

## 2   -0.039307   0.691302  0.008052 0.965178

## 3   -0.097383   0.314106  0.226376 0.067917

## 4    0.227664   1.089589  0.112032 0.672444

## 5    0.011072   0.605586  0.091124 0.722602

##

## H2OAutoEncoderMetrics: deeplearning

## ** Reported on training data. **

##

## Training Set Metrics:

## MSE: (Extract with `h2o.mse`) 0.001472071

## RMSE: (Extract with `h2o.rmse`) 0.03836757

#Convert to autoencoded representation

test_autoenc <- h2o.predict(model_nn, test)

Reduce hidden layers dimension
Karena saya telah menggunakan model bottleneck dengan dua node di lapisan tersembunyi di tengah, kita dapat menggunakan pengurangan dimensi ini untuk menjelajahi ruang fitur kami (mirip dengan apa yang bisa kami lakukan dengan analisis komponen utama). Kami dapat mengekstrak fitur tersembunyi ini dengan fungsi h2o.deepfeatures () dan memplotnya untuk menunjukkan representasi data input yang berkurang.

train_features <- h2o.deepfeatures(model_nn, train_unsupervised, layer = 2) %>%

  as.data.frame() %>%

  mutate(Class = as.vector(train_unsupervised[, 31]))

ggplot(train_features, aes(x = DF.L2.C1, y = DF.L2.C2, color = Class)) +

  geom_point(alpha = 0.1)

# let's take the third hidden layer

train_features <- h2o.deepfeatures(model_nn, train_unsupervised, layer = 3) %>%

  as.data.frame() %>%

  mutate(Class = as.factor(as.vector(train_unsupervised[, 31]))) %>%

  as.h2o()

features_dim <- setdiff(colnames(train_features), response)

model_nn_dim <- h2o.deeplearning(y = response,

                               x = features_dim,

                               training_frame = train_features,

                               reproducible = TRUE, 
                               #slow - turn off for real problems

                               balance_classes = TRUE,

                               ignore_const_cols = FALSE,

                               seed = 42,

                               hidden = c(10, 2, 10),

                               epochs = 100,

                               activation = "Tanh")

h2o.saveModel(model_nn_dim, path="model_nn_dim", force = TRUE)

model_nn_dim <- h2o.loadModel("model_nn_dim/DeepLearning_model_R_1493574057843_49")

model_nn_dim

test_dim <- h2o.deepfeatures(model_nn, test, layer = 3)

h2o.predict(model_nn_dim, test_dim) %>%

  as.data.frame() %>%

  mutate(actual = as.vector(test[, 31])) %>%

  group_by(actual, predict) %>%

  summarise(n = n()) %>%

  mutate(freq = n / sum(n))

## Source: local data frame [4 x 4]

## Groups: actual [2]

##

##   actual predict     n       freq

##    <chr>  <fctr> <int>      <dbl>

## 1      0       0 16710 0.29506286

## 2      0       1 39922 0.70493714

## 3      1       0     7 0.07608696

## 4      1       1    85 0.92391304

Hasilnya kelihatan bagus untuk 92% fraud, tapi masih belum meyakinkan untuk kategori non fraud.

Deteksi anomali
Kami juga dapat melihat  contoh mana yang dianggap outlier atau anomali dalam data pengujian kami, menggunakan fungsi h2o.anomaly ().
Berdasarkan model autoencoder train_supervise sebelumnya, data input akan direkonstruksi dan untuk setiap contoh, mean squared error (MSE) antara nilai aktual dan rekonstruksi dihitung.
Saya juga menghitung rata-rata MSE untuk kedua label kelas.

anomaly <- h2o.anomaly(model_nn, test) %>%

  as.data.frame() %>%

  tibble::rownames_to_column() %>%

  mutate(Class = as.vector(test[, 31]))

mean_mse <- anomaly %>%

  group_by(Class) %>%

  summarise(mean = mean(Reconstruction.MSE))

This, we can now plot:

ggplot(anomaly, aes(x = as.numeric(rowname), y = Reconstruction.MSE, color = as.factor(Class))) +

  geom_point(alpha = 0.3) +

  geom_hline(data = mean_mse, aes(yintercept = mean, color = Class)) +

  scale_color_brewer(palette = "Set1") +

  labs(x = "instance number",

       color = "Class")

anomaly <- anomaly %>%

  mutate(outlier = ifelse(Reconstruction.MSE > 0.02, "outlier", "no_outlier"))

anomaly %>%

  group_by(Class, outlier) %>%

  summarise(n = n()) %>%

  mutate(freq = n / sum(n))

## Source: local data frame [4 x 4]

## Groups: Class [2]

##

##   Class    outlier     n         freq

##   <chr>      <chr> <int>        <dbl>

## 1     0 no_outlier 56602 0.9994702642

## 2     0    outlier    30 0.0005297358

## 3     1 no_outlier    60 0.6521739130

## 4     1    outlier    32 0.3478260870

Pre-trained supervised model

Kita sekarang dapat mencoba menggunakan model autoencoder sebagai input pra-pelatihan untuk model train_supervise. Di sini, saya kembali menggunakan model neural network. Model ini sekarang akan menggunakan bobot dari autoencoder untuk digunakan di model.

model_nn_2 <- h2o.deeplearning(y = response,

                               x = features,

                               training_frame = train_supervised,

                               pretrained_autoencoder  = "model_nn",

                               reproducible = TRUE, 
                               #slow - turn off for real problems

                               balance_classes = TRUE,

                               ignore_const_cols = FALSE,

                               seed = 42,

                               hidden = c(10, 2, 10),

                               epochs = 100,

                               activation = "Tanh")

h2o.saveModel(model_nn_2, path="model_nn_2", force = TRUE)

model_nn_2 <- h2o.loadModel("model_nn_2/DeepLearning_model_R_1493574057843_9")

model_nn_2

## Model Details:

## ==============

##

## H2OBinomialModel: deeplearning

## Model ID:  DeepLearning_model_R_1493574057843_9

## Status of Neuron Layers: predicting Class, 2-class classification, bernoulli distribution, CrossEntropy loss, 424 weights/biases, 11.7 KB, 3,643,248 training samples, mini-batch size 1

##   layer units    type dropout       l1       l2 mean_rate rate_rms

## 1     1    34   Input  0.00 %                                    

## 2     2    10    Tanh  0.00 % 0.000000 0.000000  0.274110 0.291925

## 3     3     2    Tanh  0.00 % 0.000000 0.000000  0.004480 0.002651

## 4     4    10    Tanh  0.00 % 0.000000 0.000000  0.210337 0.326239

## 5     5     2 Softmax         0.000000 0.000000  0.137694 0.123830

##   momentum mean_weight weight_rms mean_bias bias_rms

## 1                                                  

## 2 0.000000   -0.006945   1.058583 -0.501068 1.576798

## 3 0.000000    0.021012   0.309286  0.360286 0.105522

## 4 0.000000    0.934361   1.759343  0.304729 0.532527

## 5 0.000000   -0.133149   2.641065  2.392999 3.137845

##

## H2OBinomialMetrics: deeplearning

## ** Reported on training data. **

## ** Metrics reported on temporary training frame with 9973 samples **

##

## MSE:  0.01500211

## RMSE:  0.1224831

## LogLoss:  0.04408663

## Mean Per-Class Error:  0.00169424

## AUC:  0.9995075

## Gini:  0.9990149

##

## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:

##           0    1    Error      Rate

## 0      5000   17 0.003388  =17/5017

## 1         0 4956 0.000000   =0/4956

## Totals 5000 4973 0.001705  =17/9973

##

## Maximum Metrics: Maximum metrics at their respective thresholds

##                         metric threshold    value idx

## 1                       max f1  0.134320 0.998288  96

## 2                       max f2  0.134320 0.999314  96

## 3                 max f0point5  0.134320 0.997263  96

## 4                 max accuracy  0.134320 0.998295  96

## 5                max precision  1.000000 1.000000   0

## 6                   max recall  0.134320 1.000000  96

## 7              max specificity  1.000000 1.000000   0

## 8             max absolute_mcc  0.134320 0.996597  96

## 9   max min_per_class_accuracy  0.134320 0.996612  96

## 10 max mean_per_class_accuracy  0.134320 0.998306  96

##

## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`

pred <- as.data.frame(h2o.predict(object = model_nn_2, newdata = test)) %>%

  mutate(actual = as.vector(test[, 31]))

pred %>%

  group_by(actual, predict) %>%

  summarise(n = n()) %>%

  mutate(freq = n / sum(n))

## Source: local data frame [4 x 4]

## Groups: actual [2]

##

##   actual predict     n        freq

##    <chr>  <fctr> <int>       <dbl>

## 1      0       0 56512 0.997881057

## 2      0       1   120 0.002118943

## 3      1       0    16 0.173913043

## 4      1       1    76 0.826086957

pred %>%

  ggplot(aes(x = actual, fill = predict)) +

    geom_bar() +

    theme_bw() +

    scale_fill_brewer(palette = "Set1") +

    facet_wrap( ~ actual, scales = "free", ncol = 2)

Sekarang, ini terlihat jauh lebih baik! Kami kehilangan 17% dari kasus fraud tetapi kami juga tidak salah mengklasifikasikan terlalu banyak kasus non-fraud.
Nyatanya  kami sekarang akan menghabiskan lebih banyak waktu untuk mencoba memperbaiki model dengan  menggunakan performing grid search for hyperparameter tuning, melakukan pencarian grid untuk penyetelan hyperparameter.

Measuring model performance on highly unbalanced data

Karena bias yang besar terhadap kasus-kasus non-fraud, kami tidak dapat menggunakan ukuran kinerja seperti akurasi atau area di bawah kurva (AUC), karena mereka akan memberikan hasil yang terlalu optimis berdasarkan persentase tinggi dari klasifikasi yang benar dari kelas mayoritas.
Alternatif untuk AUC adalah dengan menggunakan kurva recall-precicion atau kurva_sensitivitas Untuk menghitung dan memplot metrik ini, kita dapat menggunakan paket ROCR. Ada berbagai cara untuk menghitung area di bawah kurva (lihat paket PRROC untuk detailnya) tetapi saya akan menggunakan fungsi sederhana yang menghitung area antara setiap titik-pasangan-pasangan x (yaitu x1 - x0, x2 - x1, dll) di bawah nilai y yang sesuai.

library(ROCR)

line_integral <- function(x, y) {

  dx <- diff(x)

  end <- length(y)

  my <- (y[1:(end - 1)] + y[2:end]) / 2

  sum(dx * my)

}

prediction_obj <- prediction(pred$p1, pred$actual)

par(mfrow = c(1, 2))

par(mar = c(5.1,4.1,4.1,2.1))

# precision-recall curve

perf1 <- performance(prediction_obj, measure = "prec", x.measure = "rec")

x <- perf1@x.values[[1]]

y <- perf1@y.values[[1]]

y[1] <- 0

plot(perf1, main = paste("Area Under the\nPrecision-Recall Curve:\n", round(abs(line_integral(x,y)), digits = 3)))

# sensitivity-specificity curve

perf2 <- performance(prediction_obj, measure = "sens", x.measure = "spec")

x <- perf2@x.values[[1]]

y <- perf2@y.values[[1]]

y[1] <- 0

plot(perf2, main = paste("Area Under the\nSensitivity-Specificity Curve:\n", round(abs(line_integral(x,y)), digits = 3)))

Presisi adalah proporsi kasus uji yang diprediksi sebagai fraud  (Prediksi positif sebenarnya), sedangkan recall atau sensitivitas adalah proporsi kasus fraud yang diidentifikasi sebagai fraud. Dan spesifisitas adalah proporsi kasus non-fraud yang diidentifikasi sebagai non-fraud.
Kurva presisi-recall memberi tahu kita hubungan antara prediksi fraud yang benar dan proporsi kasus fraud yang terdeteksi.
Jika semua atau sebagian besar kasus fraud diidentifikasi, kami juga memiliki banyak kasus non-fraud yang diprediksi sebagai fraud dan sebaliknya).
Kurva sensitivitas-spesifisitas dengan demikian memberi tahu kami hubungan antara kelas yang diidentifikasi dengan benar dari kedua label (mis. Jika kami memiliki 100% kasus fraud yang diklasifikasikan dengan benar, kami tidak akan memiliki kasus non-fraud yang diklasifikasikan dengan benar dan sebaliknya).
Kita juga dapat melihat ini sedikit berbeda, dengan secara manual melalui ambang prediksi yang berbeda dan menghitung berapa banyak kasus yang diklasifikasikan dengan benar di dua kelas:

thresholds <- seq(from = 0, to = 1, by = 0.1)

pred_thresholds <- data.frame(actual = pred$actual)

for (threshold in thresholds) {

 

  prediction <- ifelse(pred$p1 > threshold, 1, 0)

  prediction_true <- ifelse(pred_thresholds$actual == prediction, TRUE, FALSE)

  pred_thresholds <- cbind(pred_thresholds, prediction_true)

}

colnames(pred_thresholds)[-1] <- thresholds

pred_thresholds %>%

  gather(x, y, 2:ncol(pred_thresholds)) %>%

  group_by(actual, x, y) %>%

  summarise(n = n()) %>%

  ggplot(aes(x = as.numeric(x), y = n, color = actual)) +

    geom_vline(xintercept = 0.6, alpha = 0.5) +

    geom_line() +

    geom_point(alpha = 0.5) +

    theme_bw() +

    facet_wrap(actual ~ y, scales = "free", ncol = 2) +

    labs(x = "prediction threshold",

         y = "number of instances")

Grafik ini menggambarkan  pertambahan jumlah kasus correctly classified non-fraud  tanpa kehilangan correctly classified non-fraud pada ambang prediksi dari standar 0,5 menjadi 0,6.

pred %>%

  mutate(predict = ifelse(pred$p1 > 0.6, 1, 0)) %>%

  group_by(actual, predict) %>%

  summarise(n = n()) %>%

  mutate(freq = n / sum(n))

## Source: local data frame [4 x 4]

## Groups: actual [2]

##

##   actual predict     n        freq

##    <chr>   <dbl> <int>       <dbl>

## 1      0       0 56558 0.998693318

## 2      0       1    74 0.001306682

## 3      1       0    16 0.173913043

## 4      1       1    76 0.826086957

Kesimpulan
Kita ingat dari awal bahwa ada dugaan credit  card yang terkena fraud adalah 492 dan yang tidak kena fraud 284315, setelah melalui analisa di atas, didapat kesimpulan:

1. Model ini menunjukkan  83% of fraud dan  hampir  100% non-fraud.
2. Credit card yang benar benar kena fraud sebanyak 76.
3. Credit card yang benar benar aman alias tida kena fraud sebanyak 56558.