朴素贝叶斯分类之垃圾短信识别
朴素贝叶斯分类之垃圾短信识别
在上⼀篇⽂章中我们使⽤最邻近算法knn实现医学中乳腺癌的判别，本⽂继续探讨分类算法，该算法是朴素贝叶斯分类算法，它有着⾮常多的优点，具体表现在简单、快速、有效，对噪声数据和缺失数据不敏感，⽽且还可以得到分类结果的概率值。
算法思想
该算法根据训练数据集的取值计算已知分类的各种概率，在完成学习的过程后，如果将⼀个未分类的样本带⼊到算法中，分类器根据样本的特征计算概率并将其判为应该属于的类。
贝叶斯条件概率
灭蚂蚁的方法上⽂中提到的概率都是基于贝叶斯条件概率公式计算所得，具体公式如下：
该公式表⽰，已知事件B发⽣的条件下，事件A发⽣的概率。举个例⼦说，已知某⼈吸烟的情况下，其可能得肺癌的概率就可以根据该公式计算所得。
这⾥需要注意的是，贝叶斯条件概率计算的是某事件发⽣的概率，所以对原始数据有⼀个潜在的假设，即变量值尽可能的离散化（成为独⽴的事件），如果变量值是⼤量的连续数据，算法可能得到不理想的分类结果。
应⽤--垃圾短信识别
⼀、读取数据
sms_rawdata <- read.csv(file = file.choose(), header = TRUE, stringsAsFactors = FALSE)
#查看数据前6⾏
head(sms_rawdata)
#查看数据概要
str(sms_rawdata)
由于短信的类型是分类变量，这⾥进⼀步将其处理为因⼦
sms_rawdata$type <- factor(sms_rawdata$type)
#查看短信类型的数量
table(sms_rawdata$type)
prop.table(table(sms_rawdata$type))
垃圾短信有747条，占了13.4%的⽐重。
⼆、⽂本处理玻璃杯歌词
在⽂本分析之前需要使⽤tm包将⽂本处理⼲净，主要是⽂本信息中含有的⼀些没有意义的内容，如标点符号、数字、停⽌词等。#下载并加载tm包
if(!suppressWarnings(require('tm'))){
install.packages('tm')
require('tm')
}
#⾸先将⽂本数据导⼊为语料库(Corpus函数)
sms_corpus <- Corpus(VectorSource(sms_rawdata$text))
#查看语料库
sms_corpus
发现语料库中包含5558个⽂件即短信。
使⽤tm_map函数将没有意义的信息剔除
#所有单词转化为⼩写
sms_clean <- tm_map(sms_corpus,content_transformer(tolower))
#剔除所有标点符号
sms_clean <- tm_map(sms_clean,removePunctuation)
#剔除所有数字
sms_clean <- tm_map(sms_clean,removeNumbers)
#剔除所有停⽌词，如a/the等，使⽤tm包⾃带的停⽌词
sms_clean <- tm_map(sms_clean,removeWords,stopwords())
#剔除所有空格
sms_clean <- tm_map(sms_clean,stripWhitespace)
创建符合贝叶斯算法的数据集（⽂档词条矩阵），矩阵的⾏表⽰短信条数，矩阵的列表⽰单词。
sms_dtm <- DocumentTermMatrix(x = sms_clean)
画眉鸟叫sms_dtm
该⽂档词条矩阵包含了8300多列，超过了短信的条数，这将导致算法⽆法准确分类，为了减少矩阵的列数，我们将剔除同⼀个单词出现在少于5条短信的单词。这⾥的5表⽰总短信条数的0.1%。
#将⽂档词条矩阵转化为数据框
sms_dtm2 <- as.data.frame(inspect(sms_dtm))
sms_dtm2 <- sms_dtm2[,findFreqTerms(sms_dtm,5)]
雅思考试的内容dim(sms_dtm2)
[1] 5558 1542
#现在还剩1542列
三、⽂本探索
在建模之前，我们对⽂本进⾏⼀个初步的探索--词云
#下载并加载wordcloud包
if(!suppressWarnings(require('wordcloud'))){
install.packages('wordcloud')
require('wordcloud')
}
#绘制⽂字云
par(bg='black')
wordcloud(words = sms_clean, min.freq = 50, scale = c(2.5,0.5),colors=rainbow(10))
一句表达回家的心情
直辖市四、建模
由于⽂档词条矩阵中的数值表⽰某个单词出现在⼀条短信中的次数，所以需要将连续数值离散化，这⾥将⼤于等于1的值⽤YES表⽰，否则⽤NO表⽰。
#构建离散化的⾃定义函数
numtochar <- function(x){
ifelse(x >= 1, 'YES', 'NO')
}
#将⾃定义函数应⽤到数据框中的每⼀列
sms_dtm2 <- sapply(sms_dtm2, numtochar)
#创建训练集和测试集
set.seed(1234)
index <- sample(1:2, size = nrow(sms_rawdata), replace = TRUE, prob = c(0.7,0.3))
train_data <- sms_dtm2[index == 1,]
train_Y <- sms_rawdata[index == 1, 1]
test_data <- sms_dtm2[index == 2,]
test_Y <- sms_rawdata[index == 2, 1]
五、函数简介
接下来使⽤klaR包中的NaiveBayes()函数实现贝叶斯分类算法，NaiveBayes()函数的语法和参数如下：
NaiveBayes(formula, data, ..., subset, na.action = na.pass)
NaiveBayes(x, grouping, prior, usekernel = FALSE, fL = 0, ...)
formula指定参与模型计算的变量，以公式形式给出，类似于y=x1+x2+x3；
data⽤于指定需要分析的数据对象；
na.action指定缺失值的处理⽅法，默认情况下不将缺失值纳⼊模型计算，也不会发⽣报错信息，当设为“na.omit”时则会删除含有缺失值的样本；
x指定需要处理的数据，可以是数据框形式，也可以是矩阵形式；
grouping为每个观测样本指定所属类别；
prior可为各个类别指定先验概率，默认情况下⽤各个类别的样本⽐例作为先验概率；
usekernel指定密度估计的⽅法（在⽆法判断数据的分布时，采⽤密度密度估计⽅法），默认情况下使
⽤标准的密度估计，设为TRUE时，则使⽤核密度估计⽅法；
fL指定是否进⾏拉普拉斯修正，默认情况下不对数据进⾏修正，当数据量较⼩时，可以设置该参数为1，即进⾏拉普拉斯修正。
#下载并加载klaR包
if(!suppressWarnings(require('klaR'))){
install.packages('klaR')
require('klaR')
}
#使⽤训练集建模
model <- NaiveBayes(x = train_data, grouping = train_Y, fL = 1)
#使⽤测试集对模型的准确性进⾏鉴定
pre <- predict(model, newdata = test_data)
Freq <- table(pre$class, test_Y)
Freq
accuracy <- sum(diag(Freq))/sum(Freq)
accuracy
模型的准确率近98%。
本⽂不⾜之处主要是没能够使⽤中⽂短信作为案例，如果条件允许，能够搜集到⼤量的中⽂短信或邮件，我还是想再⾛⼀遍流程。关于中⽂⽂本的分析，会多⼀个分词的步骤，其余基本上和英⽂⽂本分析步骤⼀致。
下载链接
⽂中的数据和脚本可到如下链接中下载：
总结：⽂章使⽤到的R包和函数
read.csv()
table()

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。