R语言爬虫豆瓣高评分电影TOP250抓取

      这里面主要用到R/Rstudio里面的RCurl、XML、wordcloud、stringr、jiebaR勒几个包，熟悉的娃晓得R里面爬虫明星般的包就是RCurl和Rvset了，不过对于更强大的Rselenium、Rwebdriver什么的先不要管了，别把自己玩疯了，作文本处理的wordcloud和jiebaR挺好玩的，我这不讲解专业知识要看去百度爸爸那里去要，也可以留言，发现某个小可爱我会call你的

library(RCurl)
library(RMySQL)
library(XML)
library(stringr)
library(tcltk)
library(jiebaR)
library(wordcloud2)

                         #这才开始别急，好戏开演了

#连接数据库，把有些老司机的东西存在库里面就不会丢了哦

conn<-dbConnect(MySQL(),dbname="mysql",user="root",password="lee0305",host="127.0.0.1",port=3306)
#http请求头
myheader <- c("User-Agent"="Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:50.0) Gecko/20100101 Firefox/50.0",
                  "Accept"="text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8",
                  "Accept-Language"="en-us",
                  "Connection"="keep-alive",
                  "Accept-Charset"="GB2312,utf-8;q=0.7,*;q=0.7")
#网址拆分，根据网址的构成拆分便于爬取
fpart<-"https://movie.douban.com/top250?start="
page_basen<-25
k=0
j=0:9
lpart<-"&filter="

#建立空白数据框，准备个箩筐哈，捡肥皂了好带回家，你是不是这样的？
doubanmovie<-data.frame()
#爬取进度显示，

#这个了，其实没得多大用处，就是看看爬到哪了，但是量大的时候可以看看进度还不错，如果出问题了，还可以设置跳出去看看哪出bug了

pbar<-tkProgressBar(title="进度",label="主人，我已完成%",min=0,max=100,initial=0,width=500)

#调试信息收集，网站那头的就不喜欢我们这样的来袭，所以看看我们获取的时候有没什么异常的，不过我这点量是不可能的，哈哈哈
dg<-debugGatherer()

#数据获取、解析
for(k in j){
  spider_url<-str_c(fpart,page_basen*k,lpart,sep="")
  #网址请求、解析网页
  analysis_url<-getURL(spider_url,httpheader=myheader,debugfunction=dg$update,verbose=TRUE)
  
  ana_doc<-htmlParse(analysis_url,encoding = "UTF-8")
  #电影中文名提取
  mname<-xpathSApply(ana_doc,"//*/span[@class='title'][1]",xmlValue)
 
  #电影别名提取一波三折啊
  oname<-xpathSApply(ana_doc,"//*/span[@class='other']",xmlValue)
  oname0<-str_split_fixed(str_trim(oname),"/",3)
  oname1<-str_trim(str_replace_all(oname0[,2],"/[:blank:]",""))
  oname2<-str_trim(oname0[,3])
  #导演、主演等信息，
  mdirector<-xpathSApply(ana_doc,"//*/div[@class='bd']/p[1]",xmlValue)
  mdfixed1<-str_split_fixed(mdirector,"主演|主",2)
  #导演
  mdir<-str_trim(str_sub(mdfixed1[,1],start=str_locate(mdfixed1[,1],"导演")[1]+3))
  
  mdfixed2<-str_split_fixed(mdfixed1[,2],"\n",2)
  #主演，非要整这么主角，麻烦
  lactor<-str_replace(mdfixed2[,1],":[:space:]","")
  mdfixed3<-str_split_fixed(mdfixed2[,2],"/",3)
  #上映年份
  myear<-str_trim(mdfixed3[,1])
  #制片国家/地区
  mc<-str_trim(mdfixed3[,2])
  #电影类型
  mtype<-str_trim(str_replace_all(mdfixed3[,3],"\n",""))
  #电影豆瓣评分，勒是好多宝宝关注的梗，哈哈
  ratenum<-xpathSApply(ana_doc,"//*/div[@class='star']/span[@class='rating_num']",xmlValue)
  #豆瓣评价人数 
  rnum<-xpathSApply(ana_doc,"//*/div[@class='star']/span[4]",xmlValue)
  ranum<-str_replace_all(rnum,"人评价","")
  #电影标签
  mtag<-xpathSApply(ana_doc,"//*/p[@class='quote']/span[@class='inq']",xmlValue)
  #电影豆瓣详情链接，剧情介绍啊，评论啊等等等的都有
  mlink<-xpathSApply(ana_doc,"//*/div[@class='item']/div[@class='pic']/a",xmlAttrs)
  mlinks<-str_replace_all(mlink,"href","")  
  #电影封面，你值得拥有
  mpic<-xpathSApply(ana_doc,"//*/div[@class='pic']/a/img",xmlGetAttr,'src')
  doubaninfo<-data.frame(mname,oname1,oname2,mdir,lactor,myear,
                         mc,mtype,ratenum,ranum,mtag,mlinks,mpic)
  doubanmovie<-rbind.data.frame(doubanmovie,doubaninfo)
  
  info<- sprintf("已完成 %d%%", round((k+1)*100/length(j)))  
  setTkProgressBar(pbar, value =(k+1)*100/length(j), title = sprintf("进度 (%s)",info),label = info)
  
  Sys.sleep(5)
}

close(pbar)
#将数据写入数据库，怕掉了啊
dbWriteTable(conn, "doubantop", doubanmovie)

#设置下载图片需要放置的位置，下图片你懂得，有些老司机
setwd("F:/RSTUDIO")
for(m in 1:length(doubanmovie$mpic)){
  mop<-getBinaryURL(doubanmovie$mpic[m])
  picm<-file(paste("num",doubanmovie$mname[m],".jpg",sep=""),open="wb")
  writeBin(mop,picm)
  close(picm)
  Sys.sleep(3)
}

#这里想把前面的数据存着的慢慢看自个写一行代码存起来，哈哈哈哈哈哈哈哈哈哈哈哈

                          来了来了，把数据部分截图给你们瞅瞅

      没得什么可视化给想学习的宝宝看，自个整吧，反正你还年轻还可以熬一熬

#后面这些乱七八糟的了，不扯了不扯了，有兴趣看看瞅瞅事业线飙升
gnum<-group_by(douban,douban$myear)
rnum<-group_size(gnum)
ynum<-count(douban,douban$myear,sort=TRUE)
rwords<-str_split_fixed(doubanmovie$mc," ",5)
write.table(rwords,file="wordsnum.txt",sep="\t",
            quote=FALSE,row.names=FALSE,col.names=FALSE)

#词云制作，草稿，别看了
wordsseg<-readLines("wordsnum.txt",encoding="GBK")
seg<-qseg[wordsseg]
se<-str_replace_all(seg,"[:digit:]","")
segm<-data.frame(table(se)）
wordcloud2(segm,color = "random-light",backgroundColor = "black" ,shape="circle")

假装弄一个词云在这忽悠哈人哈哈哈                                   这下面这个还有个丑的很的结果是这些高分电影数量排名的上映年份和数量

       

还翻，没的了，欢迎大咖们来袭啊，come on