【干货】--手把手教你完成文本情感分类

感谢关注天善智能，走好数据之路↑↑↑

欢迎关注天善智能，我们是专注于商业智能BI，人工智能AI，大数据分析与挖掘领域的垂直社区，学习，问答、求职一站式搞定！

本文作者：天善智能社区专家刘顺祥

天善智能社区地址：https://www.hellobi.com/

---

前言

    2017年12月9日，参加了天善组织的线下沙龙活动，在沙龙中自己分享了如何借助于R语言完成情感分析的案例，考虑的其他网友没能够参与到活动现场，这里作一个简单的分享。

    在文本分析中，最基础的工作就是如何完成句子、段落或文章的分词，当然这一步也是非常重要的，因为这会直接影响后面文档词条矩阵的构造和模型的有效性。一般而言，在做分词和清洗时需要完成如下三个步骤：

    创建一个自定义词库，并根据这个词库实现正确的分词；

    删除分词中的停止词（无用词）；

    删除其他无用词（如字母、数字等）；

    首先我们以电视剧《猎场》中的一句台词为例，完成上面三个步骤的任务：

# 加载第三方包

library(jiebaR)

# 台词

sentence <-'滚出去！我没有时间听一个牢里混出来的人渣，在这里跟我讲该怎么样不该怎么样！你以为西装往身上一套，我就看不到你骨子里的寒酸，剪剪头、吹吹风，就能掩藏住心里的猥琐？你差得还远，你这种人我见得多了，但还没有见到过敢对我指手画脚的。消失，快从我面前消失！'

# 设置动力和引擎

engine <- worker()

# 查看引擎配置

engine

    在分词之前，需要跟大家介绍两个函数，它们分别是：

    worker()—为分词提供动力和引擎

    segment()—为分词提供战斗机

    首先来看一下默认的分词引擎【worker()】都有哪些配置：

        从上图的结果中，我们可知引擎所选择的分词方法是混合法（即最大概率法和隐马尔科夫方法）；中文编码为UTF-8；分词最大长度为20个词；一次性可以读取最大10W行记录；同时也提供了超过58W的词库。通过这些默认的配置就可以完成句子的分词，下面我们来看看这段台词的分词效果：

# 分词

cuts <- segment(sentence, engine)

cuts

        分词结果如上所示，但是你会发现有一些词是切得不正确的，例如“剪剪头”切成了“剪剪”和“头”、“吹吹风”切成了“吹吹”和“风”。按理来说，这些应该作为一个整体被切割，但却被切分开了了。为了避免这种错误的产生，需要用户提供正确切词的词库，然后通过修改worker()函数或使用new_user_word()函数来完成自定义词库的调用：

# 自定义词库--方法一

engine2 <- worker(user ='C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/my_dict.txt')

segment(sentence, engine2)

# 自定义词库--方法二

new_user_word(engine, c('剪剪头','吹吹风','见到过'))

cuts2 <- segment(sentence, engine)

cuts2

        第一种方法就是创建词库my_dict文件，并将这个文件路径传递给worker函数；第二种方法使用new_user_word，指定几个自定义词。通过这两种方法，都可以实现正确的切词操作，如下图所示：

        词已经按照我们预期的效果完成切割了，但是分词结果中还是存在一些没有意义的停用词（如“的”、“我”、“他”等），为了避免这些停用词对后面建模的影响，需要将这些词删除。这里也通过两种方法实现，具体见下方的代码：

# 停止词的处理--方法一

engine3 <- worker(user ='C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/my_dict.txt',

stop_word ='C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/stop_words.txt')

segment(sentence, engine3)

# 停止词的处理--方法二

cuts3 <- filter_segment(cuts2, filter_words = c('我','的','听','在','你','就','能','还','对',

'人','从','但','讲','跟','这种','一个','身上'))

cuts3

        第一种方法就是创建停止词词库stop_words文件，并将这个文件路径传递给worker函数；第二种方法使用filter_segment函数，过滤掉指定的那些停止词。通过这两种方法，都可以实现停止词的删除，如下图所示。

        由于台词中不包含数字、字母等字符，这里就不说明如何删除这些内容了，但后面的评论数据例子中是含有这些字符的，那边会有代码说明。接下来需要说一说如何构造文档-词条矩阵了，先来看下面这个图：

        图中的行就代表一个个文档，列就代表一个个词，矩阵中的值就代表每一个词在某个文档中出现的频数。由于不同文档的长度不一致，如果使用简单的频数作为矩阵的值是不理想的。故考虑使用词频-逆文档频率（TFIDF）作为矩阵中的值，其公式如下图所示：

        具体计算的结果，可以查看下面的这个文档-词条矩阵图：

        在R语言中，构建这个矩阵就太简单了，只需调用tm包中的DocumentTermMatrix()函数即可。下面我们就以某酒店的评论数据为例，来构建这个文档-词条矩阵。

# 导入所需的开发包

library(readxl)

library(jiebaR)

library(plyr)

library(stringr)

library(tm)l

ibrary

(pROC)

library(ggplot2)

library(klaR)

library(randomForest)

# 读取评论数据

evaluation <- read_excel(path = file.choose(),sheet =2)

# 查看数据类型

str(evaluation)

# 转换数据类型

evaluation$Emotion <- factor(evaluation$Emotion)

# 分词(自定义词和停止词的处理)

engine <- worker(user ='C:\\Users\\Administrator\\Desktop\\HelloBI\\all_words.txt',

stop_word ='C:\\Users\\Administrator\\Desktop\\HelloBI\\mystopwords.txt')

cuts <- llply(evaluation$Content, segment, engine)

#剔除文本中的数字和字母

Content <- lapply(cuts,str_replace_all,'[0-9a-zA-Z]','')

# 检查是否有空字符创，如有则删除

idx <- which(Content =='')

Content2 <- Content[-idx]

# 删除含空字符的元素结果

Content3 <- llply(Content2,function(x) x[!x ==''])

# 将切词的评论转换为语料

content_corpus <- Corpus(VectorSource(Content3))

# 创建文档-词条矩阵

dtm <- DocumentTermMatrix(x = content_corpus,

control =list(weighting = weightTfIdf,

wordLengths = c(2,Inf)))

dtm

# 控制稀疏度

dtm_remove <- removeSparseTerms(x = dtm, sparse =0.95)

dtm_remove

# 查看变量名

dtm_remove$dimnames$Terms

# 转换为数据框

df_dtm <- as.data.frame(as.matrix(dtm_remove))

head(df_dtm)

        这张图反映的是最初的文档-词条矩阵，显示713个文档，1264个词条，而且这个矩阵的稀疏度为100%。为了降低矩阵的系数度，通过removeSparseTerms()函数设定稀疏度，如下图所示，此时的词条数就压缩到了13个，即13个变量。

        接下来，还需要将这个矩阵转换为数据框，因为分类算法（如贝叶斯、随机森林等）不接受上面生成的矩阵类型。有了下面这个数据框，我们就可以将数据集拆分为两部分，一部分用于分类器的构造，另一部分用于验证分类器的效果好坏。

        在构建贝叶斯模型之前，还需要简单介绍一下朴素贝叶斯的理论知识，这样有助于对算法的理解。贝叶斯算法核心是计算条件概率，而此处条件概率的计算又依赖于两个前提假设，即连续变量服从正态分布和各解释变量之间是互相独立的。首先来看一下这个条件概率公式，其可以写成下面这个形式：

        很显然，要求得每个样本下的条件概率最大值，只需求解分子的最大化即可。根据解释变量之间互相独立的假设，还可以将分子转换为下面这个公式：

        而下面这个公式的概率是很好求的，在已知某分类的情况下，计算每个变量取值的概率（当X变量离散时，用变量值的频率代替条件概率；当X变量连续时，用变量的正态概率密度值代替条件概率）。OK，原理很简单，在R语言中，通过调用klaR包中的NaiveBayes()函数就可以实现贝叶斯分类器的构建了。函数语法如下：

NaiveBayes(x, grouping, prior, usekernel = FALSE, fL = 0, …)

            x指定需要处理的数据，可以是数据框形式，也可以是矩阵形式；

            grouping为每个观测样本指定所属类别；

            prior可为各个类别指定先验概率，默认情况下用各个类别的样本比例作为先验概率；

            usekernel指定密度估计的方法（在无法判断数据的分布时，采用密度密度估计方法），默认情况下使用标准的密度估计，设为TRUE时，则使用核密度估   计方法；

            fL指定是否进行拉普拉斯修正，默认情况下不对数据进行修正，当数据量较小时，可以设置该参数为1，即进行拉普拉斯修正。

        接下来，进入贝叶斯分类器的实战部分，包含模型的构建、测试集的预测和模型的验证，具体代码如下：

# 拆分为训练集和测试集

set.seed(1)

index<-sample(

1:nrow(df_dtm),size=0.75*nrow(df_dtm))

train <- df_dtm[index,]

test<- df_dtm[-index,]

# 贝叶斯分类器

bayes <- NaiveBayes(x = train,grouping= evaluation$Emotion[-idx][index], fL =1)

# 预测

pred_bayes <- predict(bayes, newdata =test)

Freq_bayes <-table(pred_bayes$class, evaluation$Emotion[-idx][-index])

# 混淆矩阵

Freq_bayes

# 准确率

sum(diag(Freq_bayes))/sum(Freq_bayes)

#ROC曲线

roc_bayes <- roc(evaluation$Emotion[-idx][-index],factor(pred_bayes$class,ordered =T))

Specificity <- roc_bayes$specificities

Sensitivity <- roc_bayes$sensitivities

# 绘制ROC曲线

p<- ggplot(data=NULL,mapping= aes(x=1-Specificity, y = Sensitivity))

p+ geom_line(colour =

'red',size=1) +

coord_cartesian(xlim =c(

0,1), ylim =c(0,1)) +

geom_abline(intercept =

0, slope =1)+

annotate(

'text', x =0.5, y =0.25, label=paste('AUC=',round(roc_curve$auc,2)))+

labs(x =

'1-Specificity',y ='Sensitivity', title ='ROC Curve') +

theme(plot.title = element_text(hjust =

0.5, face ='bold', colour ='brown'))

        结果如上图所示，模型的准确率为77%（即混淆矩阵中主对角线数值之和除以4个元素之和）；ROC曲线下的面积也达到了0.79（理想的AUC在0.8以上）。相对来说，模型的效果还是比较理想的。为了比较，我们再使用一个集成算法（随机森林），看看集成算法是否比单一的贝叶斯算法要好一些。

# 随机森林

rf <- randomForest(x = train, y = evaluation$Emotion[-idx][index])

pred_rf <- predict(rf, newdata =test)

# 混淆矩阵

Freq_rf <- table(pred_rf,evaluation$Emotion[-idx][-index])

Freq_rf

# 准确率

sum(diag(Freq_rf))/sum(Freq_rf)

#ROC曲线

roc_rf <- roc(evaluation$Emotion[-idx][-index],factor(pred_rf,ordered =T))

Specificity <- roc_rf$specificities

Sensitivity <- roc_rf$sensitivities

# 绘制ROC曲线

p <- ggplot(data =NULL, mapping = aes(x=1-Specificity, y = Sensitivity))

p + geom_line(colour ='red', size =1) +

coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +

geom_abline(intercept =0, slope =1)+

annotate('text', x =0.5, y =0.25, label=paste('AUC=',round(roc_rf$auc,2)))+

labs(x ='1-Specificity',y ='Sensitivity', title ='ROC Curve') +

theme(plot.title = element_text(hjust =0.5, face ='bold', colour ='brown'))

        很显然，集成算法要比贝叶斯算法要优秀一些，模型的准确率超过80%，而且AUC值也达到了0.82。

结语

        OK，关于使用R语言完成文本情感分类的实战我们就分享到这里。如果你有任何问题，欢迎在留言区域表达你的疑问。同时，也欢迎各位朋友继续转发与分享文中的内容，让更多的人学习和进步。

---

原文地址：【干货】--手把手教你完成文本情感分类

欢迎关注天善智能，我们是专注于商业智能BI，人工智能AI，大数据分析与挖掘领域的垂直社区，学习，问答、求职一站式搞定！

天善智能社区地址：https://www.hellobi.com/