Halo Semua!
Pernahkah kamu mendapatkan SMS penting tapi kamu tidak melihatnya karena banyaknya SMS Spam yang masuk sehingga SMS yang penting tertumpuk tidak terlihat?
Pada project kali ini kami akan membuat SMS Classification antara Spam dan Ham, sehingga pada nantinya kita akan membuat model yang bisa mengklasifikasikan Spam-Ham dengan akurasi yang baik agar nantinya SMS penting kamu tidak akan terlewat untuk dilihat dan dibaca.
Untuk dataset kali ini diberikan langsung oleh Team dari Algoritma untuk kebutuhan education
Mari kita load dahulu semua library yang dibutuhkan
library(dplyr)
library(caret)
library(e1071)
library(rsample)
library(partykit)
library(randomForest)
library(readr)
library(tm) # For Text Mining
library(stopwords)
library(ROCR)
library(lime)
library(ggplot2)
library(lubridate)
library(tidyr)
library(tibble)
library(wordcloud)
Mari kita load data yang dibutuhkan untuk analisa.
<- read.csv("data/data-train.csv")
sms tail(sms)
Data Train terdiri dari kolom dibawah ini:
Mari kita cek tipe data tiap kolom untuk tiap dataset
glimpse(sms)
#> Rows: 2,004
#> Columns: 3
#> $ datetime <chr> "2017-02-15T14:48:00Z", "2017-02-15T15:24:00Z", "2017-02-15T1~
#> $ text <chr> "Telegram code 53784", "Rezeki Nomplok Dompetku Pengiriman Ua~
#> $ status <chr> "ham", "spam", "ham", "ham", "ham", "ham", "ham", "spam", "sp~
Setelah kita cek, ada tipe data yang harus diubah
<- sms %>%
sms mutate(status = as.factor(status),
datetime = as.Date(datetime))
Mari kita cek proporsi setiap label target
prop.table(table(sms$status))
#>
#> ham spam
#> 0.5798403 0.4201597
Kita bisa simpulkan bahwa target label kita memiliki proposi yang balance
Mari kita lihat plot distribusi data untuk melihat distribusi jumlah SMS based on waktu tiap jam nya dengan menggunakan package ggplot dengan geom_col (histogram) dimana sebelumnya dilakukan grouping data oleh hour dan sum total spam dan ham
<- read.csv("data/data-train.csv")
sms_original %>%
sms_original mutate(datetime = ymd_hms(datetime),
hour= hour(datetime)) %>%
mutate(hour=as.factor(hour)) %>%
group_by(hour) %>%
summarise(
spam = sum(ifelse(status == "spam", 1, 0)),
ham = sum(ifelse(status == "spam", 0, 1)),
%>%
) ungroup() %>%
pivot_longer(
cols=c(ham, spam)
%>%
) ggplot(
aes(
x=hour,
y=value,
fill=name
)+
) geom_col(
stat="identity"
+
) scale_fill_manual(values=c("blue", "orange"))
Dari plot diatas jumlah SMS secara bertahap meningkat dari pagi dan puncaknya pada jam 9 AM dan terendah pada jam 4 AM.
Dari data label target kita dibagi menjadi dua kategori, spam dan ham(not spam)
%>%
sms filter(status == "spam") %>%
tail()
Dari data yang terlihat diatas, text yang berhubungan dengan spam biasanya bersifat promosional. Kata/token yang digunakan seperti “gratis”, "bonus.
mari kita visualisasikan dengan menggunakan wordcloud kata apa saja yang paling banyak muncul di dataset yang termasuk dalam status spam
<- subset(sms, status == "spam")
jenisspam wordcloud(jenisspam$text, max.words = 60, colors = brewer.pal(5, "Dark2"), random.order = FALSE)
Kata yang paling banyak muncul diantaranya adalah “pulsa”,“kuota”, “info”, “paket”. Kita akan analisa nanti lebih lanjut pada saat prediction apakah kata-kata ini masuk false prediction atau tidak
%>%
sms filter(status == "ham") %>%
tail()
Dari data yang terlihat diatas, text yang ham berhubungan dengan code verification number atau provider information atau usual conversation. Kata/token yang digunankan seperti “code”, “dimana”, “saya”, “anda”, “pak”
mari kita visualisasikan dengan menggunakan wordcloud kata apa saja yang paling banyak muncul di dataset yang termasuk dalam status ham
<- subset(sms, status == "ham")
jenisspam wordcloud(jenisspam$text, max.words = 60, colors = brewer.pal(5, "Dark2"), random.order = FALSE)
Kata yang paling banyak muncul diantaranya adalah “atau”,“saya”, “pak”, “anda”.
Salah satu tahapan paling penting dalam proses ini adalah Text Cleansing. Kenapa kita harus melakukan text cleaning/cleansing? text yang buruk akan menyebabkan hasil yang buruk. Ungkapan “garbage in, garbage out” sudah sangat dikenal di dalam dunia Data Science. Komputer bukanlah ahli segalanya, mereka adalah mesin yang melakukan perhitungan dengan sangat cepat. Mereka tidak memiliki wawasan atau intuisi, mereka juga tidak memiliki kecerdasan atau perasaan Untuk menentukan mana yang masuk akal dan mana yang tidak
Untuk menghasilkan output yang di inginkan, kita harus mencegah kesalahan input data dan masalah yang akan mengacaukan algoritma . Pembersihan text (text cleaning/cleansing) adalah cara untuk melakukan hal ini. Pembersihan data adalah aspek analisis data yang memakan waktu cukup lama dan wajib untuk dilakukan sebelum data tersebut diolah.
Berikut beberapa hal yang dilakukan pada proses Text cleansing:
VCorpus()
dari package ‘tm’ yang umum digunakan untuk text mining<- sms %>%
sms.corpus # Convert to corpus
VectorSource() %>%
VCorpus()
<- sms.corpus %>%
sms.corpus tm_map(content_transformer(tolower)) %>%
tm_map(removeNumbers) %>%
tm_map(removeWords, stopwords("id", source="stopwords-iso")) %>%
tm_map(removePunctuation) %>%
tm_map(function(x) { stemDocument(x, language="indonesian") }) %>%
tm_map(stripWhitespace)
Setelah pembersihan, langkah terakhir adalah untuk membagi pesan teks ini menjadi kata-kata individual melalui tokenization, elemen kata tunggal. Untuk melakukan ini, Document Term Matrix (DTM) dibuat. DTM adalah yang berisi kolom dari semua kata dan frekuensi di setiap SMS. Hasil dari ini adalah berupa matrix, di mana sebagian besar entri diisi dengan nol.
<- sms.corpus %>%
sms.dtm DocumentTermMatrix()
sms.dtm
#> <<DocumentTermMatrix (documents: 3, terms: 2827)>>
#> Non-/sparse entries: 2828/5653
#> Sparsity : 67%
#> Maximal term length: 79
#> Weighting : term frequency (tf)
Dengan melihat kata yang muncul setidaknya minimal 20 sms, kita bisa mendapatkan kandidat prediktor yang paling berpengaruh sehingga kita bisa menghemat waktu untuk training model kita.
<- findFreqTerms(sms.dtm, lowfreq = 20)
sms.freq
<- sms.dtm[,sms.freq] sms.dtm
Nilai pada matrix masih berupa nilai frekuensi. Untuk perhitungan peluang, frekuensi akan diubah menjadi hanya kondisi muncul (1) atau tidak (0). Salah satu caranya dengan menggunakan Bernoulli Converter.
Kita dapat membuat fungsi DIY Bernoulli Converter:
<- function(x) {
bernoulli_conv <- as.factor(ifelse(x > 0, 1, 0))
x return(x)
}
bernoulli_conv(c(0,1,3))
#> [1] 0 1 1
#> Levels: 0 1
Mari kita aplikasikan ke data kita
<- sms.dtm %>%
sms.dtm apply(MARGIN = 2, FUN = bernoulli_conv)
1:3, 1:20] sms.dtm[
#> Terms
#> Docs aja aks aktif aktifkan aplikasi app aspen axi axisnet ayo bala bank beba
#> 1 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 2 "1" "1" "1" "1" "1" "1" "1" "1" "1" "1" "1" "1" "1"
#> 3 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> Terms
#> Docs beli berhasil berita berlaku bersifat biaya blm
#> 1 "0" "0" "0" "0" "0" "0" "0"
#> 2 "1" "1" "1" "1" "1" "1" "1"
#> 3 "0" "0" "0" "0" "0" "0" "0"
Data sekarang sudah clean dan based on Term Frequency (TF) - Inverse Document Frequency (IDF)
Dari semua data persiapan yang sudah dibuat, kita summarise semua dalam 1 function
<- function(x, is_bernoulli = TRUE) {
tokenize_text <- x %>%
data_dtm # Convert to corpus
VectorSource() %>%
VCorpus() %>%
# text cleaning
tm_map(content_transformer(tolower)) %>%
tm_map(removeNumbers) %>%
tm_map(removeWords, stopwords("id", source="stopwords-iso")) %>%
tm_map(removePunctuation) %>%
tm_map(stemDocument) %>%
tm_map(stripWhitespace) %>%
# Convert DTM
DocumentTermMatrix()
<- findFreqTerms(data_dtm, lowfreq = 20)
data_freq
if (is_bernoulli) {
%>%
data_dtm[,data_freq] apply(MARGIN = 2, FUN = bernoulli_conv) %>%
return()
else {
} %>%
data_dtm[,data_freq] return()
} }
Setelah data cleaning, data train kita split untuk train dan validation. Kita split 75% training data dan 25% validation data
set.seed(100)
<- sample(nrow(sms), nrow(sms)*0.75)
index
<- tokenize_text(sms$text)
sms_clean
<- sms_clean[index,]
data_train_clean <- sms_clean[-index,]
data_test_clean
<- sms[index, "status"]
label_train <- sms[-index, "status"] label_test
Data train dan test ini akan kita gunakan nanti untuk interpretasi model
<- sms[index,]
data_train <- sms[-index,] data_test
Untuk project ini kita akan bandingkan 2 model yaitu Naive Bayes dan Random Forest
Mari kita buat model nya dengan menggunakan data yang sudah clean
<- naiveBayes(
model_nb x = data_train_clean,
y = label_train,
laplace = 1
)
Untuk perbandingan akan kita gunakan model random forest. Training Random Forest membutuhkan waktu yang lama, jadi lebih baik kita simpan modelnya dalam bentuk RDS file setelah model dibuat
#set.seed(100)
#ctrl <- trainControl(method="repeatedcv", number = 5, repeats = 3)
#model_forest <- train(
# x = data_train_clean,
# y = label_train,
# method = "rf",
# trControl = ctrl
#)
#saveRDS(model_forest, "spam_forest_3.RDS") # save model
Mari kita load model random forest kita
<- readRDS("spam_forest_3.RDS") model_forest
Mari kita evaluasi model yang sudah kita buat dengan menggunakan confusion matrix. Tapi sebelumnya kita buat terlebih dahulu prediction nya
<- predict(model_nb, newdata = data_test_clean, type="class")
sms_pred_naive head(sms_pred_naive)
#> [1] ham spam spam spam spam ham
#> Levels: ham spam
<- predict(model_forest, newdata = data_test_clean, type="raw")
sms_pred_rf head(sms_pred_rf)
#> [1] ham spam spam spam spam ham
#> Levels: ham spam
Mari kita buat confusion matrix nya.
Untuk case sms classification, Metric yang paling penting untuk mengukur performa model adalah Accuracy, karena dengan Accuracy kita fokus pada 2 value yaitu Positif value (Spam) dan Negative value (Ham). Kenapa kita harus fokus kepada 2 value ini, karena kebanyakan orang tidak mau ada sms penting (ham) yang terlewat, tapi mereka juga mau membuang semua sms spam.
confusionMatrix(data = sms_pred_naive, reference = label_test, positive = "spam")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction ham spam
#> ham 257 16
#> spam 25 203
#>
#> Accuracy : 0.9182
#> 95% CI : (0.8906, 0.9406)
#> No Information Rate : 0.5629
#> P-Value [Acc > NIR] : <0.0000000000000002
#>
#> Kappa : 0.8345
#>
#> Mcnemar's Test P-Value : 0.2115
#>
#> Sensitivity : 0.9269
#> Specificity : 0.9113
#> Pos Pred Value : 0.8904
#> Neg Pred Value : 0.9414
#> Prevalence : 0.4371
#> Detection Rate : 0.4052
#> Detection Prevalence : 0.4551
#> Balanced Accuracy : 0.9191
#>
#> 'Positive' Class : spam
#>
Jika kita melihat hasil confusion matrix diatas, kita mendapatkan accuracy 91,22%. Hasil ini menunjukkan kalau Naive Bayes model cukup akurat
confusionMatrix(data = sms_pred_rf, reference = label_test, positive = "spam")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction ham spam
#> ham 276 2
#> spam 6 217
#>
#> Accuracy : 0.984
#> 95% CI : (0.9688, 0.9931)
#> No Information Rate : 0.5629
#> P-Value [Acc > NIR] : <0.0000000000000002
#>
#> Kappa : 0.9676
#>
#> Mcnemar's Test P-Value : 0.2888
#>
#> Sensitivity : 0.9909
#> Specificity : 0.9787
#> Pos Pred Value : 0.9731
#> Neg Pred Value : 0.9928
#> Prevalence : 0.4371
#> Detection Rate : 0.4331
#> Detection Prevalence : 0.4451
#> Balanced Accuracy : 0.9848
#>
#> 'Positive' Class : spam
#>
Walaupun Accuracy dari Naive bayes sudah cukup tinggi memprediksi data test, Ternyata Model Random Forest kita memberikan accuracy yang lebih tinggi yaitu 95,81%
Mari kita lihat apa yang salah dari model kita. Karena model Random Forest yang hasil accuracy nya paling tinggi, kita akan fokus hanya pada Random Forest.
<- data_test %>%
pred.false mutate(
pred.rf = sms_pred_rf,
%>%
) filter(pred.rf != status)
%>% select(-datetime) %>% filter(pred.rf == "spam") pred.false
Dari yang terlihat diatas, banyak missclassified dari text ham adalah dari internet provider yang menginformasikan hal seperti sisa data usage. Ini bisa terjadi karena provider internet sering mengirimkan sms promosi yang berisi kata “pulsa”, “kuota” atau “paket” yang biasa digunakan untuk memberikan informasi ke user tentang sisa data usage atau hal-hal penting lainnya.
Ada dua metode yang digunakan untuk interpretasi model-model kita. Untuk random forest menggunakan Variabel Importance sementara untuk Naive Bayes menggunakan LIME
Variable importance membantu kita untuk melihat variable mana yang memberikan kontribusi lebih
::varImp(model_forest, 20)$importance %>%
caretas.data.frame() %>%
rownames_to_column() %>%
arrange(-Overall) %>%
mutate(rowname = forcats::fct_inorder(rowname))
Variable atau kata yang paling memberikan kontribusi adalah “info”
Local Interpretable Model-agnostic Explanation (LIME) digunakan untuk menginterpretasi naive bayes model
Perbedann antara LIME dan interpretable machine learning model lain seperti decision tree, bahwa LIME bisa diaplikasikan di banyak model namun menjelaskan feature role berdasarkan model prediction di sample data. Sementara interpretable machine learning model lain hanya bisa diaplikasikan spesifik di model nya sendiri saja seperti Variable Importance di random forest yang hanya bisa menjelaskan kontribusi fitur di random forest model saja.
Karena LIME tidak support naive bayes model dari package “e1071”, kita harus membuat function baru dari naive bayes
<- function(x){
model_type.naiveBayes return("classification")
}
Kita juga harus membuat function untuk menyimpan prediksinya
<- function(x, newdata, type = "raw") {
predict_model.naiveBayes <- predict(x, newdata, type = "raw") %>% as.data.frame()
res return(res)
}
Sekarang kita siapkan input untuk LIME
<- data_train$text %>% as.character()
text_train <- data_test$text
text_test
<- lime(
explainer
text_train,model=model_nb,
preprocess=tokenize_text
)
Sekarang kita akan mencoba menjelaskan bagaimana model kita bekerja pada test dataset. Kita akan observasi interpretasi dari data ke 1 sampai ke 5 dari observasi data test. Kita akan menggunakan 5 fitur untuk menjelaskan model nya.
set.seed(100)
<- explain(
explanation 1:5],
text_test[explainer = explainer,
n_labels = 1, # show only 1 label (recommend or not recommend)
n_features = 5,
feature_select = "none", # use all terms to explain the model
single_explanation = F
)
Berikut visualisasi nya
plot_text_explanations(explanation)
Dari hasil diatas, kita lihat pada observasi ke tiga , probability untuk menjadi ham adalah 99.8%. Dari hasil explainer fit nya / The Explanation fit menunjukkan betapa bagusnya LIME untuk interpretasi prediksi pada observasi ini, yaitu 77%/mendekati 80% yang artinya cukup akurat.
Text yang diberi label biru pada observasi ke tiga artinya bahwa text tersebut meningkatkan probablity untuk menjadi spam, dengan kata yang paling memberikan infuence adalah “Promo” dan “Berlaku”
Text yang diberi label merah artinya text tersebut menurunkan probability untuk menajadi ham, seperti “offer dan”disc"
Mari kita aplikasikan model kita ke submission data. Kita akan menggunakan model random forest karena lebih robust dan lebih akurat dibanding naive bayes
Mari kita import submission data
<- read.csv("data/data-test.csv")
submission head(submission)
Karena kita sudah membuat function Tokenize_test sebelumnya. Bisa diaplikasikan ke submission data
<- tokenize_text(submission$text)
submission.clean 1:5,1:10] submission.clean[
#> Terms
#> Docs aplikasi axi axisnet bala beli berlaku bonus bronet dgn diblokir
#> 1 "0" "0" "0" "0" "1" "0" "0" "0" "1" "0"
#> 2 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 3 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 4 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 5 "0" "0" "0" "0" "0" "0" "1" "0" "0" "0"
Karena random forest mengharuskan menggunakan predictor yang sama, kita butuh untuk memotong predictor kita agar sama dengan data train.
<- function(x, train_data) {
trimRfPredictor %>%
x as.data.frame() %>%
fncols(colnames(train_data)) %>%
select(colnames(train_data)) %>%
mutate_all(as.factor) %>%
as.matrix.data.frame() %>%
return()
}
Kita juga membutuhkan function baru untuk menambahkan kolom yang match dengan predictor data training.
<- function(data, cname) {
fncols <-cname[!cname%in%names(data)]
add
if(length(add)!=0) data[add] <- as.factor("0")
data }
<- trimRfPredictor(submission.clean, data_train_clean)
submission.clean.df 1:5,1:20] submission.clean.df[
#> aja aks aktif aktifkan aplikasi app aspen axi axisnet ayo bala bank beba beli
#> 1 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "1"
#> 2 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 3 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 4 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> 5 "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"
#> berhasil berita berlaku bersifat biaya blm
#> 1 "0" "0" "0" "0" "0" "0"
#> 2 "0" "0" "0" "0" "0" "0"
#> 3 "0" "0" "0" "0" "0" "0"
#> 4 "0" "0" "0" "0" "0" "0"
#> 5 "0" "0" "0" "0" "0" "0"
setelah kita melakukan data cleaning, mari kita predict dan simpan hasilnya
<- submission %>%
submission.nb select(datetime)
$status <- predict(model_nb, newdata = submission.clean.df, type="class")
submission.nb
head(submission.nb)
write.csv(submission.nb, "data/submission_nb.csv")
<- submission %>%
submission.rf select(datetime)
$status <- predict(model_forest, newdata = submission.clean.df, type="raw")
submission.rf
head(submission.rf)
write.csv(submission.rf, "data/submission_rf_3.csv")
Beberapa hal bisa disimpulkan dari project ini :