一、前言：
继上一篇推文R文本挖掘——情感分析【1】中的局限与不足进行优化，考虑到否定词对于语句情感得分的影响，以及对评论数据的正面词、负面词进行可视化处理；
二、情感分析简述：
文本分析是目前比较热门的一项研究，文本分析大致流程如下:
1、文本数据获取【R爬虫，现在较为热门的Python爬虫等】
2、文本清洗【包括空格(如果为英文文本，请忽略这一步)、停用词】
3、分词【切词、词频统计、可视化、关键词提取、tm包语料库构建】
4、分析【情感分析、文本聚类等】
5、模型构建【LDA主题建模】
就情感分析而言，目前比较流行的方法有两种，一是词法分析、二是机器学习法。情感分析是对文本内容进行分析，探究其表达情感的技术；
机器学习应用于情感分析尚未成熟，而文本情感分析的词法分析方法对词库要求较高。
在此就分享一下自己如何通过词库的方式为每一句评论定性为正面或负面。词法分析的基本思想就是对每句评论文本进行分词，然后通过匹配正面词典与负面词典，考虑情感词前否定词对语句情感得分的影响，从而计算出语句的正面得分（词中有多少是积极的）与负面得分（词中有多少是消极的），以及综合得分（积极得分减去消极得分）。虽然该方法通俗易懂，但是对词典质量要求较高（直接影响语句情感打分）【此外在使用停用词前，需将停用词中的情感词、否定词去除（如：“不”字等）】，且需耗费大量时间精力整理，如正负面词库的构建、自定义词典的导入等。
三、步骤：
数据集说明：本次情感分析使用电影评论数据1500条，包含好评、中评、差评各500条；
【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)#数据导入：com<-read_csv("D:/good_bad.csv") #数据读取；comment<-com$comment（二）、数据清洗：
#由于是电影评论数据，去掉一些无用高频词语：#这里使用stringr包对数据进行清洗：comment<-str_replace_all(comment,"电影","")comment<-str_replace_all(comment,"动画片","")comment<-str_replace_all(comment,"老爷爷","")comment<-str_replace_all(comment,"皮克斯","")comment<-str_replace_all(comment,"动画","")(三)、评论分词：
#数据清洗后，设置分词引擎，并进行切词处理：#使用jiebaRjiebaRD包、使用停用词前需将停止词中的情感词去除;engine <- worker(type="tag",stop_word = "D:/a情感分析/stoplist.txt")#开始切词：seg_word<-list() #创建存储分词结果的容器；for(i in 1:length(comment)){seg_word[[i]]<- segment(comment[i],engine) #注意[[i]]二维列表}head(seg_word) #查看分词结果（四）、数据整理：
-------------对分词结果进行预处理：词项、所在评论ID、词性：-----------------#这里使用plyr包的sapply(对象，函数)------函数：#【1】统计每条评论的词条个数：n_word<-sapply(seg_word,length) #seg_word是一个列表，统计每个列表中的词数；#【2】根据词数生成相应的句子id数：#rep(对象，重复次数)#index作为id列；#对1:1500条评论，rep()生成相应的n_word次数；index <- rep(1:length(seg_word),n_word)#【3】获取词性：nature <- unlist(sapply(seg_word,names))#【4】整合数据集;result <- data.frame(index,unlist(seg_word),nature)#id为词语所在评论，word为词项，nature为词性；colnames(result) <- c("id","word","nature")head(result)#【5】将每个词在评论分词结果中的位置标记出来index_word <- sapply(n_word, seq_len)#seq_len 函数:输入的数据长度是n, 生成从1到n的序列#比如第一句评论有8个词，seq_len会生成1~8的序列；index_word <- unlist(index_word)result$index_word <- index_word#【6】查看数据集：#result数据说明：id:所在评论；word:词项；nature:词性；index_word:词所在评论的位置head(result)#【7】提取含有名词的评论数据，目的是为了分析哪些特征是观众感兴趣或不感兴趣的is_n <- subset(result,grepl("n",result$nature),"id")#subset()函数用于数据筛选,尝试is_n1 <- subset(result,nature=="n","id"),有什么区别？result_n <- result[result$id%in%is_n$id,]#导出备用：write.csv(result_n,"D:/word.csv",fileEncoding = "gbk")[1]对result数据集简单绘制下词云图，查看效果：
#绘制词云图,查看分词结果library(wordcloud2)#词频统计word.frep <- table(result_n$word)word.frep <- sort(word.frep,decreasing = TRUE)word.frep <- data.frame(word.frep)wordcloud2(word.frep[1:200,],color = "random-dark")wordcloud2(word.frep[1:200,],size = 1, fontFamily = "微软雅黑", color = "random-light", backgroundColor = "grey")[2]效果:
（五）、词典读取：
实操过程中发现，词典读取极易出现乱码问题（即使没有报错，但输出时确实乱码），这里可以试着把词典用Notepad++转换下编码，再读取；【建议读取后，head()查看一下】
#----------------------评论情感分析-------------------------:#这里建议，读取后使用head()查看下，会否乱码；pos.comment<-read.table("D:/a情感分析/正面评价词.txt",fileEncoding = "UTF-8")neg.comment<-read.table("D:/a情感分析/负面评价词.txt",fileEncoding = "UTF-8")pos.emotion <- read.table("D:/a情感分析/正面情感词语（中文）.txt",header = F,stringsAsFactors = F,strip.white = T,skip = 1)neg.emotion<-read.table("D:/a情感分析/负面情感词语（中文）.txt",header = F,stringsAsFactors = F,strip.white = T,skip = 1)【1】词典合并：positive<-rbind(pos.comment,pos.emotion)negative<-rbind(neg.comment,neg.emotion)【2】定位词典中相同的情感词：sameword <- intersect(positive[,1],negative[,1])#intersect()函数两个数值向量取交集#intersect(x=1:4, y = 2:6)#[1] 2 3 4【3】剔除词典中的相同情感词：positive <- data.frame(setdiff(positive[,1],sameword))negative <- data.frame(setdiff(negative[,1],sameword))#setdiff(x, y):求向量x与向量y中不同的元素(只取x中不同的元素)#>setdiff(x=1:4, y=2:3)#[1] 1 4【4】给正、负情感词典赋予权重：positive$weight<-rep(1,length(positive))colnames(positive)<-c("word","weight")negative$weight<-rep(-1,length(negative))colnames(negative)<-c("word","weight")【5】合并词典:posneg<-rbind(positive,negative)head(posneg,n=5)（六）、定位情感词：
【1】将正面结果与正负面情感词表合并，定位情感词# plyr 包,提供了一组规范的数据结构转换形式library(plyr)word <- result#join函数：join(分词结果数据框，情感词数据框，连接字段，连接类型，匹配模式)data.posneg <- join(word,posneg,by = "word",match = "first")head(data.posneg)【2】情感词的修订#根据情感词前是否有否定词或双层否定词对情感值进行修正#载入否定词表notdict <- read.table("D:/a情感分析/否定词典.txt",header = F,fileEncoding = "UTF-8",col.names = "term")head(notdict)notdict$weight<-rep(-1,length(notdict))【3】处理否定修饰词：data.posneg$amend_weight<-data.posneg$weight#只保留有情感词对语句：将NA去除only <- data.posneg[!is.na(data.posneg$weight),]#语句对应整个文档的位置：#回顾：#data.posneg#onlyindex <- as.numeric(row.names(only))for (i in 1:nrow(only)) {#提取第i个情感词所在的评论review <- data.posneg[which(data.posneg$id == only[i,]$id),]#第i个情感词在评论中的位置；affective <- only[i,]$index_wordif(affective == 2){#如果情感词的位置是某个评论中的第二个词;#注意:sum(TRUE) = 1; sum(FALSE) = 0;a.1 <- sum(review$word[affective -1 ]%in%notdict[,1]) #%in%返回逻辑值#判断该词是否在否定词里面,如果求出的和为1，认为该情感词为相反的情感值if(a.1 == 1) data.posneg$amend_weight[index[i]] <- -data.posneg$weight[index[i]]}else if (affective >= 3 ){#当情感词位于评论第三个位置时：#review$word[affective-c(1,2) 提取前两个词；#存在两个否定词，则为肯定，即当sum=1(仅包含一个否定词)时，才需修改情感词值；a.2 <- sum(review$word[affective-c(1,2)]%in%notdict[,1])if(a.2==1) data.posneg$amend_weight[index[i]] <- -data.posneg$weight[index[i]]}}【4】更新只保留有情感值的数据：only <- data.posneg[!is.na(data.posneg$amend_weight),]index <- as.numeric(row.names(only))head(only)【5】计算每条评论的情感值：pixar <- aggregate(only$amend_weight,by=list(only$id),sum)head(pixar)colnames(pixar) <- c("id","weight")（七）、评论情感倾向可视化（ggplot2）
#--------------------可视化评论情感倾向---------------------#library("dplyr")pa <- pixarpixar1 <- pa %>% mutate(sentiment = case_when(weight > 0 ~ "正面",weight == 0 ~ "中立",weight < 0 ~ "负面"))head(pixar1)#评论情感倾向：library("ggplot2")head(pixar1)a<-ggplot(pixar1,aes(x = sentiment,fill = sentiment))+geom_bar(stat = "count")b<-a+geom_text(aes(label=as.character(..count..)),stat="count",vjust=-0.5)b+ggtitle("评论情感倾向")+theme(plot.title = element_text(hjust = 0.45,vjust = 1))[1]效果图:
(八)、词云图：
【1】数据预处理：去除无情感值评论：pixar <- pixar[-which(pixar$weight == 0),]head(pixar)pixar$a_type <- rep(NA,nrow(pixar)) #生成NA列#添加相应标签：pixar$a_type[which(pixar$weight > 0)] <- "positive"pixar$a_type[which(pixar$weight < 0)] <- "negative"head(pixar)【2】数据整合result <- join(pixar,word[,c(1,4)] ,by = "id",type = "left",match = "first")head(result)【3】提取正负面的评论信息head(pixar)word <- read.csv("D:/word.csv",fileEncoding = "gbk")ind.neg <- subset(pixar,pixar$weight<0,select = c("id"))ind.pos <- subset(pixar,pixar$weight>0,select = c("id"))negdata <- word[word$id%in%ind.neg$id,]posdata <- word[word$id%in%ind.pos$id,]head(negdata)head(posdata)#绘制词云图library(wordcloud2)#统计正面评论词频posFrep <- table(posdata$word)posFrep <- sort(posFrep,decreasing = TRUE)posFrep <- data.frame(posFrep)head(posFrep)wordcloud2(posFrep[1:300,], size = 2, fontFamily = "微软雅黑", color = "random-light", backgroundColor = "grey")#统计负面评论词频negFrep <- table(negdata$word)negFrep <- sort(negFrep,decreasing = TRUE)negFrep <- data.frame(negFrep)head(negFrep)wordcloud2(negFrep[1:100,],color = "random-dark")[1]正面词云图效果：
[2]负面词云图效果：
【3】正负面词云图：
#-----------------------正负面评论词云图：posFrep$sentiment<-"positive"colnames(posFrep)<-c("words","n","sentiment")head(posFrep)posFrep %>% filter(n>2)->pos1negFrep$sentiment<-"negative"colnames(negFrep)<-c("words","n","sentiment")negFrep %>% filter(n>1)->neg1library("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数据科学，原创作者：学习是我快乐，请支持原创！
感谢大家耐心看完，自己的文章都写的很细，代码都在原文中，希望大家都可以自己做一做，请关注后私信回复“数据链接”获取所有数据和本人收集的学习资料。如果对您有用请先收藏，再点赞转发。
也欢迎大家的意见和建议。
如果你是一个大学本科生或研究生，如果你正在因为你的统计作业、数据分析、论文、报告、考试等发愁，如果你在使用SPSS,R，Python，Mplus, Excel中遇到任何问题，都可以联系我。因为我可以给您提供最好的，最详细和耐心的数据分析服务。
如果你对Z检验，t检验，方差分析，多元方差分析，回归，卡方检验，相关，多水平模型，结构方程模型，中介调节，量表信效度等等统计技巧有任何问题，请私信我，获取最详细和耐心的指导。
If you are a student and you are worried about you statistical #Assignments, #Data #Analysis, #Thesis, #reports, #composing, #Quizzes, Exams.. And if you are facing problem in #SPSS, #R-Programming, #Excel, Mplus, then contact me. Because I could provide you the best services for your Data Analysis.
Are you confused with statistical Techniques like z-test, t-test, ANOVA, MANOVA, Regression, Logistic Regression, Chi-Square, Correlation, Association, SEM, multilevel model, mediation and moderation etc. for your Data Analysis...??
Then Contact Me. I will solve your Problem...
加油吧，打工人！
往期内容：
R文本挖掘：情感分析
R文本挖掘：文本聚类分析
R文本挖掘：中文文本聚类
R文本挖掘：中文词云生成
R文本挖掘：中文词云生成，以2021新年贺词为例
R文本挖掘：社会网络分析
R文本挖掘：文本主题分析topic analysis
R文本挖掘：手把手教你做词云图，小白教程
