6.3、朴素贝叶斯之垃圾邮件过滤

最新推荐文章于 2022-03-10 19:37:09 发布

**码上人生**

最新推荐文章于 2022-03-10 19:37:09 发布

阅读量4.1k

点赞数

分类专栏：机器学习分类监督学习文章标签：朴素贝叶斯垃圾邮件过滤机器学习

本文链接：https://blog.csdn.net/qq_16365849/article/details/50649902

版权

机器学习同时被 3 个专栏收录

64 篇文章 4 订阅

订阅专栏

分类

15 篇文章 0 订阅

订阅专栏

监督学习

12 篇文章 0 订阅

订阅专栏

利用朴素贝叶斯来判断垃圾短信

这里我们以判断垃圾短信为例，数据来自sms spam数据集

1、数据准备----把数据下载后读入：

>setwd("G:/R/Rworkspace/mail/")

> sms_raw <- read.table("SMSSpamCollection.txt",stringsAsFactors=F, sep="\t", header=F, comment="",quote=NULL, encoding="UTF-8") 注意：在读取外部数据集时，1369/2730/4421行都含有特殊字符，需要删除后再读取。

> sms_raw <-read.table("G:/R/Rworkspace/mail/SMSSpamCollection.txt",stringsAsFactors=F, sep="\t", header=F, comment="",quote=NULL,encoding="UTF-8") 此命令等价于上面的两条命令

> str(sms_raw)

'data.frame': 5574 obs. of 2 variables:

$ V1: chr "ham" "ham""spam" "ham" ...

$ V2: chr "Go until jurong point, crazy..Available only in bugis n great world la e buffet... Cine there got amorewat..." "Ok lar... Joking wif u oni..." "Free entry in 2 awkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receiveentry question(std txt rate)T&C"| __truncated__ "U dun say soearly hor... U c already then say..." ...

> names(sms_raw) <- c("type", "text") 给数据集命名

> str(sms_raw)

'data.frame': 5574 obs. of 2 variables:

$ type:chr "ham" "ham""spam" "ham" ...

$ text:chr "Go until jurong point, crazy..Available only in bugis n great world la e buffet... Cine there got amorewat..." "Ok lar... Joking wif u oni..." "Free entry in 2 awkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receiveentry question(std txt rate)T&C"| __truncated__ "U dun say soearly hor... U c already then say..." ...

注意：如果在read.table里面不指定quote=NULL那么会遇到如下问题 Warning message:In scan(file, what, nmax, sep, dec, quote, skip, nlines, na.strings,: EOF within quoted string实际上你如果仔细研究一下数据，你可以发现这是因为数据里面的5082行开始有""导致。

接下来将type转换为factor变量，因为贝叶斯分类要求目标变量为factor类型。

> sms_raw$type<- factor(sms_raw$type)

>table(sms_raw$type)

ham spam

4827 747

数据集里面有4827条正常短信，747条垃圾短信

2、数据预处理

对于文本的分析通常我们会用到tm包

> library(tm)

> sms_corpus <- Corpus(VectorSource(sms_raw$text)) 这里将原始数据中的短消息都作为向量输入来构建语料库

VectorSource（x）：将一个文本向量创建为一个向量源，向量源解释向量的每一个元素作为一个文档；x为一个向量的文本；

Corpus（）：语料库的呈现与计算。语料库是包含（自然语言）文本的文档集合。其中采用包TM提供基础设施软件包，例如语料库表示通过虚拟S3类语料库：这样的套餐提供S3语料库类扩展虚拟基类（如vcorpus包装TM本身提供）。

>print(sms_corpus)

<<VCorpus>>

Metadata: corpus specific: 0, document level (indexed):0

Content: documents: 5574

> inspect(sms_corpus[1:3]) 获取前3条短信的详细信息

<<VCorpus>>

Metadata: corpus specific: 0, document level (indexed):0

Content: documents: 3

[[1]]

<<PlainTextDocument>>

Metadata: 7

Content: chars: 111 注意：这里只给出了字符的数量，但原测试显示了内容。

[[2]]

<<PlainTextDocument>>

Metadata: 7

Content: chars: 29

[[3]]

<<PlainTextDocument>>

Metadata: 7

Content: chars: 155

inspect（）函数：显示语料库或术语文档矩阵的详细信息

这里可以看出语料库有5574个文档，实际与我们的数据集样本数一样。每个文档对应的就是一条短信。从前3条短信我们看出，文档的里面有标题，数字，还有标点符号，以及大小写，为了方便分析我们进行如下处理：

> corpus_clean <- tm_map(sms_corpus, tolower) 把所有词转换为小写字母

> corpus_clean <- tm_map(corpus_clean, removeNumbers) 去掉数字

> corpus_clean <- tm_map(corpus_clean, removeWords,stopwords()) 去掉停止词

> corpus_clean <- tm_map(corpus_clean, removePunctuation) 去掉标点

> corpus_clean <- tm_map(corpus_clean, stripWhitespace) 去掉空格

> corpus_clean<- tm_map(corpus_clean, PlainTextDocument)

>inspect(corpus_clean[1:3])

<<VCorpus>>

Metadata: corpus specific: 0, document level (indexed):0

Content: documents: 3

[[1]]

[1] go jurong pointcrazy available bugis n great world la e buffet cine got amore wat

[[2]]

[1] ok lar jokingwif u oni

[[3]]

[1] free entry wklycomp win fa cup final tkts st may text fa receive entry questionstd txt ratetcsapply s

tm_map():语料库的转换；应用转换函数（映射）到语料库的接口。

以上依次把所有词转换为小写，去掉数字，去掉停止词（就是类似and，or，the之类，也就是冠词、介词、副词或连词），去掉标点，最后去掉所有空格。

3、统计词频：完成了上述步骤，我们就需要统计每个词在文档中出现的频率了，这可以通过构建document term稀疏矩阵完成，这个稀疏矩阵的行对应一个文档，列则对应了每个词。term document则反过来。

> sms_dtm <- DocumentTermMatrix(corpus_clean) 构建document term稀疏矩阵,稀疏矩阵的行对应一个文档，列则对应了每个词

<<DocumentTermMatrix(documents: 5574, terms: 7929)>>

Non-/sparse entries:43087/44153159

Sparsity : 100%

Maximal term length:40

Weighting : term frequency (tf)

DocumentTermMatrix()：构建一个术语文档矩阵或文件项矩阵

1）、准备训练与测试数据

有了上面的矩阵，我们就可以开始准备训练数据与测试数据了，还是用caret包的createDataPartition来完成，可以看出训练与测试数据中的垃圾短信比例都相似。

> library(caret)

> set.seed(2014)

> inTrain <-createDataPartition(y=sms_raw$type, p=0.75, list=F)

> sms_raw_train<- sms_raw[inTrain, ]

> sms_raw_test <- sms_raw[-inTrain, ] 获取训练集和测试集数据

> sms_dtm_train<- sms_dtm[inTrain, ]

> sms_dtm_test <- sms_dtm[-inTrain, ] 从document term稀疏矩阵中获取训练集和测试集数据

>sms_corpus_train <- corpus_clean[inTrain]

> sms_corpus_test <- corpus_clean[-inTrain] 从语料库中获取训练集和测试集数据

> table(sms_raw_train$type) 列联表，列出频数

ham spam

3621 561

> prop.table(table(sms_raw_train$type)) 列出边缘表的频率，参数为列联表

ham spam

0.8658537 0.1341463

>prop.table(table(sms_raw_test$type))

ham spam

0.8663793 0.1336207

createdatapartition(y, times, p=0.5, list)函数：创建一系列的测试/训练的分区。y为一个输出的向量，如果是createtimeslices，这些应该是按时间的顺序；times为创建的分区的数目；p为训练数据的百分比；list为F是不将结果列在列表中。

createresample()函数：创建一个或多个Bootstrap样本；

Createfolds()函数：将数据分为K组；

createtimeslices()函数：创建交叉验证样本信息可用于时间序列数据。

2）、使用wordcloud包分析文本

最简单的文本分析方法就是市场词云了，我们用wordcloud包

>library(wordcloud)

> wordcloud(sms_corpus_train,min.freq=40, random.order=F) 这里的min.freq是词出现的最小频率，通常我们用语料库的10%来开始(训练语料库有4182个文档)

wordcloud包中的wordcloud(words, min.freq, max.words,random.order, scale=c(4,.5))函数：画一个字云。words为文本中的单词；min.freq表示频率低于min.freq话不会被绘制；max.words被绘制的最大数目字，最小频繁项将失效；random.order随机顺序画词，为F时则按降序顺序画词;scale 为一个长度为2的向量表示单词大小的范围。

上面那个词云只是给出了一个总体印象，对我们的分析没有太大帮助，所有我们考虑分布看看垃圾邮件与正常邮件的区别

> spam <-subset(sms_raw_train, type=="spam")

> ham <-subset(sms_raw_train, type=="ham")

>wordcloud(spam$text, max.words=40, scale=c(3, 0.5))

>wordcloud(ham$text, max.words=40, scale=c(3, 0.5))

很显然可以看出垃圾邮件里面free,now,prize,textclaim等比较多

3）、词频

把所有的词都考虑进来显然不是很好的方法，我们的矩阵有7986个特征，因此我们需要考虑缩小范围，于是采用findFreqTerms的方法取大于5的特征（具体取多少根据数据的数据情况）：

>findFreqTerms(sms_dtm_train, 5)[10:20]

[1] "add" "address" "admirer" "advance" "aft"

[6] "afternoon" "age" "ago" "ahead" "aight"

[11]"aint"

findFreqTerms(x, lowfreq, highfreq)函数：在文档术语或术语文档矩阵中查找频繁项。x为一个术语文档矩阵；lowfreq为一个数字，表示较低的频繁项；highfreq为一个数字，表示较高的频繁项

> freq5 <-findFreqTerms(sms_dtm_train, 5)

> str(freq5)

chr [1:1253] "abiola""able" "abt" "accept" "access" ...

> freq5_corpus<- Corpus(VectorSource(freq5))

>freq5_corpus_dtm <- DocumentTermMatrix(freq5_corpus)

> sms_dict <- Terms(freq5_corpus_dtm)

注意：> sms_dict<- Dictionary(findFreqTerms(sms_dtm_train, 5)) 此命令用上面的命令代替，因为tm包中的Dictionary()函数已经删除，用Terms代替。

Terms(x)函数：访问文档的标识和条款。x表示术语文档矩阵。

获得了频数大于5的词后，我们再利用它来生成一个字典，这样可以在文档矩阵中指出，我只取字典中有的词，新的矩阵就只有1252个特征了。

> sms_train <-DocumentTermMatrix(sms_corpus_train, list(dictionary=sms_dict))

> sms_test <-DocumentTermMatrix(sms_corpus_test, list(dictionary=sms_dict))

我们的目标是想通过短信里面有或者是没有某个词来判断是否是垃圾短信，那么我们很显然应该使用的矩阵是标记某个词在某个短信中出现了还是没有出现。因此写个函数来完成这一个功能：

> convert_counts<- function(x) {

+ x <- ifelse(x>0, 1, 0)

+ x <- factor(x, levels=c(0,1),labels=c("No", "Yes"))

+ return(x)

+ }

对矩阵每一列进行这样的处理：于是我们可以得到最终用来构建模型的数据集

> sms_train <-apply(sms_train, MARGIN=2, convert_counts)

>sms_test <- apply(sms_test, MARGIN=2, convert_counts)

apply(x, MARGIN, FUN)：x表示包含在矩阵中的一个数组；MARGIN表示按列还是按行操作；FUN表示要操作的函数。例如，apply(x, 2, mean) 对数据框x的每列求平均值（2代表按列操作，1代表按行操作）

4）、模型训练

在R里面有多个包都提供朴素贝叶斯分类，比如e1071包，还有klaR包的NaiveBayes()，这里使用e1071：

> library(e1071)

> sms_classifier<- naiveBayes(sms_train, sms_raw_train$type)

于是我们得到了分类器sms_classifier

5）、模型评估

有了模型就可以对测试数据进行预测:

predict(object, newdata, type) object：naveBayes模型；newdata：测试数据；type：预测类型，type如果为class代表是分类，如果是raw则代表概率的计算

> sms_test_pred<- predict(sms_classifier, sms_test)

>library(gmodels)

>CrossTable(sms_test_pred, sms_raw_test$type, prop.chisq=F, prop.t=F,dnn=c("predicted", "actual"))

Cell Contents

|-------------------------|

| N |

| N / Row Total |

| N / Col Total |

|-------------------------|

Total Observationsin Table: 1392

| actual

predicted | ham | spam | Row Total |

-------------|-----------|-----------|-----------|

ham | 1202 | 29| 1231 |

| 0.976 | 0.024 | 0.884 |

| 0.997 | 0.156 | |

-------------|-----------|-----------|-----------|

spam | 4 | 157 | 161 |

| 0.025 | 0.975 | 0.116 |

| 0.003 | 0.844 | |

-------------|-----------|-----------|-----------|

Column Total | 1206 | 186 | 1392 |

| 0.866 | 0.134 | |

-------------|-----------|-----------|-----------|

gmodels包的CrossTable(x, y, prop.chisq, prop.t,dnn)函数：独立试验因素的交叉制表。 x为向量或矩阵，如果y指定，必须是一个向量；y为一个矩阵或数据框的向量；prop.chisq为T时，每个单元的卡方贡献将被包括；prop.t为T时，t分布的分布率将被包括；dnn在结果的尺寸中被给予的名称。

我们可以看出简单的贝叶斯模型的效果却很好，97.6%的正确率，186封垃圾邮件中29封误判为了正常邮件。而1206封正常邮件中4封误判为垃圾邮件。把正常邮件误判为垃圾邮件的影响显然更大，这是需要考虑的地方。

模型改进

6）、假设拉普拉斯估计：

前面说过了拉普拉斯估计的问题，那么如果我们假设拉普拉斯估计会怎么样呢？

> sms_classifier2<- naiveBayes(sms_train, sms_raw_train$type, laplace=1)

> sms_test_pred2<- predict(sms_classifier2, sms_test)

>CrossTable(sms_test_pred2, sms_raw_test$type, prop.chisq=F, prop.t=F,dnn=c("predicted", "actual"))

Cell Contents

|-------------------------|

| N |

| N / Row Total |

| N / Col Total |