R实战——贝叶斯分类器-文本情感分析

Posted 2021-04-25 数据龟

回顾上一篇文章，使用情感词典进行分析的准确率达到76%。那么如果使用别的模型或者算法，会不会提高准确率呢？下面就用贝叶斯分类器来分析看看。  

贝叶斯分类器

---

贝叶斯分类器是一个典型的统计学方法，原理就是贝叶斯条件概率：

P(A|B) = \frac{P(B|A)P(A)}{P(B)}

P(A)：A发生的概率，也称为A的先验概率，P(A)不考虑B影响的各因素  

P(A|B)：在B发生的条件下A发生的概率，称为A的后验概率  

P(B)：B发生的概率，也称为B的先验概率，通常作为标准化常量  

P(B|A)：在A发生的条件下B发生的概率，称为B的后验概率  

其中B的后验概率与B的先验概率的比值称为标准相似度（ss），所以贝叶斯公式可以表述为：

P(A|B) = ss \times P(A)

既A的后验概率等于标准相似度与A的先验概率的乘积。  

贝叶斯条件概率与文本分类

---

文本分类的应用有很多，典型的有垃圾邮件和垃圾短信的筛选。文本分类主要分为两个步骤，首先建立一个训练集，通过这个训练集建立模型，然后再根据这个模型进行预测。  

对于一封邮件，想要判断它是否是垃圾邮件，只需要先提取其特征词项，再计算其贝叶斯概率：

由于分母都是一致的，那么就可以简化为：

P(A=health)：训练集中正常邮件的概率；  

P(A=ham)：训练集中垃圾邮件的概率；  

P(B=email | A=health)：特征词项在条件为正常邮件中发生的概率；  

P(B=email | A=ham)：特征词项在条件为垃圾邮件中发生的概率；  

通过计算这两个概率并比较其大小，就能判断出这封邮件的类别。

贝叶斯分类器与R

---

下面使用R包e1071包中的朴素贝叶斯来实现分类。

#载入相关包
library(data.table)
library(chinese.misc)
library(jiebaR)
library(tm)
library(e1071)
library(RTextTools)

首先先读取数据，并构建训练集和测试集

#读入数据并整理数据
df.csv<-fread(input = "han2.txt",sep = ",",header = T,stringsAsFactors = F,select = c(1,3),encoding = "UTF-8")
df.csv<-df.csv[,c("id","label"):=.(1:nrow(df.csv),ifelse(df.csv$Star>=4,"good","bad"))]
#构建训练集和测试机
df.csv$index<-sample(1:2,nrow(df.csv),replace = T,prob = c(0.7,0.3))#按7:3比例分成训练集和测试集
df.train<-df.csv[index==1]
df.test<-df.csv[index==2]
> head(df.train)
    Comment
1: 一家老牌的韩式烤肉店，味道正宗，推荐牛舌和腌制牛排，大众点评买单有优惠
2:泡菜味道一般，太辣了，小朋友不太能吃，一般般吧
3:可以吃到正宗的韩式料理，服务及环境都很不错
4:味道很一般呀，除了海带汤，别的菜我都没觉得好吃
5: 在深国投商场内，店面挺大，人不是很多，环境挺好服务也不错。因为不太吃得下烤肉所以选择了拌饭和豆腐汤这类的。拌饭味道还可以，豆腐汤味道一般，感觉不如土大力的，但是深圳好像没有土大力。可能烤肉会更加好吃一些吧。
6: 还不错吧！吃过几次了……这次用的大众买的
   Star id label index
1:    4  1  good     1
2:    4  3  good     1
3:    5  4  good     1
4:    3  5   bad     1
5:    5  6  good     1
6:    5  7  good     1

数据集包含了每个ID的评论，星级，分类标签（按星级分类），接下需要把评论生成一个DTM（document term matrix），也就是文档-词条矩阵。对于中文，tm包支持并不好，幸运的是有一个中文包Chinese.misc包。此包堪称神器，能一步生成DTM，具体用法点这里。

#生成训练集DTM
dtm.train<-df.train$Comment%>%
           corp_or_dtm(from="v",type="D",stop_word="jiebar",myfun1 = slim_text,control = list(wordLengths=c(2,25)))%>%
           removeSparseTerms(0.99)%>%
           output_dtm(doc_name=df.train$id)
#生成测试集DTM
dtm.test<-df.test$Comment%>%
          corp_or_dtm(from="v",type="D",stop_word="jiebar",myfun1 = slim_text,control = list(wordLengths=c(2,25)))%>%
          removeSparseTerms(0.99)%>%
          output_dtm(doc_name=df.test$id)
> head(dtm.train[,1:5])#DTM长这样，每一列为一个单词，每一行为一个文档，值为这个文档包含每一个单词的次数
    Terms
Docs 帮忙 便宜 冰淇淋 不错 不够
   1    0    0      0    0    0
   3    0    0      0    0    0
   4    0    0      0    1    0
   5    0    0      0    0    0
   6    0    0      0    1    0
   7    0    0      0    1    0

现在就可以用这个训练集DTM来训练朴素贝叶斯模型。

#训练贝叶斯模型
model <- naiveBayes(dtm.train, as.factor(df.train$label), laplace = 1)
#第二个参数为每个文档类别向量，需要是因子型
#laplace = 1，使用Laplace平滑

模型训练好之后就可以预测测试集

#预测测试集
pre <- predict(model, dtm.test)

#准确率

> prop.table(table(df.test$label, pre))
      pre
             bad      good
  bad  0.1019656 0.1228501
  good 0.1449631 0.6302211

召回率RTextTools包

> recall_accuracy(df.test$label, pre)
[1] 0.7321867

最后召回率为73%，并不理想。

改进

---

在生成DTM的时候，有一个关键步骤就是要对文档进行分词，与之前的文章一样，加入用户分词词典和停用词词典，再生成DTM并训练模型。

扫一扫，免费获取各种数据分析视频