LBB Telco Customer Churn
Michael Deng
September 9, 2021
1 Intro
Salam sehat kepada para pembaca report ini. Dalam report ini, kita akan memuat model Naive bayes, decision tree dan random forest pada data test “Telco customer Churn” yang didapat dari kaggle. Kita akan memprediksi apakah seorang pelanggan akan tetap berlanggan pada layanan yang kita sediakan. Pelanggan yang tidak melanjutkan langganan(subscription) disebut dengan Churn
2 Library yang akan digunakan
Tahap awal kita akan menginstall packages yang akan kita gunakan.
library(tidyverse)
library(SnowballC)
library(textstem)
library(ROCR)
library(caret)
library(class)
library(partykit)
library(e1071)
library(rsample)
library(animation)
library(randomForest)
library(GGally)
library(rpart)
library(rattle)
library(rpart.plot)3 Read dan assign data
Mari kita mulai input dan melihat data yang akan kita pakai.
telco <- read.csv("telcochurn.csv", stringsAsFactors = T)
glimpse(telco)## Rows: 7,043
## Columns: 22
## $ X <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16~
## $ customerID <fct> 7590-VHVEG, 5575-GNVDE, 3668-QPYBK, 7795-CFOCW, 9237-~
## $ gender <fct> Female, Male, Male, Male, Female, Female, Male, Femal~
## $ SeniorCitizen <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,~
## $ Partner <fct> Yes, No, No, No, No, No, No, No, Yes, No, Yes, No, Ye~
## $ Dependents <fct> No, No, No, No, No, No, Yes, No, No, Yes, Yes, No, No~
## $ tenure <int> 1, 34, 2, 45, 2, 8, 22, 10, 28, 62, 13, 16, 58, 49, 2~
## $ PhoneService <fct> No, Yes, Yes, No, Yes, Yes, Yes, No, Yes, Yes, Yes, Y~
## $ MultipleLines <fct> No, No, No, No, No, Yes, Yes, No, Yes, No, No, No, Ye~
## $ InternetService <fct> DSL, DSL, DSL, DSL, Fiber optic, Fiber optic, Fiber o~
## $ OnlineSecurity <fct> No, Yes, Yes, Yes, No, No, No, Yes, No, Yes, Yes, No,~
## $ OnlineBackup <fct> Yes, No, Yes, No, No, No, Yes, No, No, Yes, No, No, N~
## $ DeviceProtection <fct> No, Yes, No, Yes, No, Yes, No, No, Yes, No, No, No, Y~
## $ TechSupport <fct> No, No, No, Yes, No, No, No, No, Yes, No, No, No, No,~
## $ StreamingTV <fct> No, No, No, No, No, Yes, Yes, No, Yes, No, No, No, Ye~
## $ StreamingMovies <fct> No, No, No, No, No, Yes, No, No, Yes, No, No, No, Yes~
## $ Contract <fct> Month-to-month, One year, Month-to-month, One year, M~
## $ PaperlessBilling <fct> Yes, No, Yes, No, Yes, Yes, Yes, No, Yes, No, Yes, No~
## $ PaymentMethod <fct> Electronic check, Mailed check, Mailed check, Bank tr~
## $ MonthlyCharges <dbl> 29.85, 56.95, 53.85, 42.30, 70.70, 99.65, 89.10, 29.7~
## $ TotalCharges <dbl> 29.85, 1889.50, 108.15, 1840.75, 151.65, 820.50, 1949~
## $ Churn <fct> No, No, Yes, No, Yes, Yes, No, No, Yes, No, No, No, N~4 Cleaning Data
Mari kita mulai dengan merapikan data yang akan dipakai. Hal yang bisa dibersihkan.
- data X dan Customer Id akan dihapus karena data tersebut tidak memiliki efek dalam prediksi
- semua data type yang bersifat character akan kita ubah menjadi kategori (sudah diubah saat read data)
- data type Int dan Num tidak akan diubah
- list Senior Citizen akan kita ubah dari 0 dan 1 menjadi No dan Yes. kategory Integer(angka) diubah menjadi kategori
telco <- telco %>%
mutate(SeniorCitizen = as.character(SeniorCitizen),
SeniorCitizen = ifelse(SeniorCitizen == "0","No", "Yes"),
SeniorCitizen = as.factor(SeniorCitizen)) %>%
select(-c(X, customerID))
glimpse(telco)## Rows: 7,043
## Columns: 20
## $ gender <fct> Female, Male, Male, Male, Female, Female, Male, Femal~
## $ SeniorCitizen <fct> No, No, No, No, No, No, No, No, No, No, No, No, No, N~
## $ Partner <fct> Yes, No, No, No, No, No, No, No, Yes, No, Yes, No, Ye~
## $ Dependents <fct> No, No, No, No, No, No, Yes, No, No, Yes, Yes, No, No~
## $ tenure <int> 1, 34, 2, 45, 2, 8, 22, 10, 28, 62, 13, 16, 58, 49, 2~
## $ PhoneService <fct> No, Yes, Yes, No, Yes, Yes, Yes, No, Yes, Yes, Yes, Y~
## $ MultipleLines <fct> No, No, No, No, No, Yes, Yes, No, Yes, No, No, No, Ye~
## $ InternetService <fct> DSL, DSL, DSL, DSL, Fiber optic, Fiber optic, Fiber o~
## $ OnlineSecurity <fct> No, Yes, Yes, Yes, No, No, No, Yes, No, Yes, Yes, No,~
## $ OnlineBackup <fct> Yes, No, Yes, No, No, No, Yes, No, No, Yes, No, No, N~
## $ DeviceProtection <fct> No, Yes, No, Yes, No, Yes, No, No, Yes, No, No, No, Y~
## $ TechSupport <fct> No, No, No, Yes, No, No, No, No, Yes, No, No, No, No,~
## $ StreamingTV <fct> No, No, No, No, No, Yes, Yes, No, Yes, No, No, No, Ye~
## $ StreamingMovies <fct> No, No, No, No, No, Yes, No, No, Yes, No, No, No, Yes~
## $ Contract <fct> Month-to-month, One year, Month-to-month, One year, M~
## $ PaperlessBilling <fct> Yes, No, Yes, No, Yes, Yes, Yes, No, Yes, No, Yes, No~
## $ PaymentMethod <fct> Electronic check, Mailed check, Mailed check, Bank tr~
## $ MonthlyCharges <dbl> 29.85, 56.95, 53.85, 42.30, 70.70, 99.65, 89.10, 29.7~
## $ TotalCharges <dbl> 29.85, 1889.50, 108.15, 1840.75, 151.65, 820.50, 1949~
## $ Churn <fct> No, No, Yes, No, Yes, Yes, No, No, Yes, No, No, No, N~Selanjutnya kita akan memeriksa apakah adanya Missing Value pada data
anyNA(telco)## [1] TRUEcolSums(is.na(telco))## gender SeniorCitizen Partner Dependents
## 0 0 0 0
## tenure PhoneService MultipleLines InternetService
## 0 0 0 0
## OnlineSecurity OnlineBackup DeviceProtection TechSupport
## 0 0 0 0
## StreamingTV StreamingMovies Contract PaperlessBilling
## 0 0 0 0
## PaymentMethod MonthlyCharges TotalCharges Churn
## 0 0 11 0karena jumlah Missing Value (na) dibawah 5% dari total data. maka kita akan menghapus semua baris yang memiliki NA.
telco <- telco %>% na.omit()colSums(is.na(telco))## gender SeniorCitizen Partner Dependents
## 0 0 0 0
## tenure PhoneService MultipleLines InternetService
## 0 0 0 0
## OnlineSecurity OnlineBackup DeviceProtection TechSupport
## 0 0 0 0
## StreamingTV StreamingMovies Contract PaperlessBilling
## 0 0 0 0
## PaymentMethod MonthlyCharges TotalCharges Churn
## 0 0 0 0Selanjutnya kita ingin melihat apakah ada data outlier dalam data bertipe numeric. cara yang simple adalah dengan menggunakan visual boxplot().
boxplot(telco)
dari visual boxplot, kita tidak melihat adanya data outlier. Data tidak mengandung outlier dan missing value, sehingga kita bisa langsung membuat model.
5 Modelling Naive Bayes
kita terlebih dahulu memeriksa apakah proposi data sudah bagus (notes : target = churn)
prop.table(table(telco$Churn))##
## No Yes
## 0.734215 0.265785Walaupun jumlah data tidak begitu proposional. kita tidak akan melakukan downsample atau upsample karena kita ingin melihat kualitas model dengan data yang tidak dimanipulasi.
kita akan membagi data menjadi 2 bagian dimana data train akan berjumlah 70% dari total data
RNGkind(sample.kind = "Rounding")
set.seed(417)
idx <- sample(nrow(telco), nrow(telco)*0.7)
train_telco <- telco[idx,]
test_telco <- telco[-idx,]Kita akan membuat model Naive Bayes dengan menggunakan data train
model_churn <- naiveBayes(Churn~ ., train_telco)6 Predict Naive Bayes
kita sudah membuat model dengan kode assign model_churn. sekarang kita akan melakukan prediksi terhadap 30% data test yang sudah kita sediakan.
pred <- predict(model_churn, test_telco, type = "class")7 Evaluasi Model Naive Bayes dengan confusion matrix
Disini kita akan melihat hasil yang kita dapat dari model dan prediksi yang sudah kita lakukan.
confusionMatrix(pred, test_telco$Churn, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1265 164
## Yes 289 392
##
## Accuracy : 0.7853
## 95% CI : (0.7672, 0.8027)
## No Information Rate : 0.7365
## P-Value [Acc > NIR] : 0.000000115696
##
## Kappa : 0.4841
##
## Mcnemar's Test P-Value : 0.000000005676
##
## Sensitivity : 0.7050
## Specificity : 0.8140
## Pos Pred Value : 0.5756
## Neg Pred Value : 0.8852
## Prevalence : 0.2635
## Detection Rate : 0.1858
## Detection Prevalence : 0.3227
## Balanced Accuracy : 0.7595
##
## 'Positive' Class : Yes
## 7.1 Metrics apa yang akan digunakan?
disini kita akan memakai ukuran
Sensitivity/Recall. karena kita adalah layanan langganan dimana kita bisa memfokuskan untuk memberikan promo yang menarik sehingga para pelanggan bisa menjadi berlangganan lebih lama lagi.
Specifity. karena kita bisa memprediksi apakah pelanggan kita akan berhenti berlanggan atau tidak. kalau mereka berencana untuk berhenti. kita bisa memberikan mereka promo menarik agar mereka berubah pikiran dan tetap berlangganan.
8 Check model performance menggunakan ROC/AUC
confusion matrix bukanlah satu2nya tolak ukur seberapa bagus hasil prediksi kita. kita juga bisa menggunakan metode ROC/AUC
pred_prob <- predict(model_churn, newdata = test_telco, type = "raw")
head(pred_prob)## No Yes
## [1,] 0.01859689 0.98140311214
## [2,] 0.01210249 0.98789751042
## [3,] 0.98862580 0.01137420474
## [4,] 0.64040070 0.35959929672
## [5,] 0.99998951 0.00001049235
## [6,] 0.99688800 0.00311200047pred_rocr <- prediction(predictions = pred_prob[,2],
labels = as.numeric(ifelse(test = test_telco$Churn == "Yes", 1, 0)))
perf <- performance(prediction.obj = pred_rocr, measure = "tpr", x.measure = "fpr")plot(perf)
auc <- performance(pred_rocr, "auc")
auc@y.values## [[1]]
## [1] 0.8390594kita mendapatkan hasil ROC/AUC values sebesar 83.9 %. sehingga bisa disimpulkan kalau model bisa memprediksi dengan baik.
9 Modelling dengan metode Decision tree
kita akan membuat model prediksi baru dengan menggunakan metode decision tree.
model_churn_tree <- rpart(formula = Churn ~ ., data = train_telco, method = "class")kita akan mencoba melihat visual dari decision tree yang sudah kita buat.
fancyRpartPlot(model_churn_tree, sub = NULL)
10 Predict Decision Tree
dengan menggunakan model churn tree, kita akan melakukan prediksi
pred_tree <- predict(model_churn_tree, newdata = test_telco, type = "class")
train_tree <- predict(model_churn_tree, newdata = train_telco, type = "class")
pred_tree_prob <- predict(model_churn_tree, newdata = test_telco, type = "prob")kita memakai type = response yang hasilnya memberikan hasil kategori
11 Check Model Performance dengan confusion matrix (model decision tree)
confusionMatrix(pred_tree, reference = test_telco$Churn, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1453 335
## Yes 101 221
##
## Accuracy : 0.7934
## 95% CI : (0.7754, 0.8105)
## No Information Rate : 0.7365
## P-Value [Acc > NIR] : 0.0000000007023
##
## Kappa : 0.3844
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.3975
## Specificity : 0.9350
## Pos Pred Value : 0.6863
## Neg Pred Value : 0.8126
## Prevalence : 0.2635
## Detection Rate : 0.1047
## Detection Prevalence : 0.1526
## Balanced Accuracy : 0.6662
##
## 'Positive' Class : Yes
## confusionMatrix(train_tree, reference = train_telco$Churn, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3354 777
## Yes 255 536
##
## Accuracy : 0.7903
## 95% CI : (0.7787, 0.8016)
## No Information Rate : 0.7332
## P-Value [Acc > NIR] : < 0.00000000000000022
##
## Kappa : 0.3864
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.4082
## Specificity : 0.9293
## Pos Pred Value : 0.6776
## Neg Pred Value : 0.8119
## Prevalence : 0.2668
## Detection Rate : 0.1089
## Detection Prevalence : 0.1607
## Balanced Accuracy : 0.6688
##
## 'Positive' Class : Yes
## kenapa mengevaluasi 2 model? karena kita ingin melihat apakah model yang kita buat mengalami overfitting/underfitting.
overfitting = kondisi model bagus pada data train tapi tidak bagus pada data test
underfitting = kondisi model tidak bagus saat data train dan tidak bagus pada data test
dengan evaluasi model yang kita lakukan. kita tidak mendapati model mengalami underfitting atau overfitting.
hasil metrics recall data train = 40%. data test = 39%
hasil metrics specifity data train = 92%. data test = 93%
12 Check model decision tree performance dengan ROC/AUC
selanjutnya kita akan memakai metode ROC/AUC untuk evaluasi model decision tree
pred_rocr_tree <- prediction(predictions = pred_tree_prob[,2],
labels = as.numeric(ifelse(test = test_telco$Churn == "Yes", 1, 0)))
perf_tree <- performance(prediction.obj = pred_rocr_tree, measure = "tpr", x.measure = "fpr")
plot(perf_tree)
auc <- performance(pred_rocr_tree, "auc")
auc@y.values## [[1]]
## [1] 0.7993418kita mendapatkan hasil dimana ROC/AUV value sebesar 79.9 %. hasil dari model sangatlah baik untuk memprediksi apakah seorang pelanggan akan Churn atau tidak
13 Model Random Forest
Sebelum membuat model Random forest, kita akan membuat beberapa setting
set.seed(417)
ctrl <- trainControl(method = "repeatedcv", number = 5, repeats = 3)- repeatedcv = memakai k-fold
- number = banyaknya fold/lipatan
- repeats = berapa kali k-fold diulang/dilakukan
setelah setting sudah selesai. kita akan membuat model random forest
# Run this code at your own risk. ini adalah proses pembuatan model
#churn_forest <- train(Churn~., data = train_telco, method = "rf", trControl= ctrl)membuat model Random forest membutuhkan waktu yang lama. sehingga ketika modelnya sudah selesai terbentuk. alangkah baiknya kita menyimpan model agar tidak perlu run lagi.
#saveRDS(object = churn_forest ,file = "Churn_forest")dengan begini file model random forest sudah kita simpan dan jika kita memerlukan model ini. kita cuma perlu untuk read model dengan cara dibawah ini.
#jangan dirun. hanya berupa contoh. run jika model belum ada di environment
churn_forest <- readRDS("Churn_forest")model random forest sudah terbentuk. sudah waktunya kita melakukan inspeksi model
churn_forest # output model## Random Forest
##
## 4922 samples
## 19 predictor
## 2 classes: 'No', 'Yes'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times)
## Summary of sample sizes: 3939, 3938, 3937, 3937, 3937, 3937, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.7973036 0.4198082
## 12 0.7873492 0.4158763
## 23 0.7856562 0.4117107
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.churn_forest$finalModel #model final yang dihasilkan##
## Call:
## randomForest(x = x, y = y, mtry = min(param$mtry, ncol(x)))
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 20.76%
## Confusion matrix:
## No Yes class.error
## No 3325 284 0.07869216
## Yes 738 575 0.56207159plot(churn_forest) # visualisasi model
mtry = jumlah prediktor/ nodes pada pohon
OOB error rate = 20.76%, artinya prediksi ke data-data yang belum terambil, ketika diprediksi hasilnya terdapat error sebesar 20.76%.
Berikut adalah prediktor yang penting dari hasil model Random forest
varImp(churn_forest) # melihat prediktor yang penting## rf variable importance
##
## only 20 most important variables shown (out of 23)
##
## Overall
## tenure 100.000
## TotalCharges 88.083
## MonthlyCharges 77.227
## InternetServiceFiber optic 42.345
## PaymentMethodElectronic check 31.004
## ContractTwo year 30.139
## ContractOne year 16.730
## OnlineSecurityYes 15.736
## InternetServiceNo 15.468
## PaperlessBillingYes 13.465
## TechSupportYes 12.977
## SeniorCitizenYes 9.615
## OnlineBackupYes 7.720
## PartnerYes 7.323
## DependentsYes 6.794
## DeviceProtectionYes 5.829
## MultipleLinesYes 5.434
## StreamingMoviesYes 5.246
## genderMale 5.145
## StreamingTVYes 5.10214 Predict dan Evaluasi model Random forest
pred_forest <- predict(churn_forest, newdata = test_telco)
pred_train_forest <- predict(churn_forest, newdata = train_telco)kita membuat 2 prediction agar kita bisa melihat hasil dari model mengalami overfitting atau tidak.
confusionMatrix(pred_forest, reference = test_telco$Churn)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 1430 300
## Yes 124 256
##
## Accuracy : 0.7991
## 95% CI : (0.7813, 0.816)
## No Information Rate : 0.7365
## P-Value [Acc > NIR] : 0.00000000001171
##
## Kappa : 0.4237
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.9202
## Specificity : 0.4604
## Pos Pred Value : 0.8266
## Neg Pred Value : 0.6737
## Prevalence : 0.7365
## Detection Rate : 0.6777
## Detection Prevalence : 0.8199
## Balanced Accuracy : 0.6903
##
## 'Positive' Class : No
## confusionMatrix(pred_train_forest, reference = train_telco$Churn)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3430 555
## Yes 179 758
##
## Accuracy : 0.8509
## 95% CI : (0.8406, 0.8607)
## No Information Rate : 0.7332
## P-Value [Acc > NIR] : < 0.00000000000000022
##
## Kappa : 0.5806
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.9504
## Specificity : 0.5773
## Pos Pred Value : 0.8607
## Neg Pred Value : 0.8090
## Prevalence : 0.7332
## Detection Rate : 0.6969
## Detection Prevalence : 0.8096
## Balanced Accuracy : 0.7639
##
## 'Positive' Class : No
## kita menggunakan metrics sensitivity/recall dan specifity.
berikut adalah hasil prediksi model.
recall pada data_train = 95% dan data_test = 92%
specifity data train = 57% dan data test = 46%
15 Conclusion
kita sudah membuat 3 model dan model manakah yang akan kita pilih?
- model Naive Bayes memberikan hasil yang seimbang dengan nilai ROC/AUC = 83.9%.
- mengunakan model decision tree untuk metric specifity dengan nilai 93% atau nilai ROC/AUC = 79.9%
- model random forest dengan nilai recall yang tinggi dengan nilai 92% pada data test.
Kita sudah membuat model dan setiap model memiliki kelebihan dan kekurangan masing-masing. semua model memberikan hasil yang bagus dalam memprediksi apakah pelanggan akan Churn atau tidak. kalau kita fokus pada pelanggan yang akan tetap berlangganan, kita fokus pada model random forest yang memberikan nilai 92%. kalau kita fokus kepada pelanggan yang akan berhenti, kita bisa memakai model decision tree yang memberikan nilai 91%.
semua tetap bergantung kepada pihak perusahaan untuk memakai model mana yang lebih sesuai dengan kepentingan perusahaan.
sekian untuk report yang saya buat. semoga report ini bermanfaat untuk para pembaca