Proporsi Target

Mari kita cek proporsi setiap label target.

prop.table(table(sms$status))

## 
##       ham      spam 
## 0.5798403 0.4201597

Kita dapat simpulkan bahwa target label kita memiliki proposi yang cukup balance.

Visualisasi Distribusi Label

Mari kita lihat plot distribusi data untuk melihat distribusi jumlah SMS berdasarkan jam SMS tersebut dikirim.

sms_hour <- sms %>% 
  mutate(jam = hour(datetime)) 

plot_hour <- ggplot(sms_hour, aes(jam, fill= status)) + 
  geom_bar() + 
  facet_wrap(~sms_hour$status)+
  xlab("Jam")+
  ylab("Jumlah") +
  ggtitle("Distribusi SMS Berdasarkan Jam")

ggplotly(plot_hour)

Dari plot diatas jumlah SMS spam banyak terjadi pada saat jam kerja yaitu dari jam 8 pagi sampai 5 sore.

Visualisasi Kata yang Paling Banyak Muncul Pada SMS

Mari kita visualisasikan dengan menggunakan wordcloud kata apa saja yang paling banyak muncul di dataset yang termasuk dalam status spam dan ham.

spam <- subset(sms, status == "spam")
wordcloud(spam$text, max.words = 250, scale = c(2, 0.4), colors = brewer.pal(8, "BrBG"), random.order = FALSE)

ham <- subset(sms, status == "ham")
wordcloud(ham$text, max.words = 250, scale = c(2, 0.4), colors = brewer.pal(8, "BrBG"), random.order = FALSE)

Text to Corpus

Corpus adalah kumpulan dari dokumen. Pada kasus ini, * Satu dokumen sama dengan satu observasi sms. * Didalam satu SMS bisa terdapat satu atau lebih kalimat.

Kita dapat menggunakan function VCorpus() dari package tm untuk membuat corpus.

sms_corpus <- VCorpus(VectorSource(sms$text))

sms_corpus[[2]]$content

## [1] "Rezeki Nomplok Dompetku Pengiriman Uang! Kirim uang di Alfamart & dptkan hadiah jutaan rupiah setiap hari.Periode s.d. 28Feb17.Info: http://bit.ly/dmpurna MFI1"

Text Cleansing

Dalam analisis teks, kita perlu mengambil informasi penting dari teks dan menghilangkan informasi yang kurang penting dalam teks. Oleh karena itu, kita perlu melakukan teks cleansing. Kita menggunakan function tm_map() dari package tm untuk melakukan text cleansing.

Berikut beberapa hal yang dilakukan pada proses Text cleansing:

• Mengubah seluruh teks menjadi lowercase
• Menghapus URL
• Menghapus angka
• 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.
• Menghapus spasi berlebih (whitespace)

# Custom function for transform corpus
transformer <- content_transformer(function(x, pattern){
  gsub(pattern, " ", x)
})

sms_corpus <- sms_corpus %>%
   tm_map(content_transformer(tolower)) %>% 
   tm_map(transformer, pattern = "(https?|ftp)://\\S+|www\\.\\S+") %>% 
   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)

Berikut merupakan salah satu item dari corpus yang telah dibersihkan.

sms_corpus[[2]]$content

## [1] "rezeki nomplok dompetku pengiriman uang kirim uang alfamart dptkan hadiah jutaan rupiah period sd febinfo mfi"

Document Term Matrix (DTM)

Kita perlu melakukan transformasi data text menjadi Document-Term Matrix (DTM) melalui proses tokenization menggunakan DocumentTermMatrix(). Tokenization adalah proses memecah satu kalimat menjadi beberapa term (bisa berupa 1 kata, pasangan kata, dll). Dalam DTM, 1 kata akan menjadi 1 prediktor dengan nilai berupa frekuensi kemunculan kata tersebut dalam sebuah dokumen.

sms_dtm <- sms_corpus %>% 
   DocumentTermMatrix()

inspect(sms_dtm)

## <<DocumentTermMatrix (documents: 2004, terms: 2753)>>
## Non-/sparse entries: 16780/5500232
## Sparsity           : 100%
## Maximal term length: 40
## Weighting          : term frequency (tf)
## Sample             :
##      Terms
## Docs  beli bonus dgn info internet kuota paket pulsa sms utk
##   193    0     0   0    0        0     0     0     0   0   0
##   197    0     0   0    0        0     0     0     0   1   0
##   225    0     0   0    0        1     0     0     0   0   0
##   29     0     0   0    0        0     0     0     0   0   0
##   378    0     0   0    0        0     0     0     0   0   0
##   409    0     0   0    0        0     0     0     0   0   0
##   410    0     1   1    2        0     0     2     2   0   0
##   903    0     0   0    0        0     0     0     0   0   0
##   953    0     0   0    0        0     0     0     0   0   0
##   955    0     0   0    0        2     0     3     2   0   0

Frequence Terms

Dengan melihat kata yang muncul setidaknya minimal 5 SMS, kita bisa mendapatkan kandidat prediktor yang paling berpengaruh sehingga kita bisa menghemat waktu untuk training model kita.

sms_freq <- findFreqTerms(sms_dtm, lowfreq = 5)

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:5, 1:20]

##     Terms
## Docs abaikan add admin aja aks aktif aktifkan akun alamat alasan all ambil andb
##    1 "0"     "0" "0"   "0" "0" "0"   "0"      "0"  "0"    "0"    "0" "0"   "0" 
##    2 "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" 
##    4 "0"     "0" "0"   "0" "0" "0"   "0"      "0"  "0"    "0"    "0" "0"   "0" 
##    5 "1"     "0" "0"   "0" "0" "0"   "0"      "1"  "0"    "0"    "0" "0"   "0" 
##     Terms
## Docs ansdr ansdri antarbank apartemen aplikasi aplikasinya apn
##    1 "0"   "0"    "0"       "0"       "0"      "0"         "0"
##    2 "0"   "0"    "0"       "0"       "0"      "0"         "0"
##    3 "0"   "0"    "0"       "0"       "0"      "0"         "0"
##    4 "0"   "0"    "0"       "0"       "0"      "0"         "0"
##    5 "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 fungsi.

tokenize_text <- function(x, is_bernoulli = TRUE) {
   data_dtm <- x %>% 
      # Convert to corpus
      VectorSource() %>% 
      VCorpus() %>% 
      
      # text cleaning
      tm_map(content_transformer(tolower)) %>% 
      tm_map(transformer, pattern = "(https?|ftp)://\\S+|www\\.\\S+") %>% 
      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 = 5)

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

Naive Bayes

Naive Bayes adalah salah satu algoritma klasifikasi yang sering digunakan dalam analisis teks. Konsep dasarnya didasarkan pada Teorema Bayes dan diasumsikan bahwa setiap fitur (kata) dalam teks adalah independen satu sama lain, meskipun kenyataannya fitur-fitur ini mungkin tidak benar-benar independen. Dalam klasifikasi teks, Naive Bayes menghitung probabilitas bahwa suatu dokumen termasuk dalam suatu kategori berdasarkan kata-kata yang ada di dalamnya.

Kita dapat melakukan model fitting menggunakan algoritma Naive Bayes dengan fungsi naiveBayes.

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

Random Forest

Random Forest adalah algoritma klasifikasi yang kuat dan efektif dalam analisis teks. Algoritma ini berdasarkan konsep ensemble learning, di mana ia menggabungkan prediksi dari beberapa pohon keputusan (decision trees) yang dibangun secara acak dari sampel data yang berbeda. Dalam klasifikasi teks, setiap pohon keputusan di Random Forest akan memproses berbagai fitur (kata-kata) dalam teks dan memutuskan kategori untuk setiap dokumen. Hasil akhirnya didasarkan pada mayoritas suara dari pohon-pohon keputusan tersebut. Random Forest mampu mengatasi masalah overfitting dan dapat menangani dataset dengan banyak fitur (term) secara efisien.

Mari kita lakukan model fitting menggunakan algoritma Random Forest.

#set.seed(417)

#ctrl <- trainControl(method="repeatedcv", number = 5, repeats = 3)

# model_forest <- train(
#    x = data_train_clean,
#    y = label_train,
#    method = "rf",
#    trControl = ctrl)

Karena training Random Forest membutuhkan waktu yang lama, jadi lebih baik kita simpan modelnya dalam bentuk RDS file setelah model dibuat

#saveRDS(model_forest, "model_forest.RDS") # save model

# Load model
model_forest <- readRDS("model_forest.RDS")

Long Short-Term Memory (LSTM)

LSTM merupakan salah satu bagian dari Recurrent Neural Network (RNN). Jika LSTM adalah salah satu bagian dari RNN, kenapa kita tidak menggunakan RNN saja? Salah satu alasan kenapa kita menggunakan LSTM di sini dikarenakan LSTM bisa menampung informasi atau pola jauh lebih baik jika dibandingkan dengan RNN. Hal tersebut bisa terjadi karena adanya tambahan sinyal yang diberikan dari satu langkah waktu ke langkah waktu berikutnya, atau istilah yang bisanya digunakan untuk tambahan sinyal adalah cell state/memory cell. Selain dengan adanya cell state, didalam LSTM nantinya ada beberapa gate yang untuk memproses lebih lanjut setiap data yang ada.

Proses pembuatan model LSTM cukup berbeda dibandingkan kedua model sebelumnya. Pertama, kita siapkan data text yang sudah dibersihkan dan memasukannya dalam kolom text_clean

teks_clean <- sms
teks_clean$text_clean <- NA
for (i in seq_along(sms_corpus)) {
  teks_clean$text_clean[i] <- as.character(sms_corpus[[i]])
}

teks_clean %>% 
  select(text, text_clean) %>% 
  head(5)

##                                                                                                                                                                                                                                         text
## 1                                                                                                                                                                                                                        Telegram code 53784
## 2                                                                            Rezeki Nomplok Dompetku Pengiriman Uang! Kirim uang di Alfamart & dptkan hadiah jutaan rupiah setiap hari.Periode s.d. 28Feb17.Info: http://bit.ly/dmpurna MFI1
## 3                                                                                                                                        WhatsApp code 123-994.\n\nYou can also tap on this link to verify your phone: v.whatsapp.com/123994
## 4                                                                             Transaksi travel online pakai CIMB Clicks gratis perlindungan kecelakaan & tiket nonton di Pasarpolis.com. Ayo transaksi & nikmati manfaatnya! Info S&K 14041.
## 5 Apakah Anda mencoba mengakses akun Anda dari perangkat lain? Jika ya, mohon klik tautan ini https://api.gojek.co.id/customers/device?token=f192293e-3117-46e9-bac3-1d1473c23113 dalam 72 jam ke depan. Jika tidak, mohon abaikan pesan ini
##                                                                                                                                  text_clean
## 1                                                                                                                             telegram code
## 2                             rezeki nomplok dompetku pengiriman uang kirim uang alfamart dptkan hadiah jutaan rupiah period sd febinfo mfi
## 3                                                             whatsapp code you can also tap on this link to verifi your phone vwhatsappcom
## 4 transaksi travel onlin pakai cimb click grati perlindungan kecelakaan tiket nonton pasarpoliscom ayo transaksi nikmati manfaatnya info sk
## 5                                                               mencoba mengaks akun perangkat ya mohon klik tautan jam mohon abaikan pesan

Kemudian, kita akan melakukan proses tokenization. Seperti yang kami sebutkan sebelumnya, tokenizer bertujuan untuk memisahkan setiap kata di seluruh dokumen ke dalam bentuk token. Parameter num_words berfungsi untuk mengatur jumlah maksimum kata yang akan digunakan, diurutkan berdasarkan urutan frekuensi terbesar. kata-kata yang jarang muncul akan dihilangkan.

num_words <- 1024

tokenizer <- text_tokenizer(num_words = num_words, lower = T) %>% 
  fit_text_tokenizer(teks_clean$text_clean)

paste("Number of unique words is ", length(tokenizer$word_counts))

## [1] "Number of unique words is  2910"

Dari total 2910 kata unik yang terdapat pada data teks, kita kurangi menjadi 1024 yang akan digunakan untuk membuat model.

Kemudian, kita melakukan cross validation dari data teks_clean

set.seed(100)

index <- sample(nrow(teks_clean), nrow(teks_clean)*0.8)

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

Setelah berhasil memisahkan datanya menjadi 2 bagian, mari kita implementasikan hasil temuan pada bagian tokenisasi di atas dan penjelasan lanjutan mengenai kenapa kita harus mengetahui panjang maksimal dari kata pada sebuat kalimat akan dilanjutkan di bawah ini.

maxlen <- max(str_count(teks_clean$text_clean, "\\w+")) + 1 
paste("Maximum length words in data:", maxlen)

## [1] "Maximum length words in data: 62"

# prepare x
data_train_x <- texts_to_sequences(tokenizer, data_train$text_clean) %>%
  pad_sequences(maxlen = maxlen, padding = "pre", truncating = "post")

data_test_x <- texts_to_sequences(tokenizer, data_test$text_clean) %>%
  pad_sequences(maxlen = maxlen, padding = "pre", truncating = "post")

# prepare y
data_train$status <- as.factor(ifelse(data_train$status == 'spam', 1, 0))
data_test$status <- as.factor(ifelse(data_test$status == 'spam', 1, 0))
data_train_y <- to_categorical(data_train$status)
data_test_y <- to_categorical(data_test$status)

Fungsi texts_to_sequence(), akan membuat matriks hasil transformasi text ke bentuk urutan angka (integer). Setelah itu diwrap dengan fungsi pad_sequences(), fungsi tersebut harus digunakan karena panjang teks bisa berbeda, dengan menggunakan fungsi pad_sequences() untuk memastikan semua teks memiliki panjang yang sama dengan memasukkan nilai 0 jika teks terlalu pendek.

Dalam membuat model LSTM, kita akan meminjam library(keras) dari Tensorflow Python. Dari library tersebut, kita akan menggunakan fungsi keras_model_sequential() untuk membangun arstitektur model LSTM. Secara umum arsitektur pada setiap model Neural Network setidaknya harus memiliki 3 komponen berikut ini, Input Layer, Hidden Layer dan Output Layer. Selain dari 3 komponen yang sudah disebutkan, sebenarnya kita bisa menambahkan beberapa layer lagi sesuai dengan kebutuhan, seperti layer dropout yang akan saya gunakan.

Layer Pertama: Input Layer

Layer utama yang akan dibuat adalah input layer atau biasanya juga disebut sebagai embedding layer. Pada layer ini nantinya akan diisi dengan kata-kata yang ada pada setiap berita. Pada lapisan ini juga akan mempelajari pengaruh dari posisi atau kedekatan anatara satu kata dengan kata yang lainnya. Sebagai contoh, kata raja biasanya ditempatkan di dekat kata pria dan kata ratu biasanya ditempatkan di dekat kata wanita.

Layer Kedua: Dropout Layer

Layer dropout adalah teknik regulasi yang acak menonaktifkan sebagian unit atau neuron selama pelatihan. Tujuannya adalah untuk mengurangi overfitting dan meningkatkan generalisasi model pada data baru. Dengan menerapkan dropout pada layer tertentu, kita secara acak menonaktifkan sebagian unit atau neuron selama pelatihan, dengan probabilitas tertentu (disebut tingkat dropout). Ini berarti beberapa koneksi antara neuron akan terputus pada setiap iterasi pelatihan. Proses dropout mengharuskan model belajar tanpa terlalu bergantung pada setiap fitur atau hubungan yang spesifik dari data pelatihan, sehingga meningkatkan kemampuan model untuk beradaptasi dengan data yang tidak dilihat sebelumnya.

Layer Ketiga: Hidden Layer

Layer ketiga adalah hidden layer dan pada layer ini kita bisa menambahkan berbagai macam layer, akan tetapi layer yang akan kita tambahkan di sini adalah LSTM layer karena model yang kita ingin buat adalah model LSTM. Pada layer ini nantinya setiap input atau infromasi yang berasal dari embedding layer akan proses lebih lanjut lagi.

Layer Keempat: Output Layer

Layer keempat adalah output layer atau sering juga disebut sebagai dense layer. Pada layer ini nantinya kita bisa mengatur berapa banyak kelas yang ingin dihasilkan, kelas di sini akan kita samakan dengan target variabel yang ingin kita klasifikasikan.

model_lstm <- keras_model_sequential(name = "model_nn") %>% 

  # layer input
  layer_embedding(
    name = "input",
    input_dim = num_words,
    input_length = maxlen,
    output_dim = 256, 
    embeddings_initializer = initializer_random_uniform(minval = -0.05, maxval = 0.05, seed = 2)
  ) %>%
  # layer dropout
  layer_dropout(
    name = "embedding_dropout",
    rate = 0.5
  ) %>%
  # layer lstm 
  layer_lstm(
    name = "lstm",
    units = 256,
    dropout = 0.2,
    recurrent_dropout = 0.2,
    return_sequences = FALSE, 
    recurrent_initializer = initializer_random_uniform(minval = -0.05, maxval = 0.05, seed = 2),
    kernel_initializer = initializer_random_uniform(minval = -0.05, maxval = 0.05, seed = 2)
  ) %>%
  # layer output
  layer_dense(
    name = "output",
    units = 2,
    activation = "softmax", 
    kernel_initializer = initializer_random_uniform(minval = -0.05, maxval = 0.05, seed = 2)
  )

Setelah berhasil membangun arsitektur, langkah terakhir yang harus kita lakukan adalah menambahkan beberapa parameter berikut ini, loss function, optimizer & metrics. Penambahan ketiga parameter tersebut biasanya disebut sebagai compilation/model compile.

model_lstm %>% compile(
  optimizer = optimizer_adam(learning_rate = 0.001),
  metrics = "accuracy",
  loss = "categorical_crossentropy"
)

Sekarang kita sudah bisa memasuki tahapan training model. Kita dapat menggunakan fungsi fit(), nantinya dalam fungsi tersebut ada dua parameter yang harus kita perhatikan, yaitu:

• epoch: parameter ini nantinya akan mengatur banyaknya iterasi pengulangan pada saat pelatihan model. Penentuan banyaknya iterasi juga tidak memiliki aturan khusus, akan tetapi semakin banyak epoch maka error bisa lebih kecil, namun proses training semakin lama dan rentan overfitting.
• batch_size: parameter ini nantinya akan mengatur banyak jumlah sampel yang dilatih pada tiap iterasi/epoch. Sama seperti epoch, penentuan jumlah batch size juga tidak memiliki aturan khusus, akan tetapi semakin sedikit batch size maka proses training semakin lama (karena proses optimasi model semakin banyak); namun bisa mencegah komputasi terlalu besar di 1 waktu sekaligus.

history <- model_lstm %>% 
  fit(data_train_x, 
      data_train_y,
      batch_size = 256, 
      epochs = 12,
      verbose = 1)

plot(history)

Prediction

sms_pred_naive <- predict(model_nb, newdata = data_test_clean, type="class")
head(sms_pred_naive)

## [1] spam spam spam spam ham  ham 
## Levels: ham spam

sms_pred_rf <- predict(model_forest, newdata = data_test_clean, type="raw")
head(sms_pred_rf)

## [1] spam spam spam spam ham  ham 
## Levels: ham spam

LSTM

sms_pred_lstm <- model_lstm %>%
  predict(data_test_x) %>%
  k_argmax() %>% as.array()

sms_pred_lstm <- as.factor(ifelse(sms_pred_lstm == 1, 'spam', 'ham'))
head(sms_pred_lstm)

## [1] spam spam spam spam ham  ham 
## Levels: ham spam

Naive Bayes

confusionMatrix(data = sms_pred_naive, reference = label_test, positive = "spam")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  212    4
##       spam  16  169
##                                               
##                Accuracy : 0.9501              
##                  95% CI : (0.924, 0.9693)     
##     No Information Rate : 0.5686              
##     P-Value [Acc > NIR] : < 0.0000000000000002
##                                               
##                   Kappa : 0.8992              
##                                               
##  Mcnemar's Test P-Value : 0.01391             
##                                               
##             Sensitivity : 0.9769              
##             Specificity : 0.9298              
##          Pos Pred Value : 0.9135              
##          Neg Pred Value : 0.9815              
##              Prevalence : 0.4314              
##          Detection Rate : 0.4214              
##    Detection Prevalence : 0.4613              
##       Balanced Accuracy : 0.9534              
##                                               
##        'Positive' Class : spam                
## 

Dari hasil confusion matrix diatas, model Naive Bayes mendapatkan accuracy 95,01%.

Random Forest

confusionMatrix(data = sms_pred_rf, reference = label_test, positive = "spam")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  216    2
##       spam  12  171
##                                               
##                Accuracy : 0.9651              
##                  95% CI : (0.9421, 0.9808)    
##     No Information Rate : 0.5686              
##     P-Value [Acc > NIR] : < 0.0000000000000002
##                                               
##                   Kappa : 0.9293              
##                                               
##  Mcnemar's Test P-Value : 0.01616             
##                                               
##             Sensitivity : 0.9884              
##             Specificity : 0.9474              
##          Pos Pred Value : 0.9344              
##          Neg Pred Value : 0.9908              
##              Prevalence : 0.4314              
##          Detection Rate : 0.4264              
##    Detection Prevalence : 0.4564              
##       Balanced Accuracy : 0.9679              
##                                               
##        'Positive' Class : spam                
## 

Dari hasil confusion matrix diatas, model Random Forest mendapatkan accuracy 96,51%.

LSTM

confusionMatrix(data = sms_pred_lstm, reference = label_test, positive = "spam")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  217    5
##       spam  11  168
##                                              
##                Accuracy : 0.9601             
##                  95% CI : (0.936, 0.977)     
##     No Information Rate : 0.5686             
##     P-Value [Acc > NIR] : <0.0000000000000002
##                                              
##                   Kappa : 0.919              
##                                              
##  Mcnemar's Test P-Value : 0.2113             
##                                              
##             Sensitivity : 0.9711             
##             Specificity : 0.9518             
##          Pos Pred Value : 0.9385             
##          Neg Pred Value : 0.9775             
##              Prevalence : 0.4314             
##          Detection Rate : 0.4190             
##    Detection Prevalence : 0.4464             
##       Balanced Accuracy : 0.9614             
##                                              
##        'Positive' Class : spam               
## 

Dari hasil confusion matrix diatas, model LSTM mendapatkan accuracy 96,51%. Sama seperti model Random Forest.

Random Forest

pred_false_rf <- data_test %>% 
   mutate(pred.rf = sms_pred_rf,
          status = as.factor(ifelse(status == 1, 'spam', 'ham'))) %>% 
   filter(pred.rf != status)
pred_false_rf %>% select(-datetime, -text_clean) %>% filter(pred.rf == "spam")

##                                                                                                                                                               text
## 1         Travelingnya happy, terbangnya aman, hotelnya nyaman karena dapat diskon AGODA 7% + Asuransi Gratis 25 Jt! Buruan ke sini http://bit.ly/AktifkanSekarang
## 2    Langganan Spotify Premium kamu berakhir pd 2017-03-17. Pastikan pulsa kamu cukup utk trs menikmati jutaan musik tanpa iklan. Isi ulang di bit.ly/topupindosat
## 3                  Sayang sekali pulsa kamu tdk cukup utk berlangganan Spotify Premium. Isi ulang pulsa di topup.indosatooredoo.com &  daftar kembali di *123*123#
## 4  Go Mobile\n17Mar17 12:37\n6296547805\nIsi Ulang Prabayar\nIM3 Ooredoo\n085722688068\nIDR 25,000.00\nSukses\nBiaya Adm sesuai provider, khusus Telkomsel Rp 1500
## 5                                                      Maaf, Anda tidak diperkenankan untuk mengikuti paket ini. Info detail www.indosatooredoo.com atau hub : 185
## 6           SELAMAT! Paket Freedom M Rp 59rb/30hr aktif s.d. 01/12/2017 10:00. Nikmati akses APPS & YouTube SEPUASNYA serta DATA ROLLOVER. Cek kuota di: http://im
## 7                                                Dear aspen, Pesanan anda dengan nomor 224019451 di jd.id sudah ada di jasa pengiriman, untuk info, email cs@jd.id
## 8                       Pelanggan Yth.Kiriman dari OKKY PUTRA tgl 28-12-2017 No.15892405794 sdg dlm proses pengiriman. status bisa dicek di www.posindonesia.co.id
## 9                                                                             Registrasi Prabayar Sukses. Data pelanggan sesuai identitas  Anda telah didaftarkan.
## 10 Bonus paket sembako senilai 150rb min trx 1jt dg Kartu Kredit CIMB Niaga di Lotte Mart & Lotte Supermarket, berlaku setiap hari dari 26-31Jan'18.S&K.Info 14041
## 11                   Nikmati akses ke FB, Path, Twitter,Whatsapp, BBM, Line,FB Msg, iFlix&Spotify gak habis habis kuotanya. Info *123# atau myIM3 http://im3.do/m3
## 12   Trm ksh Anda sdh akses Facebook dgn IndosatOoredoo. Brdasar pngalamn Anda, sberapa puas Anda thdp kualitas akses FB kami? Balas F1 sd F5 (F5= Sgt puas). FREE
##    status pred.rf
## 1     ham    spam
## 2     ham    spam
## 3     ham    spam
## 4     ham    spam
## 5     ham    spam
## 6     ham    spam
## 7     ham    spam
## 8     ham    spam
## 9     ham    spam
## 10    ham    spam
## 11    ham    spam
## 12    ham    spam

LSTM

pred_false_lstm <- data_test %>% 
   mutate(pred.lstm  = sms_pred_lstm,
          status = as.factor(ifelse(status == 1, 'spam', 'ham'))) %>% 
   filter(pred.lstm  != status)
pred_false_lstm %>% select(-datetime, -text_clean) %>% filter(pred.lstm  == "spam")

##                                                                                                                                                               text
## 1         Travelingnya happy, terbangnya aman, hotelnya nyaman karena dapat diskon AGODA 7% + Asuransi Gratis 25 Jt! Buruan ke sini http://bit.ly/AktifkanSekarang
## 2    Langganan Spotify Premium kamu berakhir pd 2017-03-17. Pastikan pulsa kamu cukup utk trs menikmati jutaan musik tanpa iklan. Isi ulang di bit.ly/topupindosat
## 3                  Sayang sekali pulsa kamu tdk cukup utk berlangganan Spotify Premium. Isi ulang pulsa di topup.indosatooredoo.com &  daftar kembali di *123*123#
## 4  Go Mobile\n17Mar17 12:37\n6296547805\nIsi Ulang Prabayar\nIM3 Ooredoo\n085722688068\nIDR 25,000.00\nSukses\nBiaya Adm sesuai provider, khusus Telkomsel Rp 1500
## 5                                                      Maaf, Anda tidak diperkenankan untuk mengikuti paket ini. Info detail www.indosatooredoo.com atau hub : 185
## 6           SELAMAT! Paket Freedom M Rp 59rb/30hr aktif s.d. 01/12/2017 10:00. Nikmati akses APPS & YouTube SEPUASNYA serta DATA ROLLOVER. Cek kuota di: http://im
## 7         Mohon kirimkan NIK dan Nomer Kartu Keluarga Anda. Ketik : Daftar#NIK#NomerKartuKeluarga kirim ke 4444. Contoh : DAFTAR#3212330419910000#3212340304199999
## 8                                                                             Registrasi Prabayar Sukses. Data pelanggan sesuai identitas  Anda telah didaftarkan.
## 9  Bonus paket sembako senilai 150rb min trx 1jt dg Kartu Kredit CIMB Niaga di Lotte Mart & Lotte Supermarket, berlaku setiap hari dari 26-31Jan'18.S&K.Info 14041
## 10                   Nikmati akses ke FB, Path, Twitter,Whatsapp, BBM, Line,FB Msg, iFlix&Spotify gak habis habis kuotanya. Info *123# atau myIM3 http://im3.do/m3
## 11   Trm ksh Anda sdh akses Facebook dgn IndosatOoredoo. Brdasar pngalamn Anda, sberapa puas Anda thdp kualitas akses FB kami? Balas F1 sd F5 (F5= Sgt puas). FREE
##    status pred.lstm
## 1     ham      spam
## 2     ham      spam
## 3     ham      spam
## 4     ham      spam
## 5     ham      spam
## 6     ham      spam
## 7     ham      spam
## 8     ham      spam
## 9     ham      spam
## 10    ham      spam
## 11    ham      spam

Hasil yang salah pada kedua model hampir mirip. Dari tampilan di atas banyak teks ham yang salah klasifikasi adalah sms yang berbau promosi, contohnya seperti sms dari penyedia internet yang menginformasikan penggunanya tentang sesuatu yang berguna seperti data yang tersisa. Hal ini dapat terjadi karena provider internet sering mengirimkan barang-barang promosi yang mengandung kata seperti “pulsa” atau “kuota” atau “paket” yang juga digunakan untuk menginformasikan kepada pengguna tentang sisa data atau sesuatu yang berguna bagi pengguna.

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)) %>% 
   head(10)

##       rowname   Overall
## 1        info 100.00000
## 2       pulsa  44.11981
## 3     ooredoo  42.55638
## 4         ayo  41.32096
## 5       grati  39.86128
## 6         ire  37.50058
## 7       kuota  36.27925
## 8   pelanggan  31.57221
## 9  internetan  31.03257
## 10     bronet  29.67781

Variable atau kata yang paling memberikan kontribusi adalah “info”

LIME

LIME, singkatan dari “Local Interpretable Model-agnostic Explanations,” adalah sebuah metode dalam machine learning yang digunakan untuk menjelaskan prediksi model secara lokal dan interpretatif. LIME bekerja dengan menghasilkan model yang lebih sederhana dan mudah diinterpretasi di sekitar data poin tertentu. Caranya adalah dengan mengekstrak sampel data kecil yang mendekati data poin tersebut dan kemudian melatih model interpretatif, seperti regresi linear, pada sampel-sampel tersebut. Model interpretatif ini memberikan pemahaman tentang kontribusi relatif dari setiap fitur terhadap prediksi model utama pada data poin yang dipilih. Dengan demikian, LIME memberikan insight yang lebih mudah dimengerti tentang bagaimana model membuat prediksi tertentu, terutama pada kasus-kasus di mana model utama (black box model) sulit untuk diinterpretasi secara langsung.

Kita akan melakukan interpretasi dari ketiga model yang sudah dibuat dengan menggunakan LIME.

class(model_nb)

## [1] "naiveBayes"

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

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

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

set.seed(100)
explainer <- lime(
   text_train,
   model=model_nb,
   preprocess=tokenize_text
)

explanation <- explain(
   text_test[2:5],
   explainer = explainer, 
   n_labels = 1, 
   n_features = 5, 
   feature_select = "none",
   single_explanation = F
)

plot_text_explanations(explanation)

Import Data

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

##               datetime
## 1 2018-03-01T00:32:00Z
## 2 2018-03-01T08:57:00Z
## 3 2018-03-01T09:15:00Z
## 4 2018-03-01T16:42:00Z
## 5 2018-03-01T17:42:00Z
## 6 2018-03-01T22:04:00Z
##                                                                                                                                                             text
## 1          Km baru saja akses Apps Sehari-hari terpopuler.Nikmati akses YOUTUBE ga habis habis dgn beli pkt Unlimited HANYA di *123# atau myIM3 http://im3.do/m3
## 2 GRATIS UNLIMITED YOUTUBE+INTERNET 10GB+CHAT&SOSMED+SMS+NELPON selama 30hari.Data Rollover.PROMO 100Rb (Normal 115rb). MAU? Tekan C25 kirim SMS ke 929 sekarang
## 3                    Sisa kuota 285 MB.Beli pkt Internet TERBAIK dr IM3 ooredoo di *123# atau myIM3 http:// im3.do/m3 .Kelebihan pemakaian dikenakan tarif perKB
## 4  Ada banyak lowongan kerja baru! Ayo jgn sampai kamu ketinggalan update & tips di dunia kerja, tekan *123*543*2# . Tarif Rp2.200/3hari. Info: 08001401686 DSI7
## 5 Proses PEMBLOKIRAN kartu bagi yg blm registrasi sdg berjalan,segera registrasi kartu Anda,dapatkan bonus 250MB+250mnt+250SMS.Ketik ULANG#NIK#No.KK# SMS ke4444
## 6                                                   iRing keren cuman buat km, Via Vallen-Bojo Galak (Reff),Rp.0,1/3hr prpnjngan Rp.3190 dengan hnya bls YA lho!
##   status
## 1     NA
## 2     NA
## 3     NA
## 4     NA
## 5     NA
## 6     NA

Text Cleansing

Karena kita sudah membuat fungsi tokenize_test sebelumnya. Bisa diaplikasikan ke submission data.

submission_clean <- tokenize_text(submission$text)

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 <- trimRfPredictor(submission_clean, data_train_clean)
submission_clean[1:5,1:20]

##   abaikan add admin aja aks aktif aktifkan akun alamat alasan all ambil andb
## 1 "0"     "0" "0"   "0" "1" "0"   "0"      "0"  "0"    "0"    "0" "0"   "0" 
## 2 "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" 
## 4 "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" 
##   ansdr ansdri antarbank apartemen aplikasi aplikasinya apn
## 1 "0"   "0"    "0"       "0"       "0"      "0"         "0"
## 2 "0"   "0"    "0"       "0"       "0"      "0"         "0"
## 3 "0"   "0"    "0"       "0"       "0"      "0"         "0"
## 4 "0"   "0"    "0"       "0"       "0"      "0"         "0"
## 5 "0"   "0"    "0"       "0"       "0"      "0"         "0"

Predict Submission

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

submission_nb <- submission %>% 
   select(datetime)

submission_nb$status <- predict(model_nb, newdata = submission_clean, type="class")
head(submission_nb$status)

## [1] spam spam spam spam ham  spam
## Levels: ham spam

write.csv(submission_nb, "data/submission_nb.csv", row.names = F)

submission_rf <- submission %>% 
   select(datetime)

submission_rf$status <- predict(model_forest, newdata = submission_clean, type="raw")
head(submission_rf$status)

## [1] spam spam spam spam ham  spam
## Levels: ham spam

write.csv(submission_rf, "data/submission_rf.csv", row.names = F)

submission_corpus <- VCorpus(VectorSource(submission$text))
submission_corpus <- submission_corpus %>%
   tm_map(content_transformer(tolower)) %>% 
   tm_map(transformer, pattern = "(https?|ftp)://\\S+|www\\.\\S+") %>% 
   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)

for (i in seq_along(submission_corpus)) {
  submission$text_clean[i] <- as.character(submission_corpus[[i]])
}

submission %>% 
  select(text_clean) %>% 
  head(5)

##                                                                                                              text_clean
## 1                                 km aks app sehari terpopulernikmati aks youtub ga habi habi dgn beli pkt unlimit myim
## 2                 grati unlimit youtubeinternet gbchatsosmedsmsnelpon data rolloverpromo rb normal rb tekan c kirim sms
## 3        sisa kuota mbbeli pkt internet terbaik dr im ooredoo myim http imdom kelebihan pemakaian dikenakan tarif perkb
## 4                                      lowongan kerja ayo jgn ketinggalan updat tip dunia kerja tekan tarif rp info dsi
## 5 prose pemblokiran kartu yg blm registrasi sdg berjalan registrasi kartu dapatkan bonus mbmntsmsketik ulangniknokk sms

data_lstm <- texts_to_sequences(tokenizer, submission$text_clean) %>%
  pad_sequences(maxlen = maxlen, padding = "pre", truncating = "post")

submission_lstm <- submission %>% 
   select(datetime)

submission_lstm$status <- model_lstm %>%
  predict(data_lstm) %>%
  k_argmax() %>% as.array()

submission_lstm$status <- as.factor(ifelse(submission_lstm$status == 1, 'spam', 'ham'))
head(submission_lstm$status)

## [1] spam spam spam spam ham  spam
## Levels: ham spam

write.csv(submission_lstm, "data/submission_lstm.csv", row.names = F)