R语言——朴素贝叶斯文本分类

朴素贝叶斯方法是最常见的使用贝叶斯思想进行分类的方法，它是目前所知文本分类算法中最有效的一类，常常应用于文本分类。下面将会以一个含多个类别的BBC英文文本数据为例，介绍如何使用朴素贝叶斯方法对其进行数据分类。

1 文本数据准备与探索

下面会直接导入已经预处理后的数据对其进行探索性分析，下面的程序是导入进行文本分类是需要的相关R包，以及数据的导入，数据一共有两个变量，分别是预处理后的文本内容变量text_pre，和类别标签变量lable。

library(tm);library(wordcloud2);library(tidytext);library(reshape2);
library(dplyr);library(e1071);library(ggpol)
## 读取数据,文本数据已经是预处理后的
bbcdata <- read.csv("data/chap12/bbcdata.csv",stringsAsFactors = FALSE)
bbcdata$label <- as.factor(bbcdata$label)

图1 文本数据的前几行

针对文本数据可以使用词云对其进行可视化，在下面的程序中通过unnest_tokens()、group_by()等函数计算在所有文本中，每个词语出现的次数，然后使用letterCloud()函数可视化字母词云，运行程序可获得可视化图像2。

## 对数据可视化词云，计算词频
wordfre <- bbcdata%>%unnest_tokens(output = word,input = text_pre)%>%
 group_by(word)%>%summarise(Fre = n())%>%
 arrange(desc(Fre))
letterCloud(wordfre,word = "BBC",wordSize = 1,
 color ="random-dark",backgroundColor = "snow" )

图2 词云可视化

图2中将词云以字母的形式进行可视化，越大的词出现的次数就越多。

利用tm包中的Corpus()函数可以对文本数据构建语料库，使用DocumentTermMatrix()函数可以获得文本数据的文档－词项特征矩阵，而且如果获得的文档－词项矩阵过于稀疏，可使用tm包中的removeSparseTerms()函数剔除一些不重要的词语，缓解矩阵的系数程度，下面的程序和输出则是展示了上述的文本特征的构建过程。

## 构建语料库，计算文本的TF特征
bbc_cp <- Corpus(VectorSource(bbcdata$text_pre))
bbc_cp
## <>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 2225
## 找到频繁出现的词语,出现频率大于2
dict <- wordfre$word[wordfre$Fre >2]
## 构建TF矩阵
bbc_dtm <- DocumentTermMatrix(bbc_cp,
 control = list(dictionary = dict))
bbc_dtm
## <>
## Non-/sparse entries: 300873/23159527
## Sparsity : 99%
## Maximal term length: 24
## Weighting : term frequency (tf)
## 缓解矩阵的稀疏性，同时提高计算效率
bbc_dtm <- removeSparseTerms(bbc_dtm,0.99)
bbc_dtm
## <>
## Non-/sparse entries: 250109/4989766
## Sparsity : 95%
## Maximal term length: 13
## Weighting : term frequency (tf)

从上述程序的输出中可知，处理好的语料库中有2225条文本，初步提取的文档－词项特征矩阵中有10544个词，矩阵稀疏度高达99%，进行缓解稀疏性的操作后，文档－词项特征矩阵包含2355个词，矩阵稀疏度降低到95%

2 朴素贝叶斯分类

针对前面已经提取的文本特征矩阵，使用e1071包中的naiveBayes()函数即可建立朴素贝叶斯分类器模型，在构建模型之前，将数据切分为训练集和测试集，训练集使用75%的数据样本。程序和输出如下：

## 数据随机切分为训练集和测试集
set.seed(123)
index <- sample(nrow(bbcdata),nrow(bbcdata)*0.75)
bbc_dtm2mat <- as.matrix(bbc_dtm)
train_x <- bbc_dtm2mat[index,]
train_y <- bbcdata$label[index]
test_x <- bbc_dtm2mat[-index,]
test_y <- bbcdata$label[-index]
## 使用e1071包中的naiveBayes建立模型
bbcnb <- naiveBayes(x = train_x,y = train_y,laplace = 1)
## 对测试集进行预测，查看模型的精度
train_pre <- predict(bbcnb,train_x,type = "class")
test_pre <- predict(bbcnb,test_x,type = "class")
sprintf("朴素贝叶斯模型训试集上预测精度:%4f",accuracy(train_y,train_pre))
sprintf("朴素贝叶斯模型测试集上预测精度:%4f",accuracy(test_y,test_pre))
## [1] "朴素贝叶斯模型讯试集上预测精度:0.933453"
## [1] "朴素贝叶斯模型测试集上预测精度:0.858169"

从朴素贝叶斯模型的预测结果输出中，可以知道其在训练集上的预测精度为93.3%，在测试集上的预测精度能够达到85.58%，预测精度较高。

分析模型的预测效果，还可以使用混淆矩阵热力图进行分析，下面的程序是可视化朴素贝叶斯模型在测试集上的混淆矩阵，运行程序可获得热力图3。

## 可视化预测的混淆矩阵
ggplot()+labs(x = "Reference",y = "Prediction")+
 geom_confmat(aes(x = test_y, y = test_pre),
 normalize = TRUE, text.perc = TRUE)+
 scale_fill_gradient2(low="darkblue", high="lightgreen")

图3 测试集上的混淆矩阵热力图