垃圾短信过滤程序

使用文本分类的方法判别垃圾短信的方法是NLP领域的一个非常经典的应用。其实简单来讲就是让人类的自然语言转化成模型能够“读懂”的矩阵语言。其次,数据集必须有标签,这样才能使用SVM等方法进行有监督学习。

这篇文章是我为了熟悉NLP基本概念进行的练习。训练模型的步骤很简单。稍微有点困难的是将任何一个新的数据代入训练好的模型进行判别。这需要一定的编程技巧来解决。

更困难的是将训练结果产品化,做成一个交互式的用户界面,部署在网络上。让所有用户登上网页直接就能用这个模型。这就涉及到Shiny App的知识。

世上无难事只怕有心人。我还真把这两个功能都做出来了。其实并不需要很多的编程知识。只需要深入了解一点R就可以了。Shiny App的部署方法在文末。实际上本篇对自己也仅仅是个抛砖引玉。更强算力、更多功能的程序还需要更精深的编程知识,只会R就不够啦。这个分析我也使用同样的数据用Python做了一遍,可以做个比较。

还有,我以前习惯用<-赋值,最近开始用=赋值,是因为=不仅方便还能和其他语言保持一致。于是,使用RStudio自带的Replace功能,一家伙替换掉了。

首先…

使用read_csv读取数据后无需使用tibble函数转化。read_csv能够直接得到tibble对象。不然会报错。

R在构建文档-词语矩阵的有许多实现方式。下面使用了tm::DocumentTermMatrix函数实现。在此之前,我尝试了quanteda::dfm_weight函数,但是在我的本地R软件中总是报错(在Kaggle上的R Notebook能够运行)。另一个可能的路径是使用tidytext::unnest_tokens等函数进行去除停止词、去除数字和标点符号、提取词干等一系列操作;再通过tidytext::cast_dtm转化成DocumentTermMatrix对象。但这么做会导致因变量和特征矩阵行数不一致的问题。由于我无法解决它,我采用了下面的方案。当然使用Python是非常好的选择,我在这里给出了基于Python的做法。相比R,Python的可视化能力略显不足。

我认为tidytext十分适合对文本信息进行探索和可视化,而tm则适合构建矩阵进行建模。如果将二者混用则可能导致问题。

上代码

library(magrittr)
library(quanteda)
library(tidytext)
library(ggplot2)
library(dplyr)
library(tm)
library(readr)
library(stringr)
sms = read_csv("E:/MaLearning/SPAM text message 20170820 - Data.csv")

原数据共两列,其中一列记录了是否为垃圾短信的标签。垃圾邮件记为spam,非垃圾邮件记为ham。另一列是短信文本内容。其中,非垃圾邮件的比例约为0.87,垃圾邮件的比例为0.13。

#因变量比例
sms %>% count(Category)
# # A tibble: 2 x 2
#   Category     n
#   <chr>    <int>
# 1 ham       4825
# 2 spam       747
#sms %$% prop.table(table(Category))[1]

数据概览如下,数据共2列,第1列为标签,第2列为文本内容:

smswd = sms %>%
  rename(message = Message,tag=Category) %>% 
  mutate(ID = row_number())
head(smswd)
# # A tibble: 6 x 3
#   tag   message                                                          ID
#   <chr> <chr>                                                         <int>
# 1 ham   Go until jurong point, crazy.. Available only in bugis n gre~     1
# 2 ham   Ok lar... Joking wif u oni...                                     2
# 3 spam  Free entry in 2 a wkly comp to win FA Cup final tkts 21st Ma~     3
# 4 ham   U dun say so early hor... U c already then say...                 4
# 5 ham   Nah I don't think he goes to usf, he lives around here though     5
# 6 spam  FreeMsg Hey there darling it's been 3 week's now and no word~     6
Y = as.factor(smswd$tag)
smswd$message = lapply(smswd$message , iconv, "UTF-8", "ASCII", sub="")

smsvis = smswd %>%
  unnest_tokens(word,message) %>% # 分词
  filter(str_detect(word, "^[a-z]+$")) %>% #使用正则匹配英文
  anti_join(stop_words) %>% # 去除停止词
  mutate(word = SnowballC::wordStem(word,language = "english")) # 提取词干
head(smsvis)
# # A tibble: 6 x 3
#   tag      ID word  
#   <chr> <int> <chr> 
# 1 ham       1 jurong
# 2 ham       1 crazi 
# 3 ham       1 bugi  
# 4 ham       1 world 
# 5 ham       1 la    
# 6 ham       1 buffet
library(reshape2)
library(wordcloud)
smsvis %>% # 词云图,颜色代表不同类别
  count(word, tag, sort = T) %>%
  acast(word ~ tag, value.var = "n", fill = 0) %>%
  comparison.cloud(colors = c("blue", "red"),max.words = 50)
可以看出垃圾信息大量使用了call、free等营销相关的词语。而普通信息则更多是日常交流用语

Figure 1: 可以看出垃圾信息大量使用了call、free等营销相关的词语。而普通信息则更多是日常交流用语

smsvis %>% # 不同类别信息的词频统计
  count(tag, word) %>%
  group_by(tag) %>%
  top_n(15) %>%
  ggplot() +
  geom_col(aes(reorder(word, n), 
               n, fill = tag),
           show.legend = F) +
  facet_wrap(~tag, scales = "free_y") +
  coord_flip()

smsvis %>% # 不同类别信息的tf-idf值
  count(tag, word) %>%
  bind_tf_idf(word,tag,n) %>% 
  group_by(tag) %>%
  top_n(10) %>%
ggplot() + 
  geom_col(aes(reorder(word,tf_idf), 
             tf_idf, fill = tag),
           show.legend = F) +
  facet_wrap(~tag, scales = "free_y") +
  coord_flip()

ms_corpus = VCorpus(VectorSource(smswd$message))

sms_dtm = DocumentTermMatrix(ms_corpus, control =
                                 list(tolower = T,
                                      removeNumbers = T,
                                      stopwords = T,
                                      removePunctuation = T,
                                      stemming = T))

dim(sms_dtm) #5572
# [1] 5572 6953
sms_dtm1 = removeSparseTerms(sms_dtm, sparse = .98)
smsmat = as.matrix(sms_dtm1) # 训练数据集
dim(smsmat)
# [1] 5572   51
colnames(smsmat)
#  [1] "ask"   "back"  "call"  "can"   "come"  "day"   "dont"  "free" 
#  [9] "get"   "give"  "good"  "got"   "home"  "hope"  "just"  "know" 
# [17] "later" "like"  "lor"   "love"  "ltgt"  "make"  "meet"  "mobil"
# [25] "need"  "new"   "now"   "one"   "phone" "pleas" "repli" "say"  
# [33] "see"   "send"  "sorri" "still" "stop"  "take"  "tell"  "text" 
# [41] "think" "time"  "today" "tri"   "txt"   "want"  "week"  "well" 
# [49] "will"  "work"  "you"

原本的文档-词语频率矩阵有6953个特征,维度过高且过于稀疏。经过removeSparseTerms函数处理后保留了51个特征。

算法

朴素贝叶斯常常被用作文本分类的基线模型。因为文本数据满足每个单词相互独立。而且,一个单词的位置不依赖于另一个单词。也就是说,用于建模的文档-词语频率矩阵(DTM)各列独立,这满足了朴素贝叶斯的独立性假设。此外,为了提高准确率,我还进一步使用了支持向量机方法。支持向量机则是一种性能很强的分类器,可以实现非线性划分。

支持向量机对螺旋数据集分类的决策边界

Figure 2: 支持向量机对螺旋数据集分类的决策边界

library(caret)
library(e1071)
svmc = svm(smsmat, Y)
#saveRDS(svmc, "svmc.rds")
print(svmc)
# 
# Call:
# svm.default(x = smsmat, y = Y)
# 
# 
# Parameters:
#    SVM-Type:  C-classification 
#  SVM-Kernel:  radial 
#        cost:  1 
#       gamma:  0.01960784 
# 
# Number of Support Vectors:  1386
summary(svmc)
# 
# Call:
# svm.default(x = smsmat, y = Y)
# 
# 
# Parameters:
#    SVM-Type:  C-classification 
#  SVM-Kernel:  radial 
#        cost:  1 
#       gamma:  0.01960784 
# 
# Number of Support Vectors:  1386
# 
#  ( 855 531 )
# 
# 
# Number of Classes:  2 
# 
# Levels: 
#  ham spam
pred = predict(svmc,smsmat)
#confusionMatrix(pred,Y,positive ='spam',mode="prec_recall")
conMatrix = confusionMatrix(pred,Y,
                             positive ='spam',
                             mode="prec_recall") 
conMatrix[["table"]]
#           Reference
# Prediction  ham spam
#       ham  4757  124
#       spam   68  623
# klaR包也能够实现NaiveBayes.
nb = naiveBayes(smsmat, Y) # 得到模型

#setwd('F:/Mysite/Mysite/static/archives/Rbasic')
#保留模型对象
#saveRDS(nb, "naiveBayes.rds")
#readRDS("naiveBayes.rds")
#save(nb,"naiveBayes.RData")
#load("naiveBayes.RData")

pred1 = predict(nb,smsmat)

conMatrix1 = confusionMatrix(pred1,Y,
                              positive ='spam',
                              mode="prec_recall") 
#混淆矩阵
conMatrix1[["table"]]
#           Reference
# Prediction  ham spam
#       ham  1991   48
#       spam 2834  699
#混淆矩阵
prop.table(conMatrix1[["table"]],1)
#           Reference
# Prediction        ham       spam
#       ham  0.97645905 0.02354095
#       spam 0.80215115 0.19784885

限于精力,我就不调参了。
支持向量机算法的准确率为0.97,平衡准确率为0.91。

朴素贝叶斯算法的准确率为0.48,平衡准确率为0.67。

编写一个对混淆矩阵进行可视化的函数plot_table。这个函数其实就是对ggplot2进行了一个简单封装。如果你经常浏览Kaggle的Kernels,你会发现很多人使用这种矩阵图:

plot_table = function(x,xlab='Predicted label',
                       ylab='True label',
                       normalize = F){
  if(normalize){
    x = round(prop.table(x,1), 2)
    mar = as.data.frame(x)
  }
  else{
    mar = as.data.frame(x)
  }
  ggplot2::ggplot(mar,aes(mar[,2],mar[,1])) +
    geom_tile(aes(fill=Freq),color='black') +
    scale_fill_gradientn(colours = c('gray98',
                                     'steelblue1',
                                     'midnightblue'))+
    geom_label(aes(label = Freq)) +
     labs(fill='',x=xlab,y=ylab) +
     ylim(rev(levels(mar[,2])))+
     scale_y_discrete(expand=c(0,0))+
     scale_x_discrete(expand=c(0,0))
}

class(conMatrix1[["table"]])
# [1] "table"
plot_table(conMatrix1[["table"]],'Reference','Prediction')+
  theme_bw()

plot_table(conMatrix1[["table"]])+
  theme_bw()

plot_table(conMatrix1[["table"]],'Reference','Prediction',normalize=T)+
  theme_bw()

抛开准确率问题不谈,这里有另一个问题,为了避免不必要的损失,大部分人更希望过滤系统尽可能不要把有用的信息删掉。也就是说:

宁可放过一千也不要错杀一个。

所以,对于这个任务来说,算法的精确率越高越好,召回率(或者说查全率)越低越好。根据混淆矩阵,SVM的召回率为0.83,朴素贝叶斯的召回率为0.94。SVM的精确率为0.9,朴素贝叶斯的精确率为0.2。从混淆矩阵中我们也能看出,朴素贝叶斯算法将更多普通短信归类于垃圾短信了。因此SVM显然是更佳的模型。

应用

下面我们用自己输入的短信文本放入朴素贝叶斯模型进行评价。同样,我们编写若干函数用于进行新数据的判别。其中,convert_dtm用于将新的字符串转换为DTM。注意:这个函数最重要的功能是使新DTM的列不超出训练集。众所周知,训练集和测试集的列必须一一对应。否则某些模型将会无法计算。 test_result用于得到新数据的预测结果。输入短信字符串,输出垃圾/非垃圾短信的判别结果:

#2个新的短信字符串
new = 'please go home at 4 o clock bro' #非垃圾短信

new2 = 'We are trying to call you.Please call our customer service representative on FREEPHONE.Claim code S89. Valid 12hrs only' # 垃圾短信

#对于新数据集。判断DTM的每一列是否在训练集中出现。
#出现保留,没出现剔除,补充空列。
convert_dtm = function(string){ # 得到新数据的DTM
test_dtm = VCorpus(VectorSource(string)) %>% 
  DocumentTermMatrix(., control = list(tolower = T,
                                      removeNumbers = T,
                                      stopwords = T,
                                      removePunctuation = T,
                                      stemming = T)) %>% 
  as.matrix()

smmat = smsmat[1,]  # smsmat 为训练集DTM,提取第一行
smmat = as.data.frame(smmat) # 将matrix转化为data.frame
smmat[,1] = 0 # 将此列所有值设为0
smmat = t(smmat) # 转置
sp = colnames(smmat) %in% colnames(test_dtm) # 判断新数据集在训练集中出现的列
sp2 = colnames(test_dtm) %in% colnames(smmat)
smmat[,sp] = test_dtm[,sp2]  # 提取在训练集中出现的列,将对应的值重编码为频率
return(smmat)
}


test_result = function(model,string){ # 得到新数据的预测结果
  ms_corpus = VCorpus(VectorSource(string))
test_dtm = DocumentTermMatrix(ms_corpus, control =
                                 list(tolower = T,
                                      removeNumbers = T,
                                      stopwords = T,
                                      removePunctuation = T,
                                      stemming = T))
test_dtm = as.matrix(test_dtm)

smmat = smsmat[1,] 
smmat = as.data.frame(smmat) 
smmat[,1] = 0 
smmat = t(smmat)
sp = colnames(smmat) %in% colnames(test_dtm)
sp2 = colnames(test_dtm) %in% colnames(smmat)
smmat[,sp] = test_dtm[,sp2]
result = predict(model,smmat)
result = as.character(result)
return(result)
}

#可以看出'call'的词频为2
convert_dtm(new2)
#       ask back call can come day dont free get give good got home hope
# smmat   0    0    2   0    0   0    0    0   0    0    0   0    0    0
#       just know later like lor love ltgt make meet mobil need new now one
# smmat    0    0     0    0   0    0    0    0    0     0    0   0   0   0
#       phone pleas repli say see send sorri still stop take tell text think
# smmat     0     0     0   0   0    0     0     0    0    0    0    0     0
#       time today tri txt want week well will work you
# smmat    0     0   1   0    0    0    0    0    0   0
# 现在进行结果预测
test_result(nb,new)
# [1] "ham"
test_result(nb,new2)
# [1] "spam"
test_result(svmc,new)
# [1] "ham"
test_result(svmc,new2)
# [1] "spam"

经过检验,支持向量机不能支持新数据的预测。如果新的测试集的变量超出了训练集的变量,就无法运行。而朴素贝叶斯可以(我没弄清楚为什么)。不过无所谓,我们的test_result函数完美解决了这个问题。理论上我们可以训练任何一种模型然后测试新数据。

另外,为了更好地分享短信过滤程序,我将训练好的新模型保存下来并编写成Shiny App。使得用户输入任意短信文本就能在用户友好的图形界面的得到判定结果。用户可以点击这里查看Shiny App的源代码。本来我将这个App部署到了shinyapps.io这个网站上,但它免费版的服务非常不靠谱,几乎是点进去就崩溃。所以想使用它的话,可以在本地的R中输入代码下载并运行这个程序:

library(shiny)
runGitHub( "txtnb", "songxxiao")