一、前言:


继上一篇推文 R文本挖掘——情感分析【1】

中的局限与不足进行优化,考虑到否定词对于语句情感得分的影响,以及对评论数据的正面词、负面词进行可视化处理;

二、情感分析简述:

文本分析是目前比较热门的一项研究,文本分析大致流程如下:

1、文本数据获取【R爬虫,现在较为热门的Python爬虫等】

2、文本清洗【包括空格(如果为英文文本,请忽略这一步)、停用词】

3、分词【切词、词频统计、可视化、关键词提取、tm包语料库构建】

4、分析【情感分析、文本聚类等】

5、模型构建【LDA主题建模】

就情感分析而言,目前比较流行的方法有两种,一是词法分析、二是机器学习法。情感分析是对文本内容进行分析,探究其表达情感的技术;


机器学习应用于情感分析尚未成熟,而文本情感分析的词法分析方法对词库要求较高。 在此就分享一下自己如何通过词库的方式为每一句评论定性为正面或负面。 词法分析的基本思想就是对每句评论文本进行分词,然后通过匹配正面词典与负面词典,考虑情感词前否定词对语句情感得分的影响,从而计算出语句的正面得分(词中有多少是积极的)与负面得分(词中有多少是消极的),以及综合得分(积极得分减去消极得分)。虽然该方法通俗易懂,但是对词典质量要求较高(直接影响语句情感打分)【此外在使用停用词前,需将停用词中的情感词、否定词去除(如:“不”字等)】,且需耗费大量时间精力整理,如正负面词库的构建、自定义词典的导入等。

三、步骤:

数据集说明:本次情感分析使用电影评论数据1500条,包含好评、中评、差评各500条;


r语言评估情感分析模型准确度 r语言文本情感分析_r语言评估情感分析模型准确度



【1】数据读取;

【2】数据清洗;

【3】评论分词;

【4】数据整理(方便情感打分);

【5】词典读取;

【6】定位情感词;

【7】评论情感倾向可视化(ggplot2);

【8】词云图(wordcloud,wordcloud2)

四、实操过程:

(一)、数据读取:

数据读取部分可能因文件编码问题导致读取乱码,在此,可先转换文本编码为“utf-8”或是采取其他方式读取:

如:readr包的read_csv()

       data.table包的fread()

       或是:

       read.csv()\read.table()

#一、载入所需R包:
#这里使用pacman包的p_load()函数加载所需R包,省去逐个library()的繁琐;

library(pacman)
p_load(tidyverse,jiebaR,jiebaRD,dplyr,plyr,stringr,ggplot2,wordcloud,wordcloud2)

#一、载入所需R包:
#这里使用pacman包的p_load()函数加载所需R包,省去逐个library()的繁琐;

library(pacman)
p_load(tidyverse,jiebaR,jiebaRD,dplyr,plyr,stringr,ggplot2,wordcloud,wordcloud2)
#数据导入:
comcomment
#数据导入:
comcomment

(二)、数据清洗:

#由于是电影评论数据,去掉一些无用高频词语:
#这里使用stringr包对数据进行清洗:
commentcommentcommentcommentcomment
#由于是电影评论数据,去掉一些无用高频词语:
#这里使用stringr包对数据进行清洗:
commentcommentcommentcommentcomment

(三)、评论分词:

#数据清洗后,设置分词引擎,并进行切词处理:
#使用jiebaR\jiebaRD包、使用停用词前需将停止词中的情感词去除;
engine 
#开始切词:
seg_wordfor(i in 1:length(comment)){
  seg_word[[i]]}
head(seg_word)   #查看分词结果

#数据清洗后,设置分词引擎,并进行切词处理:
#使用jiebaR\jiebaRD包、使用停用词前需将停止词中的情感词去除;
engine 
#开始切词:
seg_wordfor(i in 1:length(comment)){
  seg_word[[i]]}
head(seg_word)   #查看分词结果


#开始切词:
seg_wordfor(i in 1:length(comment)){
  seg_word[[i]]}
head(seg_word)   #查看分词结果

(四)、数据整理:

-------------对分词结果进行预处理:词项、所在评论ID、词性:-----------------
#这里使用plyr包的sapply(对象,函数)------函数:

#【1】统计每条评论的词条个数:
n_word
#【2】根据词数生成相应的句子id数:
#rep(对象,重复次数)
#index作为id列;
#对1:1500条评论,rep()生成相应的n_word次数;
index 
#【3】获取词性:
nature 
#【4】整合数据集;
result #id为词语所在评论,word为词项,nature为词性;
colnames(result) head(result)

#【5】将每个词在评论分词结果中的位置标记出来
index_word #seq_len 函数:输入的数据长度是n, 生成从1到n的序列
#比如第一句评论有8个词,seq_len会生成1~8的序列;
index_word result$index_word 
#【6】查看数据集:
#result数据说明:id:所在评论;word:词项;nature:词性;index_word:词所在评论的位置
head(result)

#【7】提取含有名词的评论数据,目的是为了分析哪些特征是观众感兴趣或不感兴趣的
is_n #subset()函数用于数据筛选,尝试is_n1 result_n #导出备用:
write.csv(result_n,'D:/word.csv',fileEncoding = 'gbk')

-------------对分词结果进行预处理:词项、所在评论ID、词性:-----------------
#这里使用plyr包的sapply(对象,函数)------函数:

#【1】统计每条评论的词条个数:
n_word
#【2】根据词数生成相应的句子id数:
#rep(对象,重复次数)
#index作为id列;
#对1:1500条评论,rep()生成相应的n_word次数;
index 
#【3】获取词性:
nature 
#【4】整合数据集;
result #id为词语所在评论,word为词项,nature为词性;
colnames(result) head(result)

#【5】将每个词在评论分词结果中的位置标记出来
index_word #seq_len 函数:输入的数据长度是n, 生成从1到n的序列
#比如第一句评论有8个词,seq_len会生成1~8的序列;
index_word result$index_word 
#【6】查看数据集:
#result数据说明:id:所在评论;word:词项;nature:词性;index_word:词所在评论的位置
head(result)

#【7】提取含有名词的评论数据,目的是为了分析哪些特征是观众感兴趣或不感兴趣的
is_n #subset()函数用于数据筛选,尝试is_n1 result_n #导出备用:
write.csv(result_n,'D:/word.csv',fileEncoding = 'gbk')

[1]对result数据集简单绘制下词云图,查看效果:

#绘制词云图,查看分词结果
library(wordcloud2)
#词频统计
word.frep word.frep word.frep wordcloud2(word.frep[1:200,],color = 'random-dark')
wordcloud2(word.frep[1:200,],size = 1, fontFamily = "微软雅黑",  color = "random-light", backgroundColor = "grey")


#绘制词云图,查看分词结果
library(wordcloud2)
#词频统计
word.frep word.frep word.frep wordcloud2(word.frep[1:200,],color = 'random-dark')
wordcloud2(word.frep[1:200,],size = 1, fontFamily = "微软雅黑",  color = "random-light", backgroundColor = "grey")

[2]效果:

r语言评估情感分析模型准确度 r语言文本情感分析_r语言评估情感分析模型准确度_02

(五)、词典读取:

实操过程中发现,词典读取极易出现乱码问题(即使没有报错,但输出时确实乱码),这里可以试着把词典用Notepad++转换下编码,再读取;【建议读取后,head()查看一下】


#----------------------评论情感分析-------------------------:
#这里建议,读取后使用head()查看下,会否乱码;
pos.comment                        fileEncoding = "UTF-8")
neg.comment                        fileEncoding = "UTF-8")
pos.emotion                           header = F,
                          stringsAsFactors = F,strip.white = T,skip = 1)
neg.emotion                        header = F,
                        stringsAsFactors = F,strip.white = T,skip = 1)
【1】词典合并:
positivenegative
【2】定位词典中相同的情感词:
sameword #intersect()函数两个数值向量取交集
#intersect(x=1:4, y = 2:6)
#[1] 2 3 4

【3】剔除词典中的相同情感词:
positive negative #setdiff(x, y):求向量x与向量y中不同的元素(只取x中不同的元素)
#>setdiff(x=1:4, y=2:3)
#[1] 1 4

【4】给正、负情感词典赋予权重:
positive$weightcolnames(positive)negative$weightcolnames(negative)
【5】合并词典:
posneghead(posneg,n=5)

#----------------------评论情感分析-------------------------:
#这里建议,读取后使用head()查看下,会否乱码;
pos.comment                        fileEncoding = "UTF-8")
neg.comment                        fileEncoding = "UTF-8")
pos.emotion                           header = F,
                          stringsAsFactors = F,strip.white = T,skip = 1)
neg.emotion                        header = F,
                        stringsAsFactors = F,strip.white = T,skip = 1)
【1】词典合并:
positivenegative
【2】定位词典中相同的情感词:
sameword #intersect()函数两个数值向量取交集
#intersect(x=1:4, y = 2:6)
#[1] 2 3 4

【3】剔除词典中的相同情感词:
positive negative #setdiff(x, y):求向量x与向量y中不同的元素(只取x中不同的元素)
#>setdiff(x=1:4, y=2:3)
#[1] 1 4

【4】给正、负情感词典赋予权重:
positive$weightcolnames(positive)negative$weightcolnames(negative)
【5】合并词典:
posneghead(posneg,n=5)

(六)、定位情感词:

【1】将正面结果与正负面情感词表合并,定位情感词
# plyr 包,提供了一组规范的数据结构转换形式
library(plyr)
word 
#join函数:join(分词结果数据框,情感词数据框,连接字段,连接类型,匹配模式)
data.posneg head(data.posneg)

【2】情感词的修订
#根据情感词前是否有否定词或双层否定词对情感值进行修正
#载入否定词表
notdict                       header = F,
                      fileEncoding = 'UTF-8',
                      col.names = "term")
head(notdict)
notdict$weight
【3】处理否定修饰词:
data.posneg$amend_weight#只保留有情感词对语句:将NA去除
only 
#语句对应整个文档的位置:
#回顾:#data.posneg
#only

index for (i in 1:nrow(only)) {
  #提取第i个情感词所在的评论
  review   #第i个情感词在评论中的位置;
  affective   
  if(affective == 2){
    #如果情感词的位置是某个评论中的第二个词;
    #注意:sum(TRUE) = 1;     sum(FALSE) = 0;

    a.1     
    #判断该词是否在否定词里面,如果求出的和为1,认为该情感词为相反的情感值
    if(a.1 == 1) data.posneg$amend_weight[index[i]]   }else if (affective >= 3 ){
    #当情感词位于评论第三个位置时:
    #review$word[affective-c(1,2) 提取前两个词;
    #存在两个否定词,则为肯定,即当sum=1(仅包含一个否定词)时,才需修改情感词值;
    a.2     if(a.2==1) data.posneg$amend_weight[index[i]]   }
}


【4】更新只保留有情感值的数据:
only index head(only)

【5】计算每条评论的情感值:
pixar head(pixar)
colnames(pixar) 
【1】将正面结果与正负面情感词表合并,定位情感词
# plyr 包,提供了一组规范的数据结构转换形式
library(plyr)
word 
#join函数:join(分词结果数据框,情感词数据框,连接字段,连接类型,匹配模式)
data.posneg head(data.posneg)

【2】情感词的修订
#根据情感词前是否有否定词或双层否定词对情感值进行修正
#载入否定词表
notdict                       header = F,
                      fileEncoding = 'UTF-8',
                      col.names = "term")
head(notdict)
notdict$weight
【3】处理否定修饰词:
data.posneg$amend_weight#只保留有情感词对语句:将NA去除
only 
#语句对应整个文档的位置:
#回顾:#data.posneg
#only

index for (i in 1:nrow(only)) {
  #提取第i个情感词所在的评论
  review   #第i个情感词在评论中的位置;
  affective   
  if(affective == 2){
    #如果情感词的位置是某个评论中的第二个词;
    #注意:sum(TRUE) = 1;     sum(FALSE) = 0;

    a.1     
    #判断该词是否在否定词里面,如果求出的和为1,认为该情感词为相反的情感值
    if(a.1 == 1) data.posneg$amend_weight[index[i]]   }else if (affective >= 3 ){
    #当情感词位于评论第三个位置时:
    #review$word[affective-c(1,2) 提取前两个词;
    #存在两个否定词,则为肯定,即当sum=1(仅包含一个否定词)时,才需修改情感词值;
    a.2     if(a.2==1) data.posneg$amend_weight[index[i]]   }
}


【4】更新只保留有情感值的数据:
only index head(only)

【5】计算每条评论的情感值:
pixar head(pixar)
colnames(pixar)

(七)、评论情感倾向可视化(ggplot2)

#--------------------可视化评论情感倾向---------------------
#library("dplyr")pa pixar1 % mutate(sentiment = case_when(weight > 0 ~ "正面",
                                                 weight == 0 ~ "中立",
                                                 weight < 0 ~ "负面"))
head(pixar1)

#评论情感倾向:
library("ggplot2")
head(pixar1)
abb+ggtitle("评论情感倾向")+theme(plot.title = element_text(hjust = 0.45,vjust = 1))

#--------------------可视化评论情感倾向---------------------
#library("dplyr")
pa pixar1 % mutate(sentiment = case_when(weight > 0 ~ "正面",
                                                 weight == 0 ~ "中立",
                                                 weight < 0 ~ "负面"))
head(pixar1)

#评论情感倾向:
library("ggplot2")
head(pixar1)
abb+ggtitle("评论情感倾向")+theme(plot.title = element_text(hjust = 0.45,vjust = 1))

[1]效果图:

r语言评估情感分析模型准确度 r语言文本情感分析_实体词典 情感词典_03

(八)、词云图:

【1】数据预处理:去除无情感值评论:
pixar head(pixar)

pixar$a_type 
#添加相应标签:
pixar$a_type[which(pixar$weight > 0)] pixar$a_type[which(pixar$weight < 0)] 
head(pixar)

【2】数据整合
result                type = 'left',match = 'first')
head(result)

【3】提取正负面的评论信息
head(pixar)
word ind.neg ind.pos 0,select = c('id'))
negdata posdata head(negdata)
head(posdata)

#绘制词云图
library(wordcloud2)
#统计正面评论词频
posFrep posFrep posFrep head(posFrep)
wordcloud2(posFrep[1:300,], size = 2, fontFamily = "微软雅黑",  color = "random-light", backgroundColor = "grey")

#统计负面评论词频
negFrep negFrep negFrep head(negFrep)
wordcloud2(negFrep[1:100,],color = 'random-dark')

【1】数据预处理:去除无情感值评论:
pixar head(pixar)

pixar$a_type 
#添加相应标签:
pixar$a_type[which(pixar$weight > 0)] pixar$a_type[which(pixar$weight < 0)] 
head(pixar)

【2】数据整合
result                type = 'left',match = 'first')
head(result)

【3】提取正负面的评论信息
head(pixar)
word ind.neg ind.pos 0,select = c('id'))
negdata posdata head(negdata)
head(posdata)

#绘制词云图
library(wordcloud2)
#统计正面评论词频
posFrep posFrep posFrep head(posFrep)
wordcloud2(posFrep[1:300,], size = 2, fontFamily = "微软雅黑",  color = "random-light", backgroundColor = "grey")

#统计负面评论词频
negFrep negFrep negFrep head(negFrep)
wordcloud2(negFrep[1:100,],color = 'random-dark')

[1]正面词云图效果:


r语言评估情感分析模型准确度 r语言文本情感分析_数据_04


[2]负 面词云图效果:

r语言评估情感分析模型准确度 r语言文本情感分析_情感分析_05

【3】正负面词云图:

#-----------------------正负面评论词云图:
posFrep$sentimentcolnames(posFrep)head(posFrep)
posFrep %>% filter(n>2)->pos1

negFrep$sentimentcolnames(negFrep)negFrep %>% filter(n>1)->neg1

library("reshape2")
library("RColorBrewer")
neg1 %>% rbind(pos1) %>%
  acast(words ~ sentiment,value.var = "n",fill = 0) %>%
  wordcloud::comparison.cloud(colors=c("gray80","gray20"),
                              title.bg.colors = c("red","green"),
                              random.order=T,
                              rot.per = 0.1,
                              max.words = 74)


#-----------------------正负面评论词云图:
posFrep$sentimentcolnames(posFrep)head(posFrep)
posFrep %>% filter(n>2)->pos1

negFrep$sentimentcolnames(negFrep)negFrep %>% filter(n>1)->neg1

library("reshape2")
library("RColorBrewer")
neg1 %>% rbind(pos1) %>%
  acast(words ~ sentiment,value.var = "n",fill = 0) %>%
  wordcloud::comparison.cloud(colors=c("gray80","gray20"),
                              title.bg.colors = c("red","green"),
                              random.order=T,
                              rot.per = 0.1,
                              max.words = 74)

[4]效果图:

r语言评估情感分析模型准确度 r语言文本情感分析_r语言评估情感分析模型准确度_06