Home work ML CL2
Michael Deng
8/25/2021
#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)read dan assign data (telcohurn.csv). Target: CHURN
telco <- read.csv("telcochurn.csv", stringsAsFactors = T)
head(telco)## X customerID gender SeniorCitizen Partner Dependents tenure PhoneService
## 1 1 7590-VHVEG Female 0 Yes No 1 No
## 2 2 5575-GNVDE Male 0 No No 34 Yes
## 3 3 3668-QPYBK Male 0 No No 2 Yes
## 4 4 7795-CFOCW Male 0 No No 45 No
## 5 5 9237-HQITU Female 0 No No 2 Yes
## 6 6 9305-CDSKC Female 0 No No 8 Yes
## MultipleLines InternetService OnlineSecurity OnlineBackup DeviceProtection
## 1 No DSL No Yes No
## 2 No DSL Yes No Yes
## 3 No DSL Yes Yes No
## 4 No DSL Yes No Yes
## 5 No Fiber optic No No No
## 6 Yes Fiber optic No No Yes
## TechSupport StreamingTV StreamingMovies Contract PaperlessBilling
## 1 No No No Month-to-month Yes
## 2 No No No One year No
## 3 No No No Month-to-month Yes
## 4 Yes No No One year No
## 5 No No No Month-to-month Yes
## 6 No Yes Yes Month-to-month Yes
## PaymentMethod MonthlyCharges TotalCharges Churn
## 1 Electronic check 29.85 29.85 No
## 2 Mailed check 56.95 1889.50 No
## 3 Mailed check 53.85 108.15 Yes
## 4 Bank transfer (automatic) 42.30 1840.75 No
## 5 Electronic check 70.70 151.65 Yes
## 6 Electronic check 99.65 820.50 YesTujuan Bisnis
Dengan data ini, kita akan memprediksi apakah seseorang akan melanjutkan langganan akan layanan yang kita berikan.
Cleaning Data
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~Hal yang bisa dibersihkan 1. data X dan Customer Id akan dihapus karena data tersebut tidak memiliki efek dalam prediksi 2. semua data type yang bersifat character akan kita ubah menjadi kategori (sudah diubah saat read data) 3. data type Int dan Num tidak akan diubah 4. list Senior Citizen akan kita ubah dari 0 dan 1 menjadi No dan Yes. kategory Int 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 0disini kita menemukan adanya Missing Value berjumlah 11 pada Total Charges, kita akan mengisi 11 NA dengan nilai rata2.
telco <- telco %>%
mutate(TotalCharges = replace_na(TotalCharges,
replace = mean(TotalCharges,
na.rm = T)))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 0dengan begini data yang akan kita gunakan sudah cocok dan tidak ada missing value.
Modelling dengan menggunakan metode Naive Bayes
kita terlebih dahulu memeriksa apakah proposi data sudah bagus (notes : target = churn)
prop.table(table(telco$Churn))##
## No Yes
## 0.7346301 0.2653699kita 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,]prop.table(table(train_telco$Churn))##
## No Yes
## 0.7375254 0.2624746prop.table(table(test_telco$Churn))##
## No Yes
## 0.7278751 0.2721249Kita akan membuat model Naive Bayes dengan menggunakan data train
model_churn <- naiveBayes(Churn~., train_telco)Predict
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")Evaluasi Model 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 1225 161
## Yes 313 414
##
## Accuracy : 0.7757
## 95% CI : (0.7573, 0.7933)
## No Information Rate : 0.7279
## P-Value [Acc > NIR] : 0.000000275330597
##
## Kappa : 0.477
##
## Mcnemar's Test P-Value : 0.000000000004043
##
## Sensitivity : 0.7200
## Specificity : 0.7965
## Pos Pred Value : 0.5695
## Neg Pred Value : 0.8838
## Prevalence : 0.2721
## Detection Rate : 0.1959
## Detection Prevalence : 0.3441
## Balanced Accuracy : 0.7582
##
## 'Positive' Class : Yes
## Metrics apa yang akan digunakan?
disini saya 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.
Check model performance menggunakan ROC/AUC
confusion matrix bukanlah satu2nya tolak ukut 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.01451274 0.985487256379
## [2,] 0.01069848 0.989301515722
## [3,] 0.99060178 0.009398220017
## [4,] 0.65902921 0.340970790609
## [5,] 0.99999234 0.000007659987
## [6,] 0.99631363 0.003686371304pred_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.8246452kita mendapatkan hasil ROC/AUC values sebesar 82%. sehingga bisa disimpulkan kalau model bisa memprediksi dengan baik.
Modelling dengan metode decision tree
kita akan membuat model prediksi baru dengan menggunakan metode decision tree.
model_churn_tree <- ctree(Churn~ ., train_telco)kita akan mencoba melihat visual dari decision tree yang sudah kita buat.
plot(model_churn_tree, type = "simple")
Predict
dengan menggunakan model churn tree, kita akan melakukan prediksi
pred_tree <- predict(model_churn_tree, newdata = test_telco, type = "response")
train_tree <- predict(model_churn_tree, newdata = train_telco, type = "response")
pred_tree_prob <- predict(model_churn_tree, newdata = test_telco, type = "prob")kita memakai type = response yang hasilnya memberikan hasil kategori
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 1306 236
## Yes 232 339
##
## Accuracy : 0.7785
## 95% CI : (0.7602, 0.7961)
## No Information Rate : 0.7279
## P-Value [Acc > NIR] : 0.00000005364
##
## Kappa : 0.4397
##
## Mcnemar's Test P-Value : 0.8897
##
## Sensitivity : 0.5896
## Specificity : 0.8492
## Pos Pred Value : 0.5937
## Neg Pred Value : 0.8470
## Prevalence : 0.2721
## Detection Rate : 0.1604
## Detection Prevalence : 0.2702
## Balanced Accuracy : 0.7194
##
## 'Positive' Class : Yes
## confusionMatrix(train_tree, reference = train_telco$Churn, positive = "Yes")## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 3139 496
## Yes 497 798
##
## Accuracy : 0.7986
## 95% CI : (0.7871, 0.8097)
## No Information Rate : 0.7375
## P-Value [Acc > NIR] : <0.0000000000000002
##
## Kappa : 0.4799
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.6167
## Specificity : 0.8633
## Pos Pred Value : 0.6162
## Neg Pred Value : 0.8635
## Prevalence : 0.2625
## Detection Rate : 0.1619
## Detection Prevalence : 0.2627
## Balanced Accuracy : 0.7400
##
## 'Positive' Class : Yes
## Check model 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.8229027kita mendapatkan hasil dimana ROC/AUV value sebesar 82%.
Conclusion (pilih algoritme yang mana yang akan digunakan, sebutkan alasannya)
disini kita mendapatkan hasil ROC/AUC untuk kedua metode adalah sama yaitu 82%. tapi disini saya lebih memilih untuk memakai metode Naive Bayes. karena model Naive bayes lebih ringan dalam komputerisasi dan memang cocok untuk kategorial. ditambah lagi decision tree cendrung overfitting jadi ada kemungkinan tidak bagus untuk data test selanjutnya.