SMS SPAM CLASSIFICATION
Primaditaningtyas W
March 26, 2019
1 Penyetelan Awal
1.1 Penyetelan Dokumen
knitr::opts_chunk$set(echo = TRUE)
options(scipen = 1)
rm(list = ls())1.2 Inisiasi Library
library(dplyr)
library(ggplot2)
library(lubridate)
library(tm)
library(katadasaR)
library(textclean)
library(tokenizers)
library(stopwords)
library(textreg)
library(wordcloud)
library(RColorBrewer)
library(e1071)
library(caret)
library(keras)
use_virtualenv("tensorflow")
use_session_with_seed(100)2 Latar Belakang
Seiring berkembangnya teknologi, fasilitas dalam menunjang proses pertukaran informasi terus berinovasi. Dari surat menyurat, telepon, hingga pertukaran informasi teks berbasis digital contohnya e-mail, sms, dan beberapa aplikasi chat seperti whatsapp, fb messenger dan lain sebagainya.
Beberapa tahun ke belakang sms merupakan metode bertukar informasi yang cukup favorit digunakan masyaratakat pada umumnya, akan tetapi dengan perkembangan teknologi, sms mulai kurang diminati dikarenakan masyarakat cenderung beralih menggunakan aplikasi chat. Beberapa kelebihan penggunaan aplikasi tersebut diantaranya adalah biaya yang jauh lebih murah, lebih bervariasi karena mampu menampilkan gambar,dokumen, serta video, dapat bertukar informasi dalam satu grup, dan masih banyak kelebihan lainnya.
Dikarenakan hal tersebut, lebih banyak sms yang kita terima saat ini adalah sebuah spam dibanding informasi real dari teman atau kolega kita. Di antara beberapa spam itu adalah iklan-iklan dari provider, beberapa jenis undian, hingga informasi lain yang cenderung mengarah ke penipuan. Kecenderungan seperti ini membuat masyarakat enggan membaca dan langsung menghapus apapun sms yang masuk ke ponsel mereka, padahal bisa jadi ada informasi penting dari kerabat, saudara atau kolega yang masih menggunakan sms sebagai metode pertukaran informasi mereka.
Oleh karena itu, proses filter sms masuk dan pelabelan spam menjadi suatu hal yang cukup krusial kebutuhannya saat ini. Pada dokumentasi ini, kita akan melihat data sample beberapa sms yang sudah dilabeli spam berasal dari laporan masyarakat terhadap sms-sms yang tidak diinginkan. Dari data tersebut kita akan melakukan beberapa eksplorasi data, lalu melakukan beberapa tahap pre-processing data/data cleansing. Setelah data cleansing selesai, tahap selanjutnya adalah prediksi sms berkategori spam menggunakan perbandingan beberapa metode machine learning. Metode terbaik akan digunakan untuk pembuatan model prediksi sms berupa spam.
3 Data PreProcess
3.1 Input
sms <- read.csv("data/SMS/sms.csv")
glimpse(sms)## Observations: 1,751
## Variables: 3
## $ STATUS <fct> ham, spam, ham, spam, spam, spam, spam, spam, spam, sp...
## $ CONTAIN <fct> "Sy wa ga sampe2 soalnya", "Km baru saja akses Apps Se...
## $ DATE <fct> 2018-02-28 11:43:00, 2018-02-28 01:52:00, 2018-02-27 1...Data diinput dengan label sms. Dalam data frame sms terdapat 3 variabel berbeda yaitu :
STATUS: Merupakan label yang diberikan pada sms yang diterima (spam/ham)CONTAIN: Isi teks smsDATE: Jam serta tanggal sms diterima
Selanjutnya adalah data yang ingin ditebak yaitu :
sms_unseen <- read.csv("data/SMS/submissionSMS.csv")
glimpse(sms_unseen)## Observations: 321
## Variables: 3
## $ DATE <fct> 2018-04-25 14:20:00, 2018-04-25 14:13:00, 2018-04-25 1...
## $ CONTAIN <fct> "ELITE RELOAD PULSA:Kami ingin menawarkan anda menjadi...
## $ STATUS <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...3.2 Eksplorasi Data
Sebelum melakukan data cleansing mari kita gabungkan data input serta data unseen yang ingin ditebak.
sms <- rbind(sms,sms_unseen)
glimpse(sms)## Observations: 2,072
## Variables: 3
## $ STATUS <fct> ham, spam, ham, spam, spam, spam, spam, spam, spam, sp...
## $ CONTAIN <fct> "Sy wa ga sampe2 soalnya", "Km baru saja akses Apps Se...
## $ DATE <fct> 2018-02-28 11:43:00, 2018-02-28 01:52:00, 2018-02-27 1...Selanjutnya kita akan mengubah kolom CONTAIN menjadi character dan kolom DATE menjadi tanggal dan jam.
sms <- sms %>%
mutate_at(vars(CONTAIN),as.character) %>%
mutate_at(vars(DATE), ymd_hms)
glimpse(sms)## Observations: 2,072
## Variables: 3
## $ STATUS <fct> ham, spam, ham, spam, spam, spam, spam, spam, spam, sp...
## $ CONTAIN <chr> "Sy wa ga sampe2 soalnya", "Km baru saja akses Apps Se...
## $ DATE <dttm> 2018-02-28 11:43:00, 2018-02-28 01:52:00, 2018-02-27 ...Tabel di atas menunjukkan proses perubahan format pada varibel CONTAIN dan DATE telah berhasil.
Kita bisa melihat rentang waktu sampling data dengan cara berikut :
range(sms$DATE[1:1751])## [1] "2017-02-15 14:48:00 UTC" "2018-02-28 11:43:00 UTC"range(sms$DATE[1752:2072])## [1] "2018-02-28 22:22:00 UTC" "2018-04-25 14:20:00 UTC"Dari info di atas kita mengetahui bahwa data training di ambil dalam rentang satu tahun dari bulan Februari 2017 hingga Februari 2018. Sedangkan data unseen/belum berlabel memiliki rentang sampling dari akhir Februari 2018 hingga April 2018.
Selanjutnya kita lihat apakah tanggal berpengaruh pada kecenderungan sms bersatus spam. Kita bisa melihatnya dalam plot densitas ham dan spam sepanjang rentang waktu sampling, seperti pada plot di bawah ini.
a <- ggplot(sms[1:1751,], aes(x = DATE))
a + geom_density(aes(fill = STATUS), alpha = 0.4) +
scale_fill_manual(values = c("#868686FF", "#EFC000FF"))+
labs(title = "Perbandingan Densitas SMS ham vs spam 2017-2018")
Plot di atas menunjukkan distribusi ham dan spam sepanjang waktu sampling, terlihat antara perbandingan kedua label sms tersebut, pola perseberan sms ham vs spam tidak saling memisah. Artinya DATE tidak mampu membantu kita dalam mengkategorikan sebuah sms bertipe spam atau ham. Oleh karena itu kolom DATE akan kita hilangkan saja.
sms <- sms %>%
select(-DATE)
glimpse(sms)## Observations: 2,072
## Variables: 2
## $ STATUS <fct> ham, spam, ham, spam, spam, spam, spam, spam, spam, sp...
## $ CONTAIN <chr> "Sy wa ga sampe2 soalnya", "Km baru saja akses Apps Se...Kita dapat melihat proporsi antara ham dan spam pada kode berikut :
table(sms$STATUS[1:1751])##
## ham spam
## 1086 665round(prop.table(table(sms$STATUS))*100,2)##
## ham spam
## 62.02 37.98Dari 1751 observasi data training, ada 62 persen (1086 Observasi) berupa ham dan 38 persen (665 Observasi) adalah spam. Atau dalam plot dapat ditampilkan seperti di bawah ini :
count_sms <- sms[1:1751,] %>%
group_by(STATUS) %>%
summarise(COUNTS = n())
ggplot(count_sms, aes(x=STATUS,y=COUNTS))+
geom_bar(aes(fill=STATUS),alpha = 0.4,colour="black",size = 1, stat = "identity")+
geom_text(aes(label=COUNTS), vjust=1,size=7)+
scale_fill_manual(values = c("#868686FF", "#EFC000FF"))+
labs(title = "Perbandingan Jumlah SMS ham vs spam")
Selanjutnya mari kita lihat isi sample acak dari data sms tersebut, dari yang berstatus ham maupun spam:
set.seed(2)
sms_ham <- sms[sms$STATUS == "ham" & !is.na(sms$STATUS),]
sms_spam <- sms[sms$STATUS == "spam" & !is.na(sms$STATUS),]
sms_ham[sample(nrow(sms_ham),5),"CONTAIN"]## [1] "Gojek d tunggu otw penjemputan"
## [2] "SAL"
## [3] "Di gloskin ya mbak"
## [4] "BNI SMS BANKING:15/12/2017 07:41 Trf Rp.37.000 ke 0271528021 an.Sdri RENITA LAVINIA telah berhasil. Reff: 972747."
## [5] "pak, saya nanti jalan ke margonda aja ya, di istana print itu"sms_spam[sample(nrow(sms_spam),5),"CONTAIN"]## [1] "WWW.SAKONGSA.COM (sbo,maxbet,cbo855,sabung aym,togel,poker,minigame) PROMO NEWMEMBER depo 100rb dpt 100rb,join skrg & menang bersm kami! klaim SKS168 di lvchat"
## [2] "BRONET DAYZ 17GB Rp89.900 hny di JUMAT BAIK dg akses *123*888# /app AXISnet dr HP, dapet BONUS 1GB setelah pembelian, berlaku di semua jaringan.Info838.AXIS007"
## [3] "TOPUP pulsa Rp 25000 berhasil via SMSBANKING CIMB_NIAGA kode trx 0317123710722286. Pulsa anda saat ini Rp 25495. Terima kasih telah menggunakan INDOSAT OOREDOO"
## [4] "iRing keren cuman buat km, Rizki Ridho DAcademy-Terlanjur Sakit (DM17),Rp.0,1/3hr prpnjngan Rp.3190 dengan hnya bls YA lho!"
## [5] "iRing keren cuman buat km, Repvblik-Aku Tetap Cinta,Rp.0,1 dengan hnya bls YA lho!"Kita dapat melihat 5 data pertama adalah contoh-contoh sms yang berkategori ham dan 5 data berikutnya adalah contoh sms berkategori spam. Sepintas data ketiga pada kategori spam seperti data ham karena terbaca seperti informasi berita (fakta). Mari kita ambil keyword “TOPUP” serta variasinya (uppercase/lowercase) dan kita lihat pada sampel dibawah
set.seed(1)
topup_sms <- sms[1:1751,] %>%
filter_all(any_vars(grepl("TOPUP|Topup|topup|TOP UP|Top Up",.)))
ggplot(topup_sms,aes(STATUS))+
geom_bar(aes(fill=STATUS),alpha = 0.4,colour="black",size = 1)+
scale_fill_manual(values = c("#868686FF", "#EFC000FF"))+
labs(title = "Perbandingan SMS ham vs spam", subtitle = "Mengandung kata TOPUP dan variasinya pada data train")
Ternyata kata topup saja tidak bisa dijadikan indikasi bahwa suatu sms berlabel ham atau spam dibuktikan dengan perbandingan jumlah sms yang mengandung kata topup dan variasinya pada plot di atas. Akan tetapi pada isi lengkap sms tersebut, ada pola kalimat yang bisa kita lihat dapat menentukan label sebuah sms. Diharapkan setelah tahap preprocessing dan tokenisasi, pola tersebut akan semakin jelas terlihat, baik kata yang cenderung menentukan label sebuah sms ham ataupun spam sehingga dapat mempermudah model kita menentukan label sebuah sms.
3.3 Text Cleansing
Kita ambil beberapa sample isi sms, dan akan kita lihat perubahannya selama proses text cleansing.
sms$CONTAIN[c(2,390,401,583,942,954,967,976)]## [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] "Dear aspen, Pesanan anda dengan nomor 224019451 di jd.id sudah ada di jasa pengiriman, untuk info, email cs@jd.id"
## [3] "Pagi, sy dr GOJEK sedang menuju kesana. Trims :-)"
## [4] "Saya sudah didepan tower a ya"
## [5] "Meikarta@Lippo Cikarang, kota terlengkap & terindah se-asia tenggara. BF 2jt & dapatkan disc.promo. Pastikan anda menjadi bagian dari kami. Info: meikarta.com"
## [6] "Main-main cm di *463*10#, Download dan nikmati Game Tom & Jerry: Mouse Maze,Cookie Crush Match 3,Lara Croft: Relic Run dll Rp.5500/mgg #refDB2"
## [7] "JobStreet.com: You've been invited by Boarding Labs for a career discussion. Respond via email or through www.jobstreet.com"
## [8] "Nonton streaming Liga Indonesia langsung dari HP-mu bareng teman-teman dengan tekan *465*2#. Tarif Rp2.200/SMS/3hari. Info: @Indosatcare. DBI1"Proses selanjutnya beberapa tahapan cleansing akan kita jadikan satu proses dalam bentuk dplyr. Keterangan proses cleansing itu diataranya adalah :
- Menghapus isi sms yang mengandung url website
- Menghapus isi sms yang berbentuk frasa email
- Menerjemahkan bentuk emoticon pada sms ke bentuk kata
- Merubah format-format tulisan yang berbentuk html
- Menghapus frasa pada sms yang berupa tag/mention
- Menghapus frasa pada sms yang berupa website dengan berpatokan mengandung ‘.com’ di belakangnya
- Menghapus frasa pada sms yang berupa hashtag/tagar
- Merubah kata-kata slang pada sms menjadi kata dasar baku bahasa indonesia
spell.lex <- read.csv("data/SMS/colloquial-indonesian-lexicon.csv") #Berisi kamus bahasa slang indonesia dengan kata dasar yang formalnyasms_cl <- readRDS("data/sms_cl.rds")
sms_cl$CONTAIN[c(2,390,401,583,942,954,967,976)]## [1] "kamu baru saja akses Apps Sehari-hari terpopuler.Nikmati akses YOUTUBE enggak habis habis dengan beli pkt Unlimited HANYA di *123# atau myIM3 "
## [2] "Dear aspen, Pesanan anda dengan nomor 224019451 di jadi.id sudah ada di jasa pengiriman, untuk info, email "
## [3] "Pagi, saya dari GOJEK sedang menuju kesana. terima kasih smiley "
## [4] "Saya sudah didepan tower a ya"
## [5] "Meikarta Cikarang, kota terlengkap & terindah se-asia tenggara. BF 2jt & dapatkan disc.promo. Pastikan anda menjadi bagian dari kami. Info: "
## [6] "Main-main cuma di *463*10#, Download dan nikmati Game Tom & Jerry: Mouse Maze,Cookie Crush Match 3,Lara Croft: Relic Run dll Rp.5500/mgg "
## [7] ": You've been invited by Boarding Labs for a career discussion. Respond via email orang through "
## [8] "menonton streaming Liga Indonesia langsung dari HP-mu bareng teman-teman dengan tekan *465*2#. Tarif Rp2.200/SMS/3hari. Info: . DBI1"Terlihat beberapa perubahan yang terjadi setelah proses cleansing di lakukan.
Kita bisa menghitung jumlah perubahan yang dilakukan dari proses di atas dengan cara sebagai berikut:
sum(sms_cl$CONTAIN != sms$CONTAIN)## [1] 1401Terdapat sejumlah 1401 perubahan saat melalui proses text cleansing.
3.4 Pembuatan Data Corpus
Selanjutnya beberapa tahap processing text akan dilakukan dalam format corpora (corpus) yang dibantu package tm.
sms.corpus <- VCorpus(VectorSource(sms_cl$CONTAIN))## [1] "kamu baru saja akses Apps Sehari-hari terpopuler.Nikmati akses YOUTUBE enggak habis habis dengan beli pkt Unlimited HANYA di *123# atau myIM3 "## [1] "Dear aspen, Pesanan anda dengan nomor 224019451 di jadi.id sudah ada di jasa pengiriman, untuk info, email "## [1] "Pagi, saya dari GOJEK sedang menuju kesana. terima kasih smiley "## [1] "Saya sudah didepan tower a ya"## [1] "Meikarta Cikarang, kota terlengkap & terindah se-asia tenggara. BF 2jt & dapatkan disc.promo. Pastikan anda menjadi bagian dari kami. Info: "## [1] "Main-main cuma di *463*10#, Download dan nikmati Game Tom & Jerry: Mouse Maze,Cookie Crush Match 3,Lara Croft: Relic Run dll Rp.5500/mgg "## [1] ": You've been invited by Boarding Labs for a career discussion. Respond via email orang through "## [1] "menonton streaming Liga Indonesia langsung dari HP-mu bareng teman-teman dengan tekan *465*2#. Tarif Rp2.200/SMS/3hari. Info: . DBI1"Dalam pemrosesan text, data sebaiknya kita standardkan secara global dalam bentuk lowercase atau uppercase. Hal ini bertujuan menghindari kata yang sama dilakukan/dikenal berbeda oleh komputer. Untuk tahap ini kita pilih lowercase.
sms.corpus <- tm_map(sms.corpus, content_transformer(tolower))## [1] "kamu baru saja akses apps sehari-hari terpopuler.nikmati akses youtube enggak habis habis dengan beli pkt unlimited hanya di *123# atau myim3 "## [1] "dear aspen, pesanan anda dengan nomor 224019451 di jadi.id sudah ada di jasa pengiriman, untuk info, email "## [1] "pagi, saya dari gojek sedang menuju kesana. terima kasih smiley "## [1] "saya sudah didepan tower a ya"## [1] "meikarta cikarang, kota terlengkap & terindah se-asia tenggara. bf 2jt & dapatkan disc.promo. pastikan anda menjadi bagian dari kami. info: "## [1] "main-main cuma di *463*10#, download dan nikmati game tom & jerry: mouse maze,cookie crush match 3,lara croft: relic run dll rp.5500/mgg "## [1] ": you've been invited by boarding labs for a career discussion. respond via email orang through "## [1] "menonton streaming liga indonesia langsung dari hp-mu bareng teman-teman dengan tekan *465*2#. tarif rp2.200/sms/3hari. info: . dbi1"Terlihat kata-kata yang memiliki huruf kapital berhasil dikonversi menjadi lowercase.
Selanjutnya kita juga tidak menginginkan angka-angka berada dalam teks, oleh karena itu bisa kita hilangkan dengan fungsi removeNumbers.
sms.corpus <- tm_map(sms.corpus, removeNumbers)## [1] "kamu baru saja akses apps sehari-hari terpopuler.nikmati akses youtube enggak habis habis dengan beli pkt unlimited hanya di *# atau myim "## [1] "dear aspen, pesanan anda dengan nomor di jadi.id sudah ada di jasa pengiriman, untuk info, email "## [1] "pagi, saya dari gojek sedang menuju kesana. terima kasih smiley "## [1] "saya sudah didepan tower a ya"## [1] "meikarta cikarang, kota terlengkap & terindah se-asia tenggara. bf jt & dapatkan disc.promo. pastikan anda menjadi bagian dari kami. info: "## [1] "main-main cuma di **#, download dan nikmati game tom & jerry: mouse maze,cookie crush match ,lara croft: relic run dll rp./mgg "## [1] ": you've been invited by boarding labs for a career discussion. respond via email orang through "## [1] "menonton streaming liga indonesia langsung dari hp-mu bareng teman-teman dengan tekan **#. tarif rp./sms/hari. info: . dbi"Kembali terlihat pada beberapa contoh isi sms di atas, sudah tidak lagi terdapat sms yang mengandung angka.
Selanjutnya kita ingin menghilangkan punctuation yang masih terdapat dalam sms, dengan membuat fungsi transformer. Fungsi ini akan membantu kita menghilangkan punctuation yang terdapat dalam list “[[:punct:]]”.
# Membuat fungsi transformer yang akan mengganti punctuation dengan " "
transformer <- content_transformer(function(x, pattern) {
gsub(pattern, " ", x)
})sms.corpus <- tm_map(sms.corpus, transformer, "[[:punct:]]")## [1] "kamu baru saja akses apps sehari hari terpopuler nikmati akses youtube enggak habis habis dengan beli pkt unlimited hanya di atau myim "## [1] "dear aspen pesanan anda dengan nomor di jadi id sudah ada di jasa pengiriman untuk info email "## [1] "pagi saya dari gojek sedang menuju kesana terima kasih smiley "## [1] "saya sudah didepan tower a ya"## [1] "meikarta cikarang kota terlengkap terindah se asia tenggara bf jt dapatkan disc promo pastikan anda menjadi bagian dari kami info "## [1] "main main cuma di download dan nikmati game tom jerry mouse maze cookie crush match lara croft relic run dll rp mgg "## [1] " you ve been invited by boarding labs for a career discussion respond via email orang through "## [1] "menonton streaming liga indonesia langsung dari hp mu bareng teman teman dengan tekan tarif rp sms hari info dbi"Selanjutnya proses penghilangan stopwords pada isi sms. Untuk proses ini sengaja di inisiasi penghilangan stopwords baik dalam bahasa Inggris maupun bahasa Indonesia dikarenakan masyarakat indonesia terkadang juga menggunakan bahasa inggris atau beberapa spam juga menggunakan bahasa inggris. Stopwords bahasa inggris sudah disediakan oleh fungsi stopwords dalam R, sedangkan untuk bahasa indonesia kita ambil dari file stopwords-id.txt.
myStopwords <- readLines("data/SMS/stopwords-id.txt")sms.corpus <- tm_map(sms.corpus, removeWords, c(stopwords("english"),myStopwords))## [1] " akses apps sehari terpopuler nikmati akses youtube habis habis beli pkt unlimited myim "## [1] "dear aspen pesanan nomor id jasa pengiriman info email "## [1] "pagi gojek kesana terima kasih smiley "## [1] " didepan tower ya"## [1] "meikarta cikarang kota terlengkap terindah asia tenggara bf jt dapatkan disc promo pastikan info "## [1] "main main download nikmati game tom jerry mouse maze cookie crush match lara croft relic run dll rp mgg "## [1] " ve invited boarding labs career discussion respond via email orang "## [1] "menonton streaming liga indonesia langsung hp mu bareng teman teman tekan tarif rp sms info dbi"Setelah proses berhasil, kita jelas melihat bahwa terkadang terdapat lebih dari satu space antar kata. Untuk menghilangkan itu digunakan fungsi stripWhitespace.
sms.corpus.new <- tm_map(sms.corpus, stripWhitespace)## [1] " akses apps sehari terpopuler nikmati akses youtube habis habis beli pkt unlimited myim "## [1] "dear aspen pesanan nomor id jasa pengiriman info email "## [1] "pagi gojek kesana terima kasih smiley "## [1] " didepan tower ya"## [1] "meikarta cikarang kota terlengkap terindah asia tenggara bf jt dapatkan disc promo pastikan info "## [1] "main main download nikmati game tom jerry mouse maze cookie crush match lara croft relic run dll rp mgg "## [1] " ve invited boarding labs career discussion respond via email orang "## [1] "menonton streaming liga indonesia langsung hp mu bareng teman teman tekan tarif rp sms info dbi"Setelah data terlihat cukup bersih, baru kita bisa lakukan proses stemming. Proses stemming adalah proses mengubah bentuk sebuah kata menjadi kata dasarnya. Untuk bahasa indonesia fungsi katadasaR dapat membantu kita melakukan proses stemming. Proses pembuatannya dapat dilihat pada kode di bawah ini :
stemming <- function(x){
gsub(" tang "," tangan ",paste(lapply(x,katadasar),collapse = " "))
}sms_contain <- convert.tm.to.character(sms.corpus.new)
sms_contain <- lapply(tokenize_words(sms_contain[]), stemming)
saveRDS(sms_contain,"data/sms_contain.rds")Pemrosesan stemming kata di awali dengan konversi file corpus hasil beberapa proses sebelumnya kembali ke bentuk character. Dengan inisiasi fungsi stemming pada data frame hasil conversi tersebut, kita mendapatkan sebuah list yang berisi hasil stemming.
Fungsi stemming ditambahkan gsub untuk mengubah kata " tang " menjadi " tangan " dikarenakan katadasaR tidak mengenal tangan sebagai sebuah kata tersendiri. Jika tangan merupakan kata yang berperan penting, hasil interpretasi secara deskripsi akan menjadi aneh.
katadasar("tangan")## [1] "tang"katadasaR("tangan")## [1] "tang"sms_contain <- readRDS("data/sms_contain.rds")
sms_contain[c(2,390,401,583,942,954,967,976)]## $`2`
## [1] "akses apps hari populer nikmat akses youtube habis habis beli pkt unlimited myim"
##
## $`390`
## [1] "dear aspen pesan nomor id jasa kirim info email"
##
## $`401`
## [1] "pagi gojek sana terima kasih smiley"
##
## $`583`
## [1] "depan tower ya"
##
## $`942`
## [1] "meikarta cikarang kota lengkap indah asia tenggara bf jt dapat disc promo pasti info"
##
## $`954`
## [1] "main main download nikmat game tom jerry mouse maze cookie crush match lara croft relic run dll rp mgg"
##
## $`967`
## [1] "ve invited boarding labs career discussion respond via email orang"
##
## $`976`
## [1] "tonton streaming liga indonesia langsung hp mu bareng teman teman tekan tarif rp sms info dbi"Akhirnnya proses text mining dan text cleansing kita telah selesai. Jika dilihat di atas, terdapat kata-kata aneh seperti bf, rp, mgg dll. Jangan khawatir karena saat proses nanti kita bisa memfilter berdasarkan kemunculan frequensi kata
3.5 Visualisasi Wordcloud
Setelah data processing selesai, kita dapat menampilkan kata-kata yang paling sering muncul dalam bentuk tabel dan juga wordcloud. Sebelum itu data dibentuk dalam tokenisasi per kata seperti pada kode di bawah:
sms.dtm <- DocumentTermMatrix(VCorpus(VectorSource(sms_contain)))
inspect(sms.dtm)## <<DocumentTermMatrix (documents: 2072, terms: 2184)>>
## Non-/sparse entries: 16667/4508581
## Sparsity : 100%
## Maximal term length: 22
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs balas beli bonus info internet kuota paket pulsa sms ulang
## 1071 0 0 1 2 0 0 2 2 7 0
## 1116 0 0 0 0 1 0 0 0 0 0
## 1136 0 0 0 0 0 0 0 0 1 0
## 1139 0 0 0 0 0 0 0 0 0 0
## 1175 0 0 0 1 0 0 0 0 0 0
## 1563 0 0 0 0 0 0 0 0 0 0
## 1594 0 0 0 0 0 0 0 0 0 0
## 1765 0 1 0 0 0 0 0 0 0 0
## 1883 0 0 0 0 0 0 0 0 0 0
## 319 0 0 4 0 0 0 0 2 0 1Dari keterangan di atas kita dapat melihat terdapat 2072 observasi dengan tiap observasi memiliki 2184 kata (variabel) yang unik.
Proses di bawah akan membantu kita melihat urutan kata berdasarkan frequensi kemunculannya, yang selanjutnya kita tampilkan bentuk wordcloud-nya.
m <- as.matrix(sms.dtm[1:1751,])
true_label <- case_when(sms$STATUS[1:1751] == "ham"~0,TRUE~1)
m <- cbind(m,true_label)
m_ham <- m[m[,2185] == 0,]
m_spam <- m[m[,2185] == 1,]
v <- sort(colSums(m),decreasing=TRUE)
v_ham <- sort(colSums(m_ham),decreasing=TRUE)
v_spam <- sort(colSums(m_spam),decreasing=TRUE)
d <- data.frame(word = names(v[-1]),freq=v[-1])
d_ham <- data.frame(word = names(v_ham[-1]),freq=v_ham[-1])
d_spam <- data.frame(word = names(v_spam[-1]),freq=v_spam[-1])
head(d,5)## word freq
## kuota kuota 299
## info info 268
## pulsa pulsa 251
## sms sms 187
## paket paket 1623.5.1 WordCloud Pada Setiap SMS
set.seed(1234)
layout(matrix(c(1, 2), nrow=2), heights=c(1, 4))
par(mar=rep(0, 4))
plot.new()
text(x=0.5, y=0.5, "WordCloud Pada Setiap SMS", cex = 2, col = "black")
wordcloud(words = d$word, freq = d$freq, min.freq = 40,
max.words=100, random.order=FALSE, rot.per=0.35,
colors= brewer.pal(8, "Dark2"), main = "Title")
3.5.2 WordCloud Pada Setiap SMS Ham
set.seed(1235)
layout(matrix(c(1, 2), nrow=2), heights=c(1, 5))
par(mar=rep(0, 4))
plot.new()
text(x=0.5, y=0.5, "WordCloud Pada Setiap SMS Ham", cex = 2, col = "black")
wordcloud(words = d_ham$word, freq = d_ham$freq, min.freq = 40,
max.words=100, random.order=FALSE, rot.per=0.35,
colors= brewer.pal(8, "Dark2"), main = "Title")
3.5.3 WordCloud Pada Setiap SMS Spam
set.seed(1236)
layout(matrix(c(1, 2), nrow=2), heights=c(1, 4))
par(mar=rep(0, 4))
plot.new()
text(x=0.5, y=0.5, "WordCloud Pada Setiap SMS Spam", cex = 2, col = "black")
wordcloud(words = d_spam$word, freq = d_spam$freq, min.freq = 40,
max.words=100, random.order=FALSE, rot.per=0.35,
colors= brewer.pal(8, "Dark2"), main = "Title")
4 Pembentukan model
Proses selanjutnya adalah membentuk data dalam format yang siap dimasukkan ke dalam model.
4.1 Naive Bayes Model
Proses awal adalah dengan melakukan split data menjadi data training dan data test. Di sini data dibagi menjadi 80 persen berupa data training dan 20 persen berupa data test. Data training dan data test memiliki proporsi sms berlabel ham dan spam yang serupa. Sebelum melakukan split data, kita juga akan memisahkan terlebih dahulu data unseen/tanpa label, yaitu row 1752 hingga 2072.
sms.dtm_train <- sms.dtm[1:1751,]
sms.dtm_unseen <- sms.dtm[1752:2072,]
dim(sms.dtm_train)## [1] 1751 2184dim(sms.dtm_unseen)## [1] 321 2184set.seed(100)
split_80 <- sample(nrow(sms.dtm_train), nrow(sms.dtm_train)*0.80)
sms_train <- sms.dtm_train[split_80, ]
sms_test <- sms.dtm_train[-split_80, ]
train_labels <- sms$STATUS[1:1751][split_80]
test_labels <- sms$STATUS[1:1751][-split_80]
prop.table(table(train_labels))## train_labels
## ham spam
## 0.6135714 0.3864286prop.table(table(test_labels))## test_labels
## ham spam
## 0.6467236 0.3532764Selanjutnya pembuatan fungsi bernouli untuk merubah nilai matriks pada setiap kata, jika lebih dari sama dengan 1 akan menjadi 1, dan 0 akan tetap 0. Fungsi ini bertujuan untuk membentuk one hot encoding.
bernoulli_conv <- function(x){
x <- as.factor(as.numeric(x > 0))
}Selanjutanya di bawah ini adalah pembuatan fungsi pemodelan naive bayes. Nantinya data input serta data test yang telah dipersiapkan pada frekuensi minimal tertentu dapat di training menggunakan fungsi ini. Hasil keluarannya adalah nilai-nilai confusion matriks dari data test. Fungsi dijalankan dengan menentukan jumlah perubahan laplace estimator yang akan ditest. Laplace estimator di-set untuk selalu start dari 1 demi menghindari observasi yang bernilai nol.
conf_funct <- function(x) {
prec <- c()
acc <- c()
recl <- c()
spec <- c()
lapl <- c()
for(l in 1:x) {
spam_model <- naiveBayes(train_bn, train_labels, laplace = l)
spam_prediction <- predict(spam_model, test_bn)
pred_df <- data.frame(table(prediction = spam_prediction, actual=test_labels))
y1= pred_df$Freq[4]/(pred_df$Freq[4]+pred_df$Freq[2])
y2= (pred_df$Freq[1]+pred_df$Freq[4])/(pred_df$Freq[1]+pred_df$Freq[2]+pred_df$Freq[3]+pred_df$Freq[4])
y3= pred_df$Freq[4]/(pred_df$Freq[4]+pred_df$Freq[3])
y4= pred_df$Freq[1]/(pred_df$Freq[1]+pred_df$Freq[2])
prec <- c(prec, y1)
acc <- c(acc, y2)
recl <- c(recl,y3)
spec <- c(spec,y4)
lapl <- c(lapl,l)
a <- data.frame(lapl,prec,acc,recl,spec)
}
return(a)
}4.1.1 Frekuensi Minimal 10
## [1] "Precission Range: "## [1] 0.8359375 0.8803419## [1] "Accuracy Range: "## [1] 0.7834758 0.9088319## [1] "Recall Range: "## [1] 0.4677419 0.9193548## [1] "Specificity Range: "## [1] 0.9030837 0.95594714.1.2 Frekuensi Minimal 20
## [1] "Precission Range: "## [1] 0.8396947 0.8750000## [1] "Accuracy Range: "## [1] 0.8262108 0.9088319## [1] "Recall Range: "## [1] 0.6129032 0.9112903## [1] "Specificity Range: "## [1] 0.9074890 0.94273134.1.3 Frekuensi Minimal 30
## [1] "Precission Range: "## [1] 0.8294574 0.8691589## [1] "Accuracy Range: "## [1] 0.8262108 0.9002849## [1] "Recall Range: "## [1] 0.6209677 0.8951613## [1] "Specificity Range: "## [1] 0.9030837 0.93832604.2 Pembahasan Performa NaiveBayes
Dari beberapa benchmark naive bayes di atas, terlihat kecenderungan recall dan akurasi akan menurun seiring ditingkatkannya laplace estimator pada model, baik pada data dengan min freq 10,20 ataupun 30. Dari ketiga frekuensi itupun, terlihat kesulitan naive bayes mendapatkan performa yang tinggi di semua nilainya, contohnya ketika recall turun maka precission cenderung meningkat.
Dari kesemua model tersebut, baik dari variasi frekuensi maupun lapl.estimator tidak mampu menghasilkan nilai precission hingga 90 persen. Dengan performa yang seperti ini, penggunaan model naive bayes diragukan memenuhi target Precission 90 persen, Accuracy 83 persen, Recall 80 persen, dan specificity 85 persen pada unseen data. Oleh karena itu mari kita coba menggunakan algoritma lain dalam klasifikasi sms spam.
4.3 Neural Network Model
Model selanjutnya yang akan kita bentuk adalah Neural Network. Demi mempercepat pemodelan, dan meningkatkan akurasi, input pada neural network juga akan menggunakan frequensi minimal.
4.3.1 Model 1
-Penggunaan Frekuensi Minimal 20
input_length <- ncol(sms_m)
input_length## [1] 210model1 <- keras_model_sequential()
model1 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model1)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 256) 53760
## ___________________________________________________________________________
## dense_2 (Dense) (None, 1) 257
## ===========================================================================
## Total params: 54,017
## Trainable params: 54,017
## Non-trainable params: 0
## ___________________________________________________________________________model1 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adam(),
metrics = c('accuracy')
)history1 <- model1 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 125,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length])
)model1 <- load_model_hdf5("data/nn_model1.h5")
class_pred_model1 <- model1 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model1),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 224 20
## 1 3 104
##
## Accuracy : 0.9345
## 95% CI : (0.9033, 0.958)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.852
##
## Mcnemar's Test P-Value : 0.0008492
##
## Sensitivity : 0.8387
## Specificity : 0.9868
## Pos Pred Value : 0.9720
## Neg Pred Value : 0.9180
## Prevalence : 0.3533
## Detection Rate : 0.2963
## Detection Prevalence : 0.3048
## Balanced Accuracy : 0.9127
##
## 'Positive' Class : 1
## 4.3.2 Model 2
-Penggunaan Frekuensi Minimal 20
input_length <- ncol(sms_m)
input_length## [1] 210model2 <- keras_model_sequential()
model2 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model2)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_3 (Dense) (None, 256) 53760
## ___________________________________________________________________________
## dense_4 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dense_5 (Dense) (None, 1) 129
## ===========================================================================
## Total params: 86,785
## Trainable params: 86,785
## Non-trainable params: 0
## ___________________________________________________________________________model2 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adam(),
metrics = c('accuracy')
)history2 <- model2 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 125,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length])
)model2 <- load_model_hdf5("data/nn_model2.h5")
class_pred_model2 <- model2 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model2),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 226 33
## 1 1 91
##
## Accuracy : 0.9031
## 95% CI : (0.8673, 0.932)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7748
##
## Mcnemar's Test P-Value : 1.058e-07
##
## Sensitivity : 0.7339
## Specificity : 0.9956
## Pos Pred Value : 0.9891
## Neg Pred Value : 0.8726
## Prevalence : 0.3533
## Detection Rate : 0.2593
## Detection Prevalence : 0.2621
## Balanced Accuracy : 0.8647
##
## 'Positive' Class : 1
## 4.3.3 Model 3
-Penggunaan Frekuensi Minimal 20
input_length <- ncol(sms_m)
input_length## [1] 210model3 <- keras_model_sequential()
model3 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 64, activation = 'relu') %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model3)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_6 (Dense) (None, 256) 53760
## ___________________________________________________________________________
## dense_7 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dense_8 (Dense) (None, 64) 8256
## ___________________________________________________________________________
## dense_9 (Dense) (None, 1) 65
## ===========================================================================
## Total params: 94,977
## Trainable params: 94,977
## Non-trainable params: 0
## ___________________________________________________________________________model3 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adam(),
metrics = c('accuracy')
)history3 <- model3 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 125,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length])
)model3 <- load_model_hdf5("data/nn_model3.h5")
class_pred_model3 <- model3 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model3),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 225 21
## 1 2 103
##
## Accuracy : 0.9345
## 95% CI : (0.9033, 0.958)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8514
##
## Mcnemar's Test P-Value : 0.0001746
##
## Sensitivity : 0.8306
## Specificity : 0.9912
## Pos Pred Value : 0.9810
## Neg Pred Value : 0.9146
## Prevalence : 0.3533
## Detection Rate : 0.2934
## Detection Prevalence : 0.2991
## Balanced Accuracy : 0.9109
##
## 'Positive' Class : 1
## 4.3.4 Model 4
-Penggunaan Frekuensi Minimal 20
input_length <- ncol(sms_m)
input_length## [1] 210model4 <- keras_model_sequential()
model4 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model4)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_10 (Dense) (None, 256) 53760
## ___________________________________________________________________________
## dense_11 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dense_12 (Dense) (None, 1) 129
## ===========================================================================
## Total params: 86,785
## Trainable params: 86,785
## Non-trainable params: 0
## ___________________________________________________________________________model4 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adam(),
metrics = c('accuracy')
)history4 <- model4 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 200,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length])
)model4 <- load_model_hdf5("data/nn_model4.h5")
class_pred_model4 <- model4 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model4),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 226 21
## 1 1 103
##
## Accuracy : 0.9373
## 95% CI : (0.9066, 0.9603)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8576
##
## Mcnemar's Test P-Value : 0.00005104
##
## Sensitivity : 0.8306
## Specificity : 0.9956
## Pos Pred Value : 0.9904
## Neg Pred Value : 0.9150
## Prevalence : 0.3533
## Detection Rate : 0.2934
## Detection Prevalence : 0.2963
## Balanced Accuracy : 0.9131
##
## 'Positive' Class : 1
## 4.3.5 Model 5
-Penggunaan Frekuensi Minimal 20
input_length <- ncol(sms_m)
input_length## [1] 210model5 <- keras_model_sequential()
model5 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model5)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_13 (Dense) (None, 256) 53760
## ___________________________________________________________________________
## dense_14 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dense_15 (Dense) (None, 1) 129
## ===========================================================================
## Total params: 86,785
## Trainable params: 86,785
## Non-trainable params: 0
## ___________________________________________________________________________model5 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adamax(),
metrics = c('accuracy')
)history5 <- model5 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 225,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length])
)model5 <- load_model_hdf5("data/nn_model5.h5")
class_pred_model5 <- model5 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model5),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 219 4
## 1 8 120
##
## Accuracy : 0.9658
## 95% CI : (0.941, 0.9822)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.9257
##
## Mcnemar's Test P-Value : 0.3865
##
## Sensitivity : 0.9677
## Specificity : 0.9648
## Pos Pred Value : 0.9375
## Neg Pred Value : 0.9821
## Prevalence : 0.3533
## Detection Rate : 0.3419
## Detection Prevalence : 0.3647
## Balanced Accuracy : 0.9662
##
## 'Positive' Class : 1
## 4.3.6 Model 6
-Penggunaan Frekuensi Minimal 30
input_length <- ncol(sms_m)
input_length## [1] 139model6 <- keras_model_sequential()
model6 %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(input_length-1)) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dense(units = 1, activation = 'sigmoid')
summary(model6)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_16 (Dense) (None, 256) 35584
## ___________________________________________________________________________
## dense_17 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dense_18 (Dense) (None, 1) 129
## ===========================================================================
## Total params: 68,609
## Trainable params: 68,609
## Non-trainable params: 0
## ___________________________________________________________________________model6 %>% compile(
loss = 'binary_crossentropy',
optimizer = optimizer_adamax(),
metrics = c('accuracy')
)history6 <- model6 %>% fit(
sms_m[,-input_length], sms_m[,input_length],
epochs = 225,
batch_size = 64,
validation_data = list(sms_m_test[,-input_length],sms_m_test[,input_length]),
callback=callback_early_stopping(monitor = "acc",mode = "max",patience = 15)
)model6 <- load_model_hdf5("data/nn_model6.h5")
class_pred_model6 <- model6 %>% predict_classes(sms_m_test[,-input_length])
confusionMatrix(as.factor(class_pred_model5),as.factor(sms_m_test[,input_length]),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 219 4
## 1 8 120
##
## Accuracy : 0.9658
## 95% CI : (0.941, 0.9822)
## No Information Rate : 0.6467
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.9257
##
## Mcnemar's Test P-Value : 0.3865
##
## Sensitivity : 0.9677
## Specificity : 0.9648
## Pos Pred Value : 0.9375
## Neg Pred Value : 0.9821
## Prevalence : 0.3533
## Detection Rate : 0.3419
## Detection Prevalence : 0.3647
## Balanced Accuracy : 0.9662
##
## 'Positive' Class : 1
## 4.4 Pembahasan Performa Neural Network
Dapat kita lihat bahwa performa Neural Network jauh lebih baik jika dibandingkan dengan NaiveBayes. Dengan neural network, akurasi dan presisi cukup konsisten di kisaran 90 persen, dimana sangat sulit dilakukan NaiveBayes.
Dari metode Neural Network dibuat 6 jenis algoritma yang sedikit berbeda :
- Model simple tanpa hidden layer dengan epochs 125
- Model dengan tambahan 1 hidden layer dengan epochs 125
- Model deep learning (2 hidden layer) dengan epochs 125
- Layer sama dengan model no 2 tetapi menggunakan epochs 200
- Layer sama dengan model 2 dan 4 tetapi menggunakan optimizer adamax dan epochs 225
- Sama dengan model 5 dengan paramter callback yg berhenti pada epochs 150, Input dengan frekuensi min 30
Mengacu pada target unseen data yang ingin ditebak yaitu Presisi, Akurasi, Recall dan Specificity adalah 90,83,80,85 persen. Dari ke lima model tersebut, model 6 lah yang paling baik melakukan prediksi karena semua performance confusion matriksnya sangat tinggi yaitu 94,97,97,dan 96 persen untuk presisi,akurasi,recall dan specificity. Dan dengan epochs yang lebih sedikit mampu menghasilkan performa yang sangat baik.
Kitapun dapat melihat performa proses training model 6 pada plot di bawah :
history <- readRDS("data/nn_history6.rds")
plot(1:150,history$metrics$acc,type="l",col="blue",ylim=c(0,1),xlab = "Epochs",ylab = "Akurasi")
lines(history$metrics$val_acc, col="green")
legend("bottomleft", c("train","val"), col=c("blue", "green"), lty=c(1,1))
title(main = "Akurasi Training dan Validasi Model 6")
plot(1:150,history$metrics$loss,type="l",col="blue",ylim=c(0,1),xlab = "Epochs",ylab = "Loss")
lines(history$metrics$val_loss, col="green")
legend("bottomleft", c("train","val"), col=c("blue", "green"), lty=c(1,1))
title(main = "Loss Training dan Validasi Model 6")
Terlihat bahwa selama proses training antara akurasi pada data training dan validasinya (data test) memiliki nilai yang berdekatan tidak ada jumping dikarenakan filter 30 berhasil membersihkan noise dari kata-kata dengan frekuensi kemunculan sedikit. Dengan bukti performa ini kita yakin bahwa model yang didapat tidak mengalami underfitting ataupun overfitting. Selain itu loss pada kedua data juga semakin mengecil seiring bertambahnya epochs.
Oleh sebab-sebab itu maka diputuskan model 6 neural network akan digunakan untuk prediksi unseen data sms.
5 Prediksi Unseen Data SMS
Ini adalah tahap terkahir, yaitu melakukan prediksi pada unseen data.
Pertama kita mengambil prediktor(kata) dengan minimal frekuensi yang sama saat melakukan pemodelan neural network model 6, yaitu 30.
Perlu dipastikan juga input untuk prediksi ini merupakan matriks dengan tipe yang sama dengan saat pembuatan training model 6.
freq =30
sms_freq <- findFreqTerms(sms.dtm, freq)
sms_unseen_freq <- sms.dtm_unseen[,sms_freq]
train_bn_nn_unseen <- apply(sms_unseen_freq, 2, bernoulli_conv)
train_bn_nn_unseen_df <- data.frame(train_bn_nn_unseen) %>%
mutate_if(is.factor,as.numeric)
train_bn_nn_unseen_m <- model.matrix(~.,data = train_bn_nn_unseen_df)
train_bn_nn_unseen_m <- train_bn_nn_unseen_m[,-1]
dim(train_bn_nn_unseen_m)## [1] 321 138Kita berhasil mendapatkan matriks dengan jumlah prediktor(kata) sebanyak 138.
Untuk memastikan kesamaan prediktor dengan data training kita bisa gunakan :
identical(colnames(sms_m[,-input_length]),colnames(train_bn_nn_unseen_m))## [1] TRUEPerbandingan isi matriks data training dan data yang akan di prediksi :
sms_m[1,c(1:3)]## akses aktif aplikasi
## 1 1 2train_bn_nn_unseen_m[1,c(1:3)]## akses aktif aplikasi
## 1 1 1Selanjutnya kita bisa prediksi label pada unseen data dengan model 6, setelah itu dapat kita lihat proporsi sms spam dan ham.
class_pred_model6_unseen <- model6 %>% predict_classes(train_bn_nn_unseen_m)
sms_unseen_pred <- sms_unseen %>%
mutate(STATUS = class_pred_model6_unseen) %>%
mutate(
STATUS = case_when(
STATUS == "0"~"ham",
TRUE ~ "spam"
)
) %>%
mutate_at(vars(STATUS),as.factor)
table(sms_unseen_pred$STATUS)##
## ham spam
## 118 203round(prop.table(table(sms_unseen_pred$STATUS))*100,2)##
## ham spam
## 36.76 63.24Ternyata ada sekitar 63 persen email spam pada unseen data berdasarkan tebakan model 6.
Berikut beberapa contoh hasil prediksi model 6
set.seed(6)
sms_unseen_pred[sample(nrow(sms_unseen_pred),5),c(2,3)]## CONTAIN
## 195 BRONET 24Jam 2GB hny Rp24.900 (normal Rp29.900) bisa buat nonton IFLIX dg beli di *123*888# / AXISNET.Yuk, beli paketnya spy WEEKND-mu SERU..!! Info838.AXIS007
## 301 ini sms nek aku gabisa nerima gambar, charger hape aku ketinggalan di cibubur kemarin jadi pakai hape yang lama
## 85 Only for Staff! Register w/CIMBNiaga email at shop.samsung .com/id_epp/cimbniaga. Disc upto 30%+Add Disc selected items +0% upto 24mos till 31Mar18. Info 14041
## 121 (CITITRANS)CT: Pesanan anda tujuan Dipati Ukur-Fatmawati pd 2018-03-25 17:15:00 dgn no kursi Ä2Ñ tercatat dgn kode booking BOCC1803251521964582609483
## 256 Proses PEMBLOKIRAN bg yg blm REGISTRASI sdg berjalan. SEGERA REGISTRASI ULANG. Dptkan BONUS 10GB+Nelpon&SMS sepuasnya u/3hr. Ketik ULANG#NIK#No.KK# SMS ke4444
## STATUS
## 195 spam
## 301 ham
## 85 spam
## 121 ham
## 256 spamSekian dokumentasi penentuan model dan prediksi sms spam pada data yang belum memiliki label. Mudah-mudahan dokumentasi ini dapat menjadi bahan pelajaran yang bermanfaat. Sekian dan Terimakasih.