IT知识库 购物 网址 游戏 小说 歌词 快照 开发 股票 美女 新闻 笑话 | 汉字 软件 日历 阅读 下载 图书馆 编程 China
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
图片批量下载器
↓批量下载图片,美女图库↓
图片自动播放器
↓图片自动播放器↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
vbs/VBScript DOS/BAT hta htc python perl 游戏相关 VBA 远程脚本 ColdFusion ruby专题 autoit seraphzone PowerShell linux shell Lua Golang Erlang 其它教程 CSS/HTML/Xhtml html5 CSS XML/XSLT Dreamweaver教程 经验交流 开发者乐园 Android开发资料
站长资讯 .NET新手 ASP.NET C# WinForm Silverlight WCF CLR WPF XNA VisualStudio ASP.NET-MVC .NET控件开发 EntityFramework WinRT-Metro Java C++ PHP Delphi Python Ruby C语言 Erlang Go Swift Scala R语言 Verilog 其它语言 架构设计 面向对象 设计模式 领域驱动 Html-Css JavaScript jQuery HTML5 SharePoint GIS技术 SAP OracleERP DynamicsCRM K2 BPM 信息安全 企业信息 Android开发 iOS开发 WindowsPhone WindowsMobile 其他手机 敏捷开发 项目管理 软件工程 SQLServer Oracle MySQL NoSQL 其它数据库 Windows7 WindowsServer Linux
  IT知识库 -> R语言 -> R语言从小木虫网页批量提取考研调剂信息 -> 正文阅读

[R语言]R语言从小木虫网页批量提取考研调剂信息

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
上一篇文章      下一篇文章      查看所有文章
加:2017-02-23 02:11:39  更:2017-05-16 01:48:11 
 
  R语言 最新文章
R的方差检验
Solving.Differential.Equations.in.R笔记1
云铝项目市场调查分析
东深新能源科技有限公司
ggplot2图形解析
R语言学习
R包
学习笔记TF037:实现强化学习策略网络
dplyr包
R语言数据可视化0—ggplot2介绍
技术频道: 站长资讯 .NET新手区 ASP.NET C# WinForm Silverlight WCF CLR WPF XNA Visual Studio ASP.NET MVC .NET控件开发 Entity Framework WinRT/Metro Java C++ PHP Delphi Python Ruby C语言 Erlang Go Swift Scala R语言 Verilog 其它语言 架构设计 面向对象 设计模式 领域驱动设计 Html/Css JavaScript jQuery HTML5 SharePoint GIS技术 SAP Oracle ERP Dynamics CRM K2 BPM 信息安全 企业信息化其他 Android开发 iOS开发 Windows Phone Windows Mobile 其他手机开发 敏捷开发 项目与团队管理 软件工程其他 SQL Server Oracle MySQL NoSQL 其它数据库 Windows 7 Windows Server Linux
脚本语言: vbs/VBScript DOS/BAT hta htc python perl 游戏相关 VBA 远程脚本 ColdFusion ruby专题 autoit seraphzone PowerShell linux shell Lua Golang Erlang 其它教程
网站开发: CSS/HTML/Xhtml html5 CSS XML/XSLT Dreamweaver教程 经验交流 开发者乐园 Android开发资料
360图书馆 软件开发资料 文字转语音 购物精选 软件下载 美食菜谱 新闻资讯 电影视频 小游戏 Chinese Culture 股票 三丰软件 开发 中国文化 网文精选 阅读网 看图 日历 万年历 2018年8日历
2018-8-15 3:16:07
多播视频美女直播
↓电视,电影,美女直播,迅雷资源↓
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
图片批量下载器
↓批量下载图片,美女图库↓
  网站联系: qq:121756557 email:121756557@qq.com  IT知识库