R語言網絡爬蟲學習 基於rvest包

R語言網絡爬蟲學習 基於rvest包

龍君蛋君；2015年3月26日

1.背景介紹：

前幾天看到有人寫了一篇用R爬蟲的文章，感興趣，於是自己學習了。好吧，其實我和那篇文章R語言爬蟲初嘗試-基於RVEST包學習 的主人認識～

2.知識引用與學習：

1.R語言爬蟲初嘗試-基於RVEST包學習

2.大數據分析之——足彩數據趴取

3.rvest + CSS Selector 網頁數據抓取的最佳選擇

4.rvest的github

3.正文：

第一個爬蟲是爬取了戴申大牛在科學網博客的一些基本信息，戴申大牛看到這篇文章不要打我啊～我只是爬取了博文的幾個字段，求饒恕～

 

library(rvest)
library(sqldf)
library(gsubfn)
library(proto)
#creat a function
extrafun <- function(i,non_pn_url){
    url <- paste0(non_pn_url,i)
    web <- html(url)
    papername<- web %>% html_nodes("dl.bbda dt.xs2 a") %>% html_text()%>% .[c(seq(2,20,2))] %>% as.character()
    paperlink<-gsub("\\?source\\=search","",web %>% html_nodes("dl.bbda dt.xs2 a") %>% html_attr("href"))%>% .[c(seq(2,20,2))]
    paperlink <- paste0("http://blog.sciencenet.cn/",paperlink) %>% as.character()
    posttime <- web %>% html_nodes("dl.bbda dd span.xg1") %>% html_text() %>% as.Date()#這里取每篇文章的發布時間
    count_of_read <- web %>% html_nodes("dl.bbda dd.xg1 a") %>% html_text()
    count_of_read <- as.data.frame(count_of_read)
    count_of_read <- sqldf("select * from count_of_read where count_of_read like '%次閱讀'")
    data.frame(papername,posttime,count_of_read,paperlink)
}
#crawl data
final <- data.frame()
url <- 'http://blog.sciencenet.cn/home.php?mod=space&uid=556556&do=blog&view=me&page='
for(i in 1:40){
   extrafun(i,url)
   final <- rbind(final,extrafun(i,url))
}
> dim(final)
[1] 400   4
> head(final)
                                                   papername
1                                             此均值非彼均值
2             [轉載]孔丘、孔子、孔老二，它究竟是一只什么鳥？
3                          大數據分析之——k-means聚類中的坑
4                               大數據分析之——足彩數據趴取
5 [轉載]老王這次要攤事了，當年他主管的部門是事被重新抖出來。
6                                 [轉載]黨衛軍是這樣抓人的。
    posttime count_of_read
1 2015-03-08    216 次閱讀
2 2015-02-10    190 次閱讀
3 2015-01-18    380 次閱讀
4 2015-01-10    437 次閱讀
5 2015-01-05    480 次閱讀
6 2015-01-05    398 次閱讀
                                          paperlink
1 http://blog.sciencenet.cn/blog-556556-872813.html
2 http://blog.sciencenet.cn/blog-556556-866932.html
3 http://blog.sciencenet.cn/blog-556556-860647.html
4 http://blog.sciencenet.cn/blog-556556-858171.html
5 http://blog.sciencenet.cn/blog-556556-856705.html
6 http://blog.sciencenet.cn/blog-556556-856640.html

抓取的數據不能直接用作分析，於是導出到Excel，對數據做了一些處理，然后繪制了一張圖。

write.table(final,"final.csv",fileEncoding="GB2312")
#抓取的數據需要在Excel進一步加工，加工后讀取進來，進一步做分析
a <- read.table("dai_shen_blog_0326.csv",header=TRUE,sep=";",fileEncoding="GB2312")#Mac OS 環境下，要sep＝";"
a$posttime <- as.Date(a$posttime)
a$paperlink <- as.character(a$paperlink)
a$papername <- as.character(a$papername)
a$count_of_read_NO. <- as.numeric(a$count_of_read_NO.)
library(ggplot2)
qplot(posttime,count_of_read_NO.,data=a,geom="point",colour=repost,size=6)

這張圖說明了什么呢？？

a).戴大牛在2012年上半年沒寫文章也沒有轉載文章（不知道發生了什么，難道是忘記博客登錄密碼了，哈哈～有可能），但下半年原創文章數量是最多的，數量占life time約1/3；

b).在2013年一整年,文章數量上半年明顯多余下半年，全年文章總數量占life time約2/5,且原創和轉載各半；

c).在2014年中，上半年文章數量明顯少於下半年，轉載和原創各半。

第二個爬蟲是爬取了NBA2014-2015常規賽技術統計排行 - 得分榜 

#Crawl NBA player statistics from sina
#web http://nba.sports.sina.com.cn/playerstats.php?s=0&e=49&key=1&t=1
library(rvest)
library(stringr)
library(sqldf)
rm(NBAdata)
start <- seq(0,250,50)
end <- seq(49,299,50)
getdata <- function(i){
    url <- paste0('http://nba.sports.sina.com.cn/playerstats.php?s=',start[i],'&e=',end[i],'&key=1&t=1')
    rank <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(1)") %>% html_text()%>%.[-1]%>%as.numeric()
    player <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(2)") %>% html_text()%>%.[-1]%>%str_sub(9,100)%>%as.character()
    team <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(3)") %>% html_text()%>%.[-1]%>%str_sub(9,100)%>%as.character()
    avg_score <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(4)") %>% html_text()%>%.[-1]
    total_score <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(5)") %>% html_text()%>%.[-1]
    total_shoot <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(6)") %>% html_text()%>%.[-1]
    three_point <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(7)") %>% html_text()%>%.[-1]
    punish_point <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(8)") %>% html_text()%>%.[-1]
    avg_time <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(9)") %>% html_text()%>%.[-1]
    total_involve <- url %>% html_session() %>% html_nodes("table") %>% .[[2]] %>% html_nodes("td:nth-child(10)") %>% html_text()%>%.[-1]
    data.frame(rank,player,team,avg_score,total_score,total_shoot,three_point,punish_point,avg_time,total_involve)

}

NBAdata <- data.frame()
for(i in 1:6){
    NBAdata <- rbind(NBAdata,getdata(i))
}
NBAdata <- sqldf("select distinct * from NBAdata")
write.table(NBAdata,"NBAdata.csv",sep=",",fileEncoding="GB2312")

> head(NBAdata)
  rank            player team avg_score total_score
1    1 拉塞爾-威斯布魯克 雷霆      27.3        1556
2    2       詹姆斯-哈登 火箭      27.1        1900
3    3     勒布朗-詹姆斯 騎士      25.8        1600
4    4     安東尼-戴維斯 鵜鶘      24.6        1403
5    5   德馬庫斯-考辛斯 國王      23.8        1308
6    6       斯蒂芬-庫里 勇士      23.4        1618
  total_shoot three_point punish_point avg_time
1       42.7%       30.1%        84.6%     33.8
2         44%       36.8%        86.6%     36.8
3       49.2%       35.4%        71.9%     36.2
4       54.5%         10%        81.4%     36.2
5       46.5%       28.6%        80.2%     33.7
6       47.9%       42.2%        91.4%     32.9
  total_involve
1            57
2            70
3            62
4            57
5            55
6            69

發現NBA2014-2015常規賽技術統計排行 - 得分榜 有兩個錯誤。

a).排名第50的NBA球星缺失。

b).數據有大量重復，初次爬取，有510條記錄，最后發現原來這個數據統計本身就有很多重復，於是用SQL去重，得到270條記錄。

4.總結：

a).SelectorGadget 真的很好用，但是貌似這個插件要翻牆才能安裝成功。SelectorGadget結合Google Chrome 使用，查找html_nodes 非常方便。

b).下次爬，要學尾巴同學，爬一些招聘網站的數據，給自己以后找工作做個參考嘛。

以上。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

以下內容修改於2015-04-01　

今天閑來無事，瀏覽戴申同學的一篇博文

http://blog.sciencenet.cn/blog-556556-848696.html

發現自己之前對於 NBA2014-2015常規賽技術統計排行 - 得分榜 這個爬蟲寫的極為失敗，特做出以下更新：

library(rvest)
library(stringr)
library(sqldf)
start <- seq(0,250,50)
end <- seq(49,299,50)
getdata <- function(i){
    url <- paste0('http://nba.sports.sina.com.cn/playerstats.php?s=',start[i],'&e=',end[i],'&key=1&t=1')
    dat <- url %>% html() %>% html_nodes("table")%>%.[[2]]%>%html_table(head=TRUE)
    data.frame(dat)
}
NBAdata <- data.frame()
for(i in 1:6){
    NBAdata <- rbind(NBAdata,getdata(i))
}
NBAdata <- sqldf("select distinct * from NBAdata")
dim(NBAdata)
write.table(NBAdata,"NBAdata.csv",sep=",",fileEncoding="GB2312")

> head(NBAdata)
  排名              球員 球隊 場均得分 得分總數 投籃命中率
1    1 拉塞爾-威斯布魯克 雷霆     27.6     1626      42.5%
2    2       詹姆斯-哈登 火箭     27.2     1988      43.8%
3    3     勒布朗-詹姆斯 騎士     25.7     1644      48.9%
4    4     安東尼-戴維斯 鵜鶘     24.7     1455      54.1%
5    5   德馬庫斯-考辛斯 國王     24.1     1347      46.8%
6    6       斯蒂芬-庫里 勇士     23.7     1708      48.3%
  三分命中率 罰籃命中率 場均時間 參賽場次
1      29.7%      84.6%     34.0       59
2      36.9%      86.6%     36.9       73
3      35.3%      71.7%     36.3       64
4        10%      81.2%     36.3       59
5      28.6%      79.7%     33.9       56
6      43.4%      91.8%     32.9       72

總結：網頁中若有table，則可以直接讀取，然后用html_table(),可以直接轉化為table，十分方便。