R語言爬蟲豆瓣高評分電影（喝最烈的酒，熬最深的夜，喫最好的胃藥，敷最貴的面膜）

豆瓣電影TOP250抓取

下了那麼多包沒用多少東西，看着黑人，反正prada   prada 的趕緊逃，趕緊的，你會炸的

   這裏面主要用到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")

假裝弄一個詞雲在這忽悠哈人哈哈哈                                   這下面這個還有個醜的很的結果是這些高分電影數量排名的上映年份和數量

       

對應年份電影上映數量

奉節臍橙性涼，味甘酸，歸肺、脾、胃經；具有生津開胃、止嘔、清腸、保護血管的功效。

奉節臍橙中富含維C和維P以及胡蘿蔔素，可以抑制致癌物質的形成，還能軟化和保護血管，促進血液循環，降低膽固醇和血脂；維生素P可以有效防止維C被破壞。鹽蒸橙子是化痰止咳良藥。橙皮裏有兩種成分具有止咳化痰的功效，一個是那可汀，一個是橙皮油。這兩種成分，只有在蒸煮之後纔會從橙皮中出來，所以咳嗽有痰的時候，不妨蒸個橙子試試

https://weidian.com/?userid=1267683370

還翻，沒的了，歡迎大咖們來襲啊，come on