Introduction

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

Load Library

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)

Load Data

Mari kita load data yang dibutuhkan untuk analisa.

sms <- read.csv("data/data-train.csv")
tail(sms)

Data Train terdiri dari kolom dibawah ini:

  • datetime: Tanggal SMS,
  • text: Isi teks dari SMS,
  • status: Label Spam/Ham dari tiap SMS.

Data Wrangling

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))

Exploratory Data Analysis (EDA)

Proporsi Target

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

Visualisasi Distribusi Label

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

sms_original <- read.csv("data/data-train.csv")
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.

Data Characteristic

Dari data label target kita dibagi menjadi dua kategori, spam dan ham(not spam)

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

jenisspam <- subset(sms, status == "spam")
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

Ham

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

jenisspam <- subset(sms, status == "ham")
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”.

Data Pre-processing

Text Cleansing

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:

  • Mengubah kolom berisi data teks menjadi corpus menggunakan function VCorpus() dari package ‘tm’ yang umum digunakan untuk text mining
  • Menghapus angka
  • Mengubah seluruh teks menjadi lowercase
  • Menghapus stopwords (stopwords adalah kata yang dianggap tidak penting (umumnya kata bantu) dalam klasifikasi teks)
  • Menghapus simbol/punctuation termasuk emoticons sesuai pattern (contoh: “@”, “-”, “?”, “.” ,“/”)
  • Menghapus Imbuhan/Stemming. Opsional: lemmatization: menghapus imbuhan dan mengubah tenses kata menjadi kata dasar (contoh: eating -> eat, eats -> eat)
  • Menghapus spasi berlebih (whitespace)
sms.corpus <- sms %>% 
   # 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)

Document-Term Matrix (DTM)

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.dtm <- sms.corpus %>% 
   DocumentTermMatrix()

sms.dtm
#> <<DocumentTermMatrix (documents: 3, terms: 2827)>>
#> Non-/sparse entries: 2828/5653
#> Sparsity           : 67%
#> Maximal term length: 79
#> Weighting          : term frequency (tf)

Frequence Terms

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.

sms.freq <- findFreqTerms(sms.dtm, lowfreq = 20)

sms.dtm <- sms.dtm[,sms.freq]

Bernoulli Converter

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:

  • jika jumlah kata yang muncul >= 1 (muncul) = 1
  • jika jumlah kata yang muncul 0 ( tidak muncul) = 0
bernoulli_conv <- function(x) {
  x <- as.factor(ifelse(x > 0, 1, 0))
  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)

sms.dtm[1:3, 1:20]
#>     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)

Text Tokenize Function

Dari semua data persiapan yang sudah dibuat, kita summarise semua dalam 1 function

tokenize_text <- function(x, is_bernoulli = TRUE) {
   data_dtm <- x %>% 
      # 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()
   
   data_freq <- findFreqTerms(data_dtm, lowfreq = 20)

   if (is_bernoulli) {
      data_dtm[,data_freq] %>% 
         apply(MARGIN = 2, FUN = bernoulli_conv) %>% 
         return()
   } else {
      data_dtm[,data_freq] %>% 
         return()
   }
}

Cross Validation

Setelah data cleaning, data train kita split untuk train dan validation. Kita split 75% training data dan 25% validation data

set.seed(100)

index <- sample(nrow(sms), nrow(sms)*0.75)

sms_clean <- tokenize_text(sms$text)

data_train_clean <- sms_clean[index,]
data_test_clean <- sms_clean[-index,]

label_train <- sms[index, "status"]
label_test <- sms[-index, "status"]

Data train dan test ini akan kita gunakan nanti untuk interpretasi model

data_train <- sms[index,]
data_test <- sms[-index,]

Model Fitting

Untuk project ini kita akan bandingkan 2 model yaitu Naive Bayes dan Random Forest

Naive Bayes

Mari kita buat model nya dengan menggunakan data yang sudah clean

model_nb <- naiveBayes(
   x = data_train_clean, 
   y = label_train,
   laplace = 1
)

Random Forest

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

model_forest <- readRDS("spam_forest_3.RDS")

Model Evaluation

Mari kita evaluasi model yang sudah kita buat dengan menggunakan confusion matrix. Tapi sebelumnya kita buat terlebih dahulu prediction nya

Prediction

Naive Bayes

sms_pred_naive <- predict(model_nb, newdata = data_test_clean, type="class")
head(sms_pred_naive)
#> [1] ham  spam spam spam spam ham 
#> Levels: ham spam

Random Forest

sms_pred_rf <- predict(model_forest, newdata = data_test_clean, type="raw")
head(sms_pred_rf)
#> [1] ham  spam spam spam spam ham 
#> Levels: ham spam

Confusion Matrix

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.

Naive Bayes

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

Random Forest

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%

False Prediction

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.

pred.false <- data_test %>% 
   mutate(
      pred.rf = sms_pred_rf,
   ) %>% 
   filter(pred.rf != status)
pred.false %>% select(-datetime) %>% filter(pred.rf == "spam")

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.

Model Interpretation

Ada dua metode yang digunakan untuk interpretasi model-model kita. Untuk random forest menggunakan Variabel Importance sementara untuk Naive Bayes menggunakan LIME

Variable Importance

Variable importance membantu kita untuk melihat variable mana yang memberikan kontribusi lebih

caret::varImp(model_forest, 20)$importance %>% 
   as.data.frame() %>%
   rownames_to_column() %>%
   arrange(-Overall) %>%
   mutate(rowname = forcats::fct_inorder(rowname))  

Variable atau kata yang paling memberikan kontribusi adalah “info”

LIME

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

model_type.naiveBayes <- function(x){
  return("classification")
}

Kita juga harus membuat function untuk menyimpan prediksinya

predict_model.naiveBayes <- function(x, newdata, type = "raw") {
    res <- predict(x, newdata, type = "raw") %>% as.data.frame()
    return(res)
}

Sekarang kita siapkan input untuk LIME

text_train <- data_train$text %>% as.character()
text_test <- data_test$text

explainer <- lime(
   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)
explanation <- explain(
   text_test[1:5],
   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"

Submission

Mari kita aplikasikan model kita ke submission data. Kita akan menggunakan model random forest karena lebih robust dan lebih akurat dibanding naive bayes

Import Data

Mari kita import submission data

submission <- read.csv("data/data-test.csv")
head(submission)

Text Cleaning

Karena kita sudah membuat function Tokenize_test sebelumnya. Bisa diaplikasikan ke submission data

submission.clean <- tokenize_text(submission$text)
submission.clean[1:5,1:10]
#>     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"

Optimize Data

Karena random forest mengharuskan menggunakan predictor yang sama, kita butuh untuk memotong predictor kita agar sama dengan data train.

trimRfPredictor <- function(x, train_data) {
   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.

fncols <- function(data, cname) {
  add <-cname[!cname%in%names(data)]

  if(length(add)!=0) data[add] <- as.factor("0")
  data
}
submission.clean.df <- trimRfPredictor(submission.clean, data_train_clean)
submission.clean.df[1:5,1:20]
#>   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"

Predict Submission

setelah kita melakukan data cleaning, mari kita predict dan simpan hasilnya

Naive Bayes

submission.nb <- submission %>% 
   select(datetime)
submission.nb$status <- predict(model_nb, newdata = submission.clean.df, type="class")

head(submission.nb)
write.csv(submission.nb, "data/submission_nb.csv")

Random Forest

submission.rf <- submission %>% 
   select(datetime)
submission.rf$status <- predict(model_forest, newdata = submission.clean.df, type="raw")

head(submission.rf)
write.csv(submission.rf, "data/submission_rf_3.csv")

Submission Result

Conclusion

Beberapa hal bisa disimpulkan dari project ini :

  • Tujuan/Goal dari project ini adalah mengklasifikasikan sms apakah itu spam atau ham. Hasilnya adalah kita bisa melakukan klasifikasi tersebut dengan menggunakan beberapa model machine learning baik dengan test/validasi dataset atau submission dataset yang menghasilkan accuracy yang sangat baik > 80% . Hasil Metric lainnya pun sangat baik (Sensitivity/recall > 80%, Specificity > 85%, Precision > 90%)
  • Model machine learning yang dilakukan test adalah Random Forest dan naive bayes. Model yang dipilih adalah Random forest karena menghasilkan accuracy yang lebih baik dibandingkan Naive Bayes
  • Hal ini membuktikan bahwa problem klasifikasi seperti ini bisa diselesaikan dengan machine learning
  • Untuk project ini bisa diimplementasikan di kehidupan sehari hari dan memiliki potensial business seperti SMS Spam filter atau Email Spam filter, dll