项目背景：本项目旨在通过网络爬虫技术，成功抓取某影评平台上的660条关于电影《我和我对家乡》的热点影评数据。随后，我们利用高效的“结巴分词”工具，并结合自主构建的停用词词典，显著提升了中文分词的准确性。在此基础上，我们采用先进的“TF-IDF”方法为关键词分配权重，进一步增强了主题分类和情感分类的合理性，为后续的数据分析和研究奠定了坚实基础。
若有不足之处，敬请指正！多谢大家关注支持！！
1 相关知识（提前了解版）
1.1 豆瓣影评数据爬取——基于R
网络爬虫是一种从网页中提取所需信息的自动化技术，它利用程序来捕获并提取特定的数据内容。在本文中，我们采用R语言作为爬虫工具，利用其强大的数据处理能力进行统计分析。为了实现这一目标，我们首先引入了RCurl、XML和rvest等R语言的包，这些包为网页数据的抓取提供了必要的支持。
为了确定需要爬取的内容，我们使用SelectorGadget这一开源插件来识别所需数据的标签。在本研究中，我们选择了豆瓣影评网站，并专注于电影《我和我的家乡》的评价页面。我们锁定了“发布者”、“发布时间”和“影评内容”这三个关键属性作为数据抓取的目标。
在爬取过程中，我们首先加载了RCurl、XML和rvest等R语言的包。然后，我们通过影片《我和我的家乡》的页面链接，利用R软件读取了页面站点。接着，我们打开SelectorGadget工具，使用其提供的selector功能获取了片名的CSS选择器。根据这些CSS选择器，我们成功提取了“发布者”、“发布时间”和“影评内容”的数据。
然而，豆瓣电影网站设有反爬取机制，为了应对这一挑战，我们设计了循环抓取网页的语句代码。通过paste函数进行链接拼接，并利用循环语句逐步抓取数据。我们成功捕获了截止到2021年1月4日，《我和我的家乡》的热点影评，包括220条好评、220条差评和220条一般评论，共计660条影片评论。最后，我们创建了一个数据框来存储这些抓取到的数据，为后续的分析和研究提供了丰富的素材。
1.2 中文分词
中文自动分词是指通过计算机技术对中文文本进行自动化的词语切分处理，以便在中文句子中标识出词语之间的界限，类似于英文中的空格分隔。这一过程在中文自然语言处理中扮演着基础且关键的角色。
在进行中文分词之前，我们首先需要确定当前的工作目录，并准备好用户自定义的词典和停用词表，这些文件通常以UTF-8编码的txt文本格式保存。随后，我们导入先前抓取的短评文档数据，通过构建特定的循环语句来清除文本中的数字、字母等非中文字符，这些通常被视为无效特征。
接下来，我们利用结巴分词工具对处理后的中文文本进行自动分词，这是一个基于规则和统计的方法，能够有效识别出文本中的词语边界。分词完成后，我们进一步利用整合好的停用词词典来剔除那些对文本意义不大的停用词，如常见的虚词、助词等。
最后，我们移除分词结果中可能存在的多余空格，并结合短评的文本类别属性，构建出一个中文分词的稀疏矩阵。这个矩阵将作为后续文本分析、主题分类或情感分析等工作的基础，有助于提高分析的准确性和效率。
1.3 关键词主题分类
主题模型（Topic Model）在机器学习和自然语言处理等领域，用来在一系列文档中发现抽象主题的一种统计模型。一个主题模型用数学框架来体现文档的这种特点，主题模型自动分析每个文档，统计文档内的词语，根据统计的信息来断定当前文档含有哪些主题，以及每个主题所占的比例各为多少。
在本文中利用文档-词频矩阵实现文本数据的结构化、使用共现分析利用词汇共同出现的情况，定量地研究文本关系后，我们进行主题建模，根据主题建模效果设定3个主题：即人物、剧情、心理，将以上的处理转化为数据框格式，并且创建数据框储存分类信息。
2 数据采集及预处理
2.1 数据来源
为了得到相关数据来研究电影《我和我的家乡》短评中语言情感倾向，我们小组选择在豆瓣网站上以爬虫的方式获取所需的影评数据。在爬取时我们选择以2021年1月4日为截止点，选择该影片最新最火热的数百条短评，但由于豆瓣网站的反爬取机制，受到限制不能抓取全部评论，于是设置循环抓取网页的语句代码，循环共抓取660条电影短评。
基础站点：我和我的家乡 短评
2.2 数据采集代码（采集+存储）
##爬虫部分（爬取豆瓣影评）
library("XML")
library("rvest")
library("stringr")
library("rlist")
setwd("F:\\爬虫")
##循环抓取网页（好评）
candidate_date=Sys.Date()%>%format('%Y年%m月%d日')#设置日期格式
fun <-function(x){
re=c(x[18],candidate_date)
re=data.frame(发布者=re[1],日期=re[2])
return(re)
}#创建格式函数
comments <- data.frame()
index <-seq(0,220,20)
for (i in index){# 读取网址
url = paste("https://movie.douban.com/subject/35051512/comments?percent_type=h&start=",i,"&limit=20&status=P&sort=new_score")
url2<-str_replace_all(url," ","") #合并网页去掉空格
web <-read_html(url2,encoding ='utf-8')%>%
html_nodes('p.comment-content')%>%html_text()# 爬取豆瓣好评
web1<-str_replace_all(web," ","") #去掉好评空格
web2<-gsub("\n","",web1) #去掉好评换行符
author<-read_html(url2,encoding ='utf-8')%>%
html_nodes('span.comment-info')%>%html_text()%>%str_split('\\s')
comments_data<-data.frame(author%>%lapply(fun)%>%list.stack(),"评论"=web2) #转化为数据框格式
# 创建数据框存储以上信息
comments <- rbind(comments,comments_data)
}
write.csv (comments,file="好评.csv",row.names=FALSE)
##循环抓取网页（差评）
candidate_date=Sys.Date()%>%format('%Y年%m月%d日')#设置日期格式
fun <-function(x){
re=c(x[18],candidate_date)
re=data.frame(发布者=re[1],日期=re[2])
return(re)
}#创建格式函数
comments <- data.frame()
index1 <-seq(0,220,20)
for (i in index1){# 读取网址
url = paste("https://movie.douban.com/subject/35051512/comments?percent_type=l&start=",i,"&limit=20&status=P&sort=new_score")
url2<-str_replace_all(url," ","") #合并网页去掉空格
web <-read_html(url2,encoding ='utf-8')%>%
html_nodes('p.comment-content')%>%html_text()# 爬取豆瓣好评
web1<-str_replace_all(web," ","") #去掉好评空格
web2<-gsub("\n","",web1) #去掉好评换行符
author<-read_html(url2,encoding ='utf-8')%>%
html_nodes('span.comment-info')%>%html_text()%>%str_split('\\s')
comments_data<-data.frame(author%>%lapply(fun)%>%list.stack(),"评论"=web2) #转化为数据框格式
# 创建数据框存储以上信息
comments <- rbind(comments,comments_data)
}
write.csv (comments,file="豆瓣差评.csv",row.names=FALSE)
##循环抓取网页（一般）
candidate_date=Sys.Date()%>%format('%Y年%m月%d日')#设置日期格式
fun <-function(x){
re=c(x[18],candidate_date)
re=data.frame(发布者=re[1],日期=re[2])
return(re)
}#创建格式函数
comments <- data.frame()
index1 <-seq(0,220,20)
for (i in index1){# 读取网址
url = paste("https://movie.douban.com/subject/35051512/comments?percent_type=m&start=",i,"&limit=20&status=P&sort=new_score")
url2<-str_replace_all(url," ","") #合并网页去掉空格
web <-read_html(url2,encoding ='utf-8')%>%
html_nodes('p.comment-content')%>%html_text()# 爬取豆瓣好评
web1<-str_replace_all(web," ","") #去掉好评空格
web2<-gsub("\n","",web1) #去掉好评换行符
author<-read_html(url2,encoding ='utf-8')%>%
html_nodes('span.comment-info')%>%html_text()%>%str_split('\\s')
comments_data<-data.frame(author%>%lapply(fun)%>%list.stack(),"评论"=web2) #转化为数据框格式
# 创建数据框存储以上信息
comments <- rbind(comments,comments_data)
}
write.csv (comments,file="豆瓣一般.csv",row.names=FALSE)
##循环抓取网页（最新）
candidate_date=Sys.Date()%>%format('%Y年%m月%d日')#设置日期格式
fun1 <-function(x){
re=c(x[18],candidate_date)
re=data.frame(发布者=re[1],日期=re[2])
return(re)
}#创建格式函数
comments <- data.frame()
index1 <-seq(0,80,20)
for (i in index1){# 读取网址
url = paste("https://movie.douban.com/subject/35051512/comments?start=",i,"&limit=20&status=P&sort=time")
url3<-str_replace_all(url," ","") #合并网页去掉空格
web <-read_html(url3,encoding ='utf-8')%>%
html_nodes('p.comment-content')%>%html_text()# 爬取豆瓣好评
web1<-str_replace_all(web," ","") #去掉好评空格
web2<-gsub("\n","",web1) #去掉好评换行符
author<-read_html(url3,encoding ='utf-8')%>%
html_nodes('span.comment-info')%>%html_text()%>%str_split('\\s')
comments_data<-data.frame(author%>%lapply(fun1)%>%list.stack(),"评论"=web) #转化为数据框格式
# 创建数据框存储以上信息
comments <- rbind(comments,comments_data)
}
write.csv (comments,file="豆瓣最新（预测集）.csv",row.names=FALSE)
2.3 数据预处理思路
通过上述爬虫后我们得到原始数据，部分数据见下表。
具体数据预处理操作流程如下图所示：
首先，创建循环数据结构剔除影评文本中的标点、数字、字母等无效属性；然后我们通过对所获取的影评文本进行结巴分词处理，结巴分词是利用已用中文词库（使用者可以根据自身需要可以在原词库基础上再进行添加新词），确定汉字之间的关联概率，汉字间概率大的组成词组，形成分词结果。通过剔除数字、字母文本后，发现第387、420、464的个案为空白文本，所以去除这3个个案；接着，我们根据自己汇总的停用词典（共1892个停用词）去除中文分词文本中的停用词，停用词主要用于过滤一些无效、无实质意义或者干扰词汇，例如“哒”、“吱”、“呃”等字、词或者词组，在剔除了停用词后发现第358、528、584、593个个案的影评无内容，所以剔除这四个个案。为了生成文本稀疏矩阵，我们创建了不稳定语料库，并去除了多余的空格，生成了具有TF-IDF特征的稀疏矩阵，最后，将标准化后的稀疏矩阵与评论类别属性合并为一个CSV文件。
2.3.1 中文分词代码
##数据预处理部分
library("rJava")
library("NLP")
library("tm")
library("Rwordseg")
#调入绘制词云的库
library("RColorBrewer")
library("wordcloud")
head(data1)
#将文本存储到一个向量中
data <- read.csv("评论样本集.csv",header=T, stringsAsFactors=T)#读取数据
head(data)
######################数字处理##########################
removeNumbers = function(x) { ret = gsub("[0-9０１２３４５６７８９]","",x) }
sample.words <- lapply(data$评论, removeNumbers)
doc=c(NULL)
for(i in 1:dim(data)[1]){
doc=c(doc,sample.words[i])
}
######################## 字母处理###########################
doc=gsub(pattern="[a-zA-Z]+","",doc)
#################################################################
########################结巴分词############################
#去除结巴分词异常数据（异常：前面操作使数据变成空）
doc1<-doc[-c(387,420,464)]
library(jiebaR)
tagger<-worker()
doc_CN=list()
for(j in 1:657){
doc_CN[[j]]=c( tagger<=doc1[j])
}
#############################
#结巴分词后为657条有效数据
###################去停用词##############################
mystopwords<- unlist (read.table("停用词.txt",stringsAsFactors=F,encoding = "UTF-8"))
sample.words <- doc_CN
for(i in 1:length(sample.words))
{
sample.words[[i]]=sample.words[[i]][!sample.words[[i]]%in%mystopwords]
sample.words[[i]]=subset(sample.words[[i]], nchar(as.character(sample.words[[i]]))>1 )
sample.words[[i]]=paste(sample.words[[i]],sep = " ",collapse =" ")
}
2.3.2 文本稀疏矩阵生成代码
##########生成文本稀疏矩阵
library("tm")
reuters =VCorpus(VectorSource(sample.words))
as.character(reuters[[1]])
lapply(reuters[c(358,528,584,593)], as.character)
#去除行358,528,584,593（空）
reuters1<-reuters[-c(358,528,584,593)]
##################################################3###########
###########################################################
reuters2<-tm_map(reuters1,stripWhitespace) #去除额外空格
##生成稀疏矩阵
dtm<-DocumentTermMatrix(reuters1)
# 删除停用词
############################
################################333
####生成tfidf特征##################
control=list(removePunctuation=T,minDocFreq=5,wordLengths = c(1, Inf),
weighting = weightTfIdf) #IF-IDF特征
doc.tdm=TermDocumentMatrix(reuters2,control)
#变量control是一个选项列表，控制如何抽取文档，removePunctuation表示去除标点，
#minDocFreq=5表示只有在文档中至少出现5次的词才会出现在TDM的行中。
#tm包默认TDM中只保留至少3个字的词（对英文来说比较合适，中文就不适用了吧……），
#wordLengths = c(1, Inf)表示字的长度至少从1开始。
######
data2<-data.frame(data$分类[-c(387,420,464)])
names(data2)<-c("level") #列命名
data3<-data.frame(data2$level[-c(358,528,584,593)]) #去除数据后剩余653条数据
length(doc.tdm$dimnames$Terms) #项目列数
#tdm_removed=removeSparseTerms(doc.tdm, 0.995)# 去除了低于 99.5% 的稀疏条目项
length(tdm_removed$dimnames$Terms) #项目列数
mat = as.matrix(doc.tdm)####转换成文档矩阵
mat2<-data.frame(t(mat))
##合并稀疏矩阵大数据集
data4<-data.frame(cbind(mat2,data3))
write.csv (data4,file="评论稀疏矩阵.csv",row.names=FALSE)#创建大稀疏矩阵文件
data5<-read.csv("评论稀疏矩阵.csv")
data5$data2.level..c.358..528..584..593..
data6<-data5[,-c(5025)]
#归一化自变量
data7<-data.frame(scale(data6))
data8<-data.frame(cbind(data7,data5$data2.level..c.358..528..584..593..))
#标准化自变量后的矩阵
write.csv (data8,file="标准化评论矩阵.csv",row.names=FALSE)
经过上述的一系列数据预处理后，我们可以得到处理后的部分数据格式见下表所示。
2.4 主题模型构建（代码+分析）
主题模型的主要技术是隐含狄式分布（LDA），它假定在文档里能找到的主题和单词分布来源事先按照狄式分布抽样的隐藏多项分布，主题模型可以视为聚类的一种形式。主题模型在机器学习和自然语言处理等领域中是一种在一系列文档中发现抽象主题的统计模型，主题模型通过词项在文档级的共现信息中抽取出语义相关的主题集合，并能将词项空间中的文档变换到主题空间,得到文档在低维空间的表达，潜在狄利克雷分布模型是一种广泛使用的主题模型。
在本文中我们将研究数据拆分为3个文件，即好评文件、差评文件、一般评论文件，在对数据进行一系列的预处理后，就做好建模的准备。首先进行初始化参数操作，在建立模型时经过程序的预运行我们设置了3个主题属性，在完成模型后会将文档自动归分为3个主题，通过加载LDA数据包即可完成初步LDA建模。
运行程序：
library(lda)
sample.words1<-sample.words[-c(358,528,584,593)]#去除空
corpus <- lexicalize(sample.words1, lower=TRUE)
num.topics <- 3#3个主题
## 初始化参数
params <- sample(c(-1, 1), num.topics, replace=TRUE)
poliblog.ratings<- sample(c(-100, 100),653, replace=TRUE)
result <- slda.em(documents=corpus$documents,
K=num.topics,
vocab=corpus$vocab,
num.e.iterations=30,
num.m.iterations=12,
alpha=1.0, eta=0.1,
poliblog.ratings / 100,
params,
variance=0.25,
lambda=1.0,
logistic=FALSE,
method="sLDA")
## 绘图.
Topics <- apply(top.topic.words(result$topics, 8, by.score=TRUE),
2, paste, collapse=" ")
aa=length(Topics)
t=c()
for(i in 1:aa)
{t[i]=paste(i,Topics[i],sep="")}
a=apply(result$document_sums,
1,sum)
names(a)<-t
p=data.frame(a=t,b=a)
p=p[order(p[,2],decreasing=T),]
a1=c()
c=c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"
,"za","zb","zc","zd")
for(i in 1:aa)
{
a1[i]= paste(c[i],p$a[i],sep="")
}
p1=data.frame(a=a1,主题得分=p$b)#############################主题分类#######################
library(lda)
sample.words1<-sample.words[-c(358,528,584,593)]#去除空
corpus <- lexicalize(sample.words1, lower=TRUE)
num.topics <- 3#3个主题
## 初始化参数
params <- sample(c(-1, 1), num.topics, replace=TRUE)
poliblog.ratings<- sample(c(-100, 100),653, replace=TRUE)
result <- slda.em(documents=corpus$documents,
K=num.topics,
vocab=corpus$vocab,
num.e.iterations=30,
num.m.iterations=12,
alpha=1.0, eta=0.1,
poliblog.ratings / 100,
params,
variance=0.25,
lambda=1.0,
logistic=FALSE,
method="sLDA")
## 绘图.
Topics <- apply(top.topic.words(result$topics, 8, by.score=TRUE),
2, paste, collapse=" ")
aa=length(Topics)
t=c()
for(i in 1:aa)
{t[i]=paste(i,Topics[i],sep="")}
a=apply(result$document_sums,
1,sum)
names(a)<-t
p=data.frame(a=t,b=a)
p=p[order(p[,2],decreasing=T),]
a1=c()
c=c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"
,"za","zb","zc","zd")
for(i in 1:aa)
{
a1[i]= paste(c[i],p$a[i],sep="")
}
p1=data.frame(a=a1,主题得分=p$b)
library(ggplot2)
ggplot(data=p1, aes(x=a, y=主题得分, fill=主题得分)) +
geom_bar(colour="black", stat="identity") +
labs(x = "主题", y = "得分") + ggtitle("文档主题排名顺序")+ coord_flip()
Topics <- top.topic.words(result$topics, 20, by.score=TRUE)#每个主题最多词汇
Topics1 <- top.topic.words(result$topics, by.score=TRUE)#每个主题最多词汇
a=c()
b=c()
for(i in 1:3)
{
a=c(a,Topics[,i])
b=c(b,rep(paste("主题",i,sep=""),20))
}
a = table(a, b)
a = as.matrix(a)
library(wordcloud)
comparison.cloud(a, scale = c(1, 1.5), rot.per = 0.5,
colors = brewer.pal(ncol(a), "Dark2"))
在我们研究的此次主题模型中，我们选择查看每个主题最重要的20个词，首先将数据转化为dtm矩阵，从矩阵中计算每个词条的频率，转换为数值型向量后去掉属性名，组成新的词频数据框，得到的结果如下表所示。
通过ggplot2可视化，用R软件对三个文档文本数据进行主题模型主题得分计算，根据每个文档主题得分进行文档主题排名排序，我们得到下图：
通过上图我们可以看到，得分最高的是a3，其文档频率最高的词为“最后一课”、“北京”、“真的”等；其次是文档b2，前几个词为“没有”、“什么故事”、“每个家乡”等；得分最低的是文档c1，文档前几个词是“电影”、“祖国”、“这种”等。
根据LDA主题模型，从不同主题着手进行词云图绘制，如下图，我们根据不同主题词云特征确定三个主题分别为人物、剧情、心理，分别为主题3、主题2、主题1，其中任务类别主要涉及网友对人物的评价；剧情类别主要涉及网友对剧中情节的评价；心理主要涉及网友关于电影引发的感概。
一、Python所有方向的学习路线
Python所有方向路线就是把Python常用的技术点做整理，形成各个领域的知识点汇总，它的用处就在于，你可以按照上面的知识点去找对应的学习资源，保证自己学得较为全面。
二、学习软件
工欲善其事必先利其器。学习Python常用的开发软件都在这里了，给大家节省了很多时间。
三、入门学习视频
我们在看视频学习的时候，不能光动眼动脑不动手，比较科学的学习方法是在理解之后运用它们，这时候练手项目就很适合了。
网上学习资料一大堆，但如果学到的知识不成体系，遇到问题时只是浅尝辄止，不再深入研究，那么很难做到真正的技术提升。
一个人可以走的很快，但一群人才能走的更远！不论你是正从事IT行业的老鸟或是对IT行业感兴趣的新人，都欢迎加入我们的的圈子（技术交流、学习资源、职场吐槽、大厂内推、面试辅导），让我们一起学习成长！
1343
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
