【R语言爬虫实战】——爬取某影评并建立主题模型（附完整代码

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 数据预处理思路


  通过上述爬虫后我们得到原始数据，部分数据见下表。


![](https://img-blog.csdnimg.cn/img_convert/7466eefa02ad06497f0cc151251e197a.png)


  具体数据预处理操作流程如下图所示：


![](https://img-blog.csdnimg.cn/img_convert/ad63284e3c3e16a969f3631e33915840.png)


  首先，创建循环数据结构剔除影评文本中的标点、数字、字母等无效属性；然后我们通过对所获取的影评文本进行结巴分词处理，结巴分词是利用已用中文词库（使用者可以根据自身需要可以在原词库基础上再进行添加新词），确定汉字之间的关联概率，汉字间概率大的组成词组，形成分词结果。通过剔除数字、字母文本后，发现第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(dataKaTeX parse error: Expected 'EOF', got '#' at position 47: …2)<-c("level") #̲列命名 data3<-data…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”)
data5KaTeX parse error: Expected 'EOF', got '#' at position 61: …ta5[,-c(5025)] #̲归一化自变量 data7<-d…data2.level…c.358…528…584…593…))
#标准化自变量后的矩阵
write.csv (data8,file=“标准化评论矩阵.csv”,row.names=FALSE)

  经过上述的一系列数据预处理后，我们可以得到处理后的部分数据格式见下表所示。


![](https://img-blog.csdnimg.cn/img_convert/19865ee36be253c1234324221b3f1c25.png)


### 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(resultKaTeX parse error: Expected '}', got 'EOF' at end of input: …]= paste(c[i],pa[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(resultKaTeX parse error: Expected '}', got 'EOF' at end of input: …]= paste(c[i],pa[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(resultKaTeX parse error: Expected 'EOF', got '#' at position 27: … by.score=TRUE)#̲每个主题最多词汇 Topics…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矩阵，从矩阵中计算每个词条的频率，转换为数值型向量后去掉属性名，组成新的词频数据框，得到的结果如下表所示。


![](https://img-blog.csdnimg.cn/img_convert/4ad6facaeb1777d985200246bfcbd2f3.png)


  通过ggplot2可视化，用R软件对三个文档文本数据进行主题模型主题得分计算，根据每个文档主题得分进行文档主题排名排序，我们得到下图：


![](https://img-blog.csdnimg.cn/img_convert/6a46b8fb5fc6af13c86cc3d5b050603d.png)


  通过上图我们可以看到，得分最高的是a3，其文档频率最高的词为“最后一课”、“北京”、“真的”等；其次是文档b2，前几个词为“没有”、“什么故事”、“每个家乡”等；得分最低的是文档c1，文档前几个词是“电影”、“祖国”、“这种”等。


  根据LDA主题模型，从不同主题着手进行词云图绘制，如下图，我们根据不同主题词云特征确定三个主题分别为人物、剧情、心理，分别为主题3、主题2、主题1，其中任务类别主要涉及网友对人物的评价；剧情类别主要涉及网友对剧中情节的评价；心理主要涉及网友关于电影引发的感概。


![](https://img-blog.csdnimg.cn/img_convert/ec1ce1cf6e2981d64d52f796393792a3.png)


## 3 完整程序

##爬虫部分（爬取豆瓣影评）
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)
######################################################################
######################################################################
##数据预处理部分

##数据预处理部分
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 =” ")
}
#############################主题分类#######################

感谢每一个认真阅读我文章的人，看着粉丝一路的上涨和关注，礼尚往来总是要有的：

①　2000多本Python电子书（主流和经典的书籍应该都有了）

②　Python标准库资料（最全中文版）

③　项目源码（四五十个有趣且经典的练手项目及源码）

④　Python基础入门、爬虫、web开发、大数据分析方面的视频（适合小白学习）

⑤ Python学习路线图（告别不入流的学习）

网上学习资料一大堆，但如果学到的知识不成体系，遇到问题时只是浅尝辄止，不再深入研究，那么很难做到真正的技术提升。

需要这份系统化学习资料的朋友，可以戳这里无偿获取

一个人可以走的很快，但一群人才能走的更远！不论你是正从事IT行业的老鸟或是对IT行业感兴趣的新人，都欢迎加入我们的的圈子（技术交流、学习资源、职场吐槽、大厂内推、面试辅导），让我们一起学习成长！