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

原创 2017-02-28 ywliao 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 = output, 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

微信回复关键字即可学习

回复 R              R语言快速入门免费视频
回复统计          统计方法及其在R中的实现
回复用户画像   民生银行客户画像搭建与应用
回复大数据      大数据系列免费视频教程
回复可视化   利用R语言做数据可视化
回复数据挖掘数据挖掘算法原理解释与应用
回复机器学习   R&Python机器学习入门

”FAN某”的离婚财产分割判决书（全文）

”FAN某”的离婚财产分割判决书（全文）

哈里斯女粉搞4B运动、毒杀丈夫，回旋镖能否让美国“血流成河”

许纪霖：珠海驾车撞人事件的背后，弦绷得太紧了，要给人们以松弛感 | 二湘空间

刑讯逼供、管辖异议，唐山杨立国涉黑案争议