R語言從小木蟲網頁批量提取考研調劑信息

一、從URL讀取並返回html樹

    1.1 Rcurl包

        使用Rcurl包可以方便的向服務器發出請求，捕獲URI，get 和 post 表單。比R socktet連接要提供更高水平的交互，並且支持 FTP/FTPS/TFTP，SSL/HTTPS,telnet 和cookies等。本文用到的函數是basicTextGatherer和getURL。想詳細了解這個包的可以點擊參考資料的鏈接。

        R命令：

        h <- basicTextGatherer( )   # 查看服務器返回的頭信息
        txt <- getURL(url, headerfunction = h$update,.encoding="UTF-8...")  # 返回字符串形式html

       參數url即為需要訪問的url這里參數用headerfunction用到上一條命令返回的頭信息，.encoding指定網頁的編碼方式為“UTF-8"。

       網頁的編碼方式有很多，一般采用UTF-8，一些中文網頁編碼方式為“gbk"，可以在瀏覽器的網頁代碼查看或者getURL返回的字符串看到。

       小木蟲網頁代碼查看

                                 

      可見小木蟲網頁編碼方式為gbk。

     1.2  XML包

       R語言XML包 具有讀取或者創建XML（HTML）文件的功能，可以本地文件也支持HTTP 或者 FTP ，也提供Xpath(XML路徑語言)解析方法。此處函數htmlparse,將文件解析為XML或者HTML樹，便於進一步數據的提取或者編輯。

        R命令：

        htmlParse(file,asText=T,encoding="UTF-8"...) #參數file 即為XML或者HTML文件名或者text，asText參數是T指定file是text,encoding指定網頁編碼方式。

 

       這里我們需要讀取網頁，並且拿到該網頁的html樹內容

        自定義函數download,輸入strURL，strURL為網址，返回html樹內容

            download <- function(strURL){
              h <- basicTextGatherer( )# 查看服務器返回的頭信息
              txt <- getURL(strURL, headerfunction = h$update,.encoding="gbk") ## 字符串形式
               htmlParse(txt,asText=T,encoding="gbk")      #選擇gbk進行網頁的解析
             }

二、獲得一個網頁所有的URL

    有時候我們需要進入每個網頁上的子鏈接取分析數據，這個時候可以用到XML包的getHTMLLinks函數。

    R命令：

        getHTMLLinks(doc,  xpQuery = "//a/@href"...) #doc為解析后的HTML樹文件，xpQuery指定想匹配的Xpath元素（下面會詳細講一點Xpath基礎)。

    此處我們需要獲得小木蟲“導師招生”頁面下的所有話題鏈接。

    2.1 首先我們要獲得導師招生的第一頁，第二頁，第三頁，甚至到最后一頁的網址。

        導師招生首頁

                       

       導師招生第二頁，第三頁。

                     

                  

        發現首頁網址是http://muchong.com/html/f430.html，余下的網址符合http://muchong.com/html/f430_  +   第幾頁   +.html 

        於是網址我們可以手動編輯。

        strURLs="http://muchong.com/html/f430.html"

        n=50

        strURLs <- c(strURLs,paste(rep("http://muchong.com/html/f430_",n),c(2:n),".html",sep=""))

        strURLs包括了所有1到50頁導師招生網頁的網址。

    2.2獲得每一頁導師招生里面多個話題的鏈接

             

        在導師招生頁面下，有許多話題，我們需要獲得各個話題的鏈接。

        用getHTMLLinks函數查看導師招生里面所有URL，再對比話題網址。

 

       

        http://muchong.com/html/201702/11075436.html

        發現話題網址是組成成分是http://muchong.com/ + html/201702/11075436.html 類似的URL

        這時我采用先從導師招生網頁提取所有URL，再匹配 html * .html格式的URL，最后再前面加上http://muchong.com/ 的策略。

        自定義greg函數用於正則匹配，並且得到匹配到的字符串。
            greg <- function(pattern,istring){
                gregout <- gregexpr(pattern,istring)   #pattern為匹配模式，istring為待匹配的字符串
                substr(istring,gregout[[1]],gregout[[1]]+attr(gregout[[1]],'match.length')-1)
             }

         自定義extradress函數，用於提取strURL網頁的中的 URL ,最后處理返回各個話題網頁的鏈接。

            extradress <- function(strURL){
                 prefix <- "http://muchong.com/"
                 pattern <- "html/[0-9/]+.html"
                 links <- getHTMLLinks(strURL)
                 needlinks <- gregexpr(pattern,links)
                 needlinkslist <- list()
                for (i in which(unlist(needlinks)>0)){
                    preadress <- substr(links[i],needlinks[[i]],needlinks[[i]]+attr(needlinks[[i]],'match.length')-1)
                    needlinkslist<- c(needlinkslist,list(preadress))
                   adresses <- lapply(needlinkslist,function(x)paste(prefix,x,sep=""))
                 }
                return (adresses)
                 }

     

三、從HTML樹中獲得我們所要的數據

    3.1 XML文檔基本知識

    下面是小木蟲的部分html:

 

   

 

   html為根元素，head和body是html的子元素，div是body的子元素，div有屬性id,style，屬性后面對應着屬性值。“小木蟲---“一行是p元素的文本內容。

    3.2 獲得某個元素的內容

       此處用到XML包中的getNodeSet函數，getNodeSet函數

        R命令：

        getNodeSet(doc, path...) #doc 就是html樹文件對象,path 就是元素路徑。可以用/從根元素一層層指定路徑，也可以用//直接定位到某一層元素。

        例如要定位到html下的body下的div，path 即為/html/body/div，也可//body/div直接從body開始定位。返回列表，如果定位到多個元素，將返回多個元素的列表。此次我們要定為到網頁的話題內容:

 

                     

     我們這里直接定位到p元素，再從列表中篩選。

     先輸入命令

      getNodeSet(doc,'//p')

 

     

 

      getNodeSet(doc,'//p')[[2]]就是我們需要的內容。

 

     

     

      但是返回的結果是個對象，要轉變為字符串要用到函數xmlValue獲得元素值。

       xmlValue(x...) # x就是getNodeSet得到的對象

       此處

  xmlValue(getNodeSet(a,'//p')[[2]]) 得到我們所要的內容


  


   此時，我們獲得了每一個話題的內容，我們就可以從內容中提取有效信息，是否招調劑，大學名，導師名字，研究方向，聯系人，郵箱，電話等。

四、從小木蟲獲取調劑信息實例

    我師妹是生物專業的需要調劑的學生，現在需要從小木蟲網站提取別人發布的信息，做成一個表格形式，便於篩選查看和發送郵件。

   以下是全部代碼內容

 

library(RCurl)
library(XML)

download <- function(strURL){
    h <- basicTextGatherer()# 查看服務器返回的頭信息
    txt <- getURL(strURL, headerfunction = h$update,.encoding="gbk") ## 字符串形式
    htmlParse(txt,asText=T,encoding="gbk")      #選擇gbk進行網頁的解析
}

extradress <- function(strURL){
  prefix <- "http://muchong.com/"
  pattern <- "html/[0-9/]+.html"
  links <- getHTMLLinks(strURL)
  needlinks <- gregexpr(pattern,links)
  needlinkslist <- list()
  for (i in which(unlist(needlinks)>0)){
    preadress <- substr(links[i],needlinks[[i]],needlinks[[i]]+attr(needlinks[[i]],'match.length')-1)
    needlinkslist<- c(needlinkslist,list(preadress))
    adresses <- lapply(needlinkslist,function(x)paste(prefix,x,sep=""))
  }
  return (adresses)
}

gettopic <- function(doc){
    xmlValue(getNodeSet(doc,'//p')[[2]])
}

greg <- function(pattern,istring){
    gregout <- gregexpr(pattern,istring)
    substr(istring,gregout[[1]],gregout[[1]]+attr(gregout[[1]],'match.length')-1)
}

getinf <- function(topic){
pattern1 <- "招[\u4E00-\u9FA5]+[0-9-]*[\u4E00-\u9FA5]*[：、；，,;]*[\u4E00-\u9FA5]*[：、；，,;]*[\u4E00-\u9FA5]*[：、；，,;]*[\u4E00-\u9FA5]*[：、；，,;]*[\u4E00-\u9FA5]*(研究生)|(調劑)"
pattern2 <- "([\u4E00-\u9FA5]*課題組|[\u4E00-\u9FA5]*團隊)"  
pattern21 <- "[\u4E00-\u9FA5]*[：、；，,;]*(教授|博士)"
pattern3 <- "[\u4E00-\u9FA5]*[：、；，,;]*[-A-Za-z0-9_.%]+@[-A-Za-z0-9_.%]+\\.[A-Za-z]+[.A-Za-z]*"
    #匹配@163.com類或者@abc.edu.cn兩類郵箱
pattern4 <- "[\u4E00-\u9FA5]+老師"  #匹配某老師
pattern5 <- "[\u4E00-\u9FA5]*[：:]*1[3,5,8]{1}[0-9]{1}[0-9]{8}|0[0-9]{2,3}-[0-9]{7,8}(-[0-9]{1,4})?" #匹配聯系人和號碼
pattern6 <- "(主|從事)*[\u4E00-\u9FA5]*(的研究|方向)為*[：、；，,;]*[\u4E00-\u9FA5]*"
pattern7 <- "[\u4E00-\u9FA5]+(大學|學院|研究院|研究所)"
pattern8 <-"[-A-Za-z0-9_.%]+@[-A-Za-z0-9_.%]+\\.[A-Za-z]+[.A-Za-z]*" #精確匹配郵箱


cate <- greg(pattern1,topic)
proj <- greg(pattern2,topic)
PI <- greg(pattern21,topic)
email <- greg(pattern3,topic)
man <- greg(pattern4,topic)
phone <- greg(pattern5,topic)
direc <- greg(pattern6,topic)
univ <- greg(pattern7,topic)
print(cate)
if (greg("(分子|生物|植物|細胞|醫學|動物|水)+",topic) !=""){
    if (man =="" && proj != ""){
        man <- unlist(strsplit(proj,"課題組")[1])
    }
 
    if (email != ""){
      email <- greg(pattern10,email)
    }
    
    data.frame("類別"=cate,"大學"=univ,"課題"=proj,"PI"=PI,"聯系人"=man,"郵箱"=email,"方向"=direc,"電話"=phone)
}
else{
  return("")
}
}

strURLs="http://muchong.com/html/f430.html"
n=50
dat <- data.frame("URL"="URL","類別"="類別","大學"="大學","課題"="課題","PI"="PI","聯系人"="聯系人","郵箱"="郵箱","方向"="方向","電話"="電話")
strURLs <- c(strURLs,paste(rep("http://muchong.com/html/f430_",n),c(2:n),".html",sep=""))
output1 <- "a2017.2.21.txt" #未處理數據，用於進一步處理
output2 <- "b2017.2.21.txt" #進一步篩選的數據，用於查看

for ( strURL in strURLs){
    adresses <- extradress(strURL)
    for (adress in adresses){
      message(adress)
      doc <- download(adress)
      topic <- gettopic(doc)
      inf <- getinf(topic)
      if (inf != ""){
        URL <- data.frame("URL"=adress)
        inf <- cbind(URL,inf)
        dat<- rbind(dat,inf)
      }
    }
}

write.table(dat, file = output1, row.names = F, col.names=F,quote = F, sep="\t")  # tab 分隔的文件
message("完成！")

dat <- read.table(output1,sep="\t",header=T)
dat <- dat[dat$郵箱, ] #去除沒有郵箱數據
dat <- dat[!duplicated(dat$郵箱), ]  #去除重復郵箱數據
dat$index <- as.numeric(rownames(dat))
dat <- dat[order(dat$index,decreasing=F),] #將亂序后的數據重新按照index排序
dat$index <- NULL
write.table(dat, file = output2, row.names = F, col.names=F,quote = F, sep="\t")  # tab 分隔的文件
message("完成！")

 

 

最后祝所有考研人都能成功被心儀的學校錄取！

 

 

參考資料：

Rcurl包 ：https://cran.r-project.org/web/packages/RCurl/RCurl.pdf

XML包：https://cran.r-project.org/web/packages/XML/XML.pdf

XML基本知識：http://www.cnblogs.com/thinkers-dym/p/4090840.html