Prediksi Fraud Credit Card
Rizki Aldiansyah
July 25, 2023
library(tidyverse)
library(caret)
library(plotly)
library(data.table)
library(GGally)
library(tidymodels)
library(car)
library(scales)
library(lmtest)
library(ggplot2)1 Penjelasan Dataset
Dataset ini hanya berisi variabel input numerik yang merupakan hasil dari transformasi PCA (Principal Component Analysis). Sayangnya, karena masalah kerahasiaan, informasi asli mengenai fitur-fitur utama (principal components) dan latar belakang data tidak dapat disediakan. Fitur-fitur V1, V2, …, V28 adalah komponen utama yang diperoleh dari transformasi PCA. Satu-satunya fitur yang tidak diubah dengan PCA adalah ‘Time’ dan ‘Amount’. Fitur ‘Time’ berisi waktu dalam detik antara setiap transaksi dengan transaksi pertama dalam dataset. Fitur ‘Amount’ berisi jumlah transaksi. Fitur ‘Class’ adalah variabel target yang bernilai 1 jika terjadi penipuan dan 0 jika tidak.
Karena kelas dataset ini tidak seimbang, disarankan untuk mengukur akurasi menggunakan Area Under the Precision-Recall Curve (AUPRC). Akurasi dari confusion matrix tidak memiliki makna yang signifikan untuk klasifikasi yang tidak seimbang.
Dalam situasi dataset yang tidak seimbang seperti ini, kita perlu berhati-hati dalam mengevaluasi model klasifikasi. Meskipun akurasi keseluruhan mungkin tinggi karena mayoritas data adalah non-fraud (kelas negatif), namun ini mungkin tidak mencerminkan performa yang sebenarnya dalam mendeteksi kejadian fraud (kelas positif). Oleh karena itu, penggunaan metrik evaluasi yang lebih tepat seperti AUPRC sangat dianjurkan untuk mengukur kualitas model klasifikasi pada dataset yang tidak seimbang.
2 Data Preparation
# Membaca data dari file CSV
credit_card <- read.csv('./data_input/card_transdata.csv')
# Menampilkan data
head(credit_card)#> distance_from_home distance_from_last_transaction
#> 1 57.877857 0.3111400
#> 2 10.829943 0.1755915
#> 3 5.091079 0.8051526
#> 4 2.247564 5.6000435
#> 5 44.190936 0.5664863
#> 6 5.586408 13.2610733
#> ratio_to_median_purchase_price repeat_retailer used_chip used_pin_number
#> 1 1.94593998 1 1 0
#> 2 1.29421881 1 0 0
#> 3 0.42771456 1 0 0
#> 4 0.36266258 1 1 0
#> 5 2.22276730 1 1 0
#> 6 0.06476847 1 0 0
#> online_order fraud
#> 1 0 0
#> 2 0 0
#> 3 1 0
#> 4 1 0
#> 5 1 0
#> 6 0 0glimpse(credit_card)#> Rows: 1,000,000
#> Columns: 8
#> $ distance_from_home <dbl> 57.8778566, 10.8299427, 5.0910795, 2.24…
#> $ distance_from_last_transaction <dbl> 0.31114001, 0.17559150, 0.80515259, 5.6…
#> $ ratio_to_median_purchase_price <dbl> 1.94593998, 1.29421881, 0.42771456, 0.3…
#> $ repeat_retailer <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, …
#> $ used_chip <dbl> 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, …
#> $ used_pin_number <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, …
#> $ online_order <dbl> 0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, …
#> $ fraud <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …Insigth Dari hasil glimpse didapatkan bahwa strutur data ini sudah baik, oleh karenanya tidak ada tindakan selanjutnya
# Mengubah kolom menjadi faktor menggunakan mutate
credit_card <- credit_card %>%
mutate(repeat_retailer = as.factor(repeat_retailer),
used_chip = as.factor(used_chip),
used_pin_number = as.factor(used_pin_number),
online_order = as.factor(online_order),
fraud = as.factor(fraud))na_count <- sapply(credit_card, function(x) sum(is.na(x)))
na_count#> distance_from_home distance_from_last_transaction
#> 0 0
#> ratio_to_median_purchase_price repeat_retailer
#> 0 0
#> used_chip used_pin_number
#> 0 0
#> online_order fraud
#> 0 0Insigth Tidak terdapat nilai yang missing pada dataset ini
3 Exploratory Data Analyst
summary(credit_card)#> distance_from_home distance_from_last_transaction
#> Min. : 0.005 Min. : 0.000
#> 1st Qu.: 3.878 1st Qu.: 0.297
#> Median : 9.968 Median : 0.999
#> Mean : 26.629 Mean : 5.037
#> 3rd Qu.: 25.744 3rd Qu.: 3.356
#> Max. :10632.724 Max. :11851.105
#> ratio_to_median_purchase_price repeat_retailer used_chip used_pin_number
#> Min. : 0.0044 0:118464 0:649601 0:899392
#> 1st Qu.: 0.4757 1:881536 1:350399 1:100608
#> Median : 0.9977
#> Mean : 1.8242
#> 3rd Qu.: 2.0964
#> Max. :267.8029
#> online_order fraud
#> 0:349448 0:912597
#> 1:650552 1: 87403
#>
#>
#>
#> 3.1 Mengecek Distribusi Data
Distribusi data dilakukan pengecekan karna dari deskripsi dataset yang diberikan pemiliki dataset ini mengatakan bahwa data yang ia berikan sangat imbalace, oleh karenanya wajib mengetahui seberapa imbalance data tersebut
# Membuat count plot untuk variabel kategorikal "Class"
ggplot(credit_card, aes(x = fraud)) +
geom_bar() +
labs(title = "Distribusi Kelas 'Class'",
x = "Fraud",
y = "Jumlah") +
theme_minimal()
Insigth Sesuai dengan penjelasan datasetnya. memang
classnya ini sangatlah imbalance, hal ini haruslah dilakukan pemrosesan
pada dataset ini seperti over sampling ataupun under samplaing agar
datanya balance.
3.1.1 Under Sampling
library(ROSE)
set.seed(123)
credit_card_balanced <- ovun.sample(fraud ~ ., data = credit_card, method = "both", N = 8000)$data
# Menampilkan hasil data yang telah di-oversampling
print(table(credit_card_balanced$fraud))#>
#> 0 1
#> 4043 39573.2 Visualisai Distribusi data tiap label dengan prediktor kategori
plot(credit_card_balanced$fraud, credit_card_balanced$online_order)
table(credit_card_balanced$fraud, credit_card_balanced$online_order)#>
#> 0 1
#> 0 1511 2532
#> 1 199 3758Insigth dari data hasil tersebut dapat disimpulkan bahwa fraud terjadi lebih banyak pada pembelian online
plot(credit_card_balanced$fraud, credit_card_balanced$used_pin_number)
table(credit_card_balanced$fraud, credit_card_balanced$used_pin_number)#>
#> 0 1
#> 0 3608 435
#> 1 3943 14Insigth dari data hasil tersebut dapat disimpulkan bahwa fraud terjadi lebih banyak tidak menggunakan number pin
prop.table(table(credit_card_balanced$fraud))#>
#> 0 1
#> 0.505375 0.4946254 Cross Validation
RNGkind(sample.kind = "Rounding")
set.seed(417)
# index sampling
index <- sample(x = nrow(credit_card_balanced), size = nrow(credit_card_balanced) * 0.8)
# splitting
cc_train <- credit_card_balanced[index, ]
cc_test <- credit_card_balanced[-index, ]# re-check class imbalance
prop.table(table(cc_test$fraud))#>
#> 0 1
#> 0.509375 0.4906255 Modeling
# model base
model_lr <- glm(formula = fraud ~ .,
data = cc_train,
family = 'binomial')# bandingkan AIC
model_lr$aic#> [1] 2813.502# summary model
summary(model_lr)#>
#> Call:
#> glm(formula = fraud ~ ., family = "binomial", data = cc_train)
#>
#> Coefficients:
#> Estimate Std. Error z value
#> (Intercept) -7.025021 0.262903 -26.721
#> distance_from_home 0.028846 0.001161 24.848
#> distance_from_last_transaction 0.043480 0.002643 16.450
#> ratio_to_median_purchase_price 1.113557 0.031770 35.050
#> repeat_retailer1 -1.465616 0.156870 -9.343
#> used_chip1 -1.159571 0.113002 -10.262
#> used_pin_number1 -12.665803 0.800395 -15.824
#> online_order1 4.706304 0.211765 22.224
#> Pr(>|z|)
#> (Intercept) <0.0000000000000002 ***
#> distance_from_home <0.0000000000000002 ***
#> distance_from_last_transaction <0.0000000000000002 ***
#> ratio_to_median_purchase_price <0.0000000000000002 ***
#> repeat_retailer1 <0.0000000000000002 ***
#> used_chip1 <0.0000000000000002 ***
#> used_pin_number1 <0.0000000000000002 ***
#> online_order1 <0.0000000000000002 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 8871.8 on 6399 degrees of freedom
#> Residual deviance: 2797.5 on 6392 degrees of freedom
#> AIC: 2813.5
#>
#> Number of Fisher Scoring iterations: 9Interpretasi Model - Intercept: Jika seseorang tidak melakukan pembelian online, repeat order, dan menggunakan pin, serta variable lainnya bernilai 0 maka peluang terjadi fraud -7.025 - semakin besar nilai dari distance_from_home, distance_last_transaction ataupun ratio_to_median_purchace_price. maka semakin besar juga kemungkinan terjadi fraud - jika repeat_retailer, used_chip, ataupun used_pin_number = 1, maka peluang terjadinya fraud akan semakin kecil, sebaliknya jika online_order = 1, maka peluang terjadinya fraud akan semakin besar.
6 Evaluasi
cc_test$pred_risk <- predict(object = model_lr,
newdata = cc_test,
type = "response")
head(cc_test)#> distance_from_home distance_from_last_transaction
#> 4 10.198055 6.75355971
#> 9 30.060108 1.19572926
#> 11 1.962679 4.71855159
#> 16 3.256990 0.08256192
#> 17 2.772009 1.61721178
#> 26 48.326194 0.78340107
#> ratio_to_median_purchase_price repeat_retailer used_chip used_pin_number
#> 4 0.4752249 1 0 0
#> 9 0.5449163 1 1 0
#> 11 1.7946043 1 0 0
#> 16 0.1212887 1 1 0
#> 17 0.8473620 1 0 0
#> 26 8.0372196 1 0 0
#> online_order fraud pred_risk
#> 4 1 0 0.06492930486
#> 9 1 0 0.03173777590
#> 11 0 0 0.00196466935
#> 16 0 0 0.00008127393
#> 17 0 0 0.00061285289
#> 26 0 0 0.86845423265# ubah peluang menjadi label prediksi
cc_test$pred_label <- ifelse(cc_test$pred_risk > 0.5, 1, 0)
head(cc_test)#> distance_from_home distance_from_last_transaction
#> 4 10.198055 6.75355971
#> 9 30.060108 1.19572926
#> 11 1.962679 4.71855159
#> 16 3.256990 0.08256192
#> 17 2.772009 1.61721178
#> 26 48.326194 0.78340107
#> ratio_to_median_purchase_price repeat_retailer used_chip used_pin_number
#> 4 0.4752249 1 0 0
#> 9 0.5449163 1 1 0
#> 11 1.7946043 1 0 0
#> 16 0.1212887 1 1 0
#> 17 0.8473620 1 0 0
#> 26 8.0372196 1 0 0
#> online_order fraud pred_risk pred_label
#> 4 1 0 0.06492930486 0
#> 9 1 0 0.03173777590 0
#> 11 0 0 0.00196466935 0
#> 16 0 0 0.00008127393 0
#> 17 0 0 0.00061285289 0
#> 26 0 0 0.86845423265 1cc_test %>%
select(fraud, # label aktual
pred_risk, # peluang hasil prediksi not_paid
pred_label) %>% # hasil prediksi (label)
head(10)#> fraud pred_risk pred_label
#> 4 0 0.0649293048552 0
#> 9 0 0.0317377758996 0
#> 11 0 0.0019646693520 0
#> 16 0 0.0000812739314 0
#> 17 0 0.0006128528911 0
#> 26 0 0.8684542326500 1
#> 29 0 0.0012716896044 0
#> 33 0 0.0451001121395 0
#> 37 0 0.0000002376394 0
#> 43 0 0.8146191426757 1# confusion matrix
library(caret)
confusionMatrix(data = as.factor(cc_test$pred_label),
reference = cc_test$fraud,
positive = "1")#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 757 49
#> 1 58 736
#>
#> Accuracy : 0.9331
#> 95% CI : (0.9198, 0.9449)
#> No Information Rate : 0.5094
#> P-Value [Acc > NIR] : <0.0000000000000002
#>
#> Kappa : 0.8662
#>
#> Mcnemar's Test P-Value : 0.4393
#>
#> Sensitivity : 0.9376
#> Specificity : 0.9288
#> Pos Pred Value : 0.9270
#> Neg Pred Value : 0.9392
#> Prevalence : 0.4906
#> Detection Rate : 0.4600
#> Detection Prevalence : 0.4963
#> Balanced Accuracy : 0.9332
#>
#> 'Positive' Class : 1
#> Kesimpulan
Kelas Positive : fraud (1)
Pada kasus ini, risiko yang cencering adalah jika terjadi FP sehingga mabil matrix evaluasi Precision (Prioritas), karena kita tau bahwa risikonya sangat tinggi jika pada sebuah kasus yang seharusnya fraud malah dianggap tidak fraud. oleh karenanya Precision lebih prioritas dari pada Recall