我们做临床研究常见的烦恼为没有好的数据,目前气象网站上有很多关于气象因素和空气质量数据,但是没有系统的整理和格式等问题,我们使用起来非常不方便,而且很费时间,我们可以使用R语言爬虫工具对网站上的数据进行抓取,然后对数据进行整合,最后进行分析,达到事半功倍的效果,先申明一下,爬取工具不是病毒,原理我就不废话这么多了,主要是对实际操作进行讲解。
今天我们要爬取的网站是PM2.5网,为什么选这个网站,因为它上面没有反爬虫的措施,比较好抓取数据,我试了一下几乎大部分类似的R包都可以抓取数据,非常适合新手练手。
网址为:/
它上面有个历史天气,可以查询既往的天气情况,我们点开它
在这个界面可以查询每个城市的既往天气情况,假设我们想获得3月-10月北京,气温和风力等数据的情况。为什么我不查一整年的,因为其他月份缺失数据较多,但是一样可以做的,有兴趣的可以自己试一下。我们先导入相关的R包
library(rvest)library(xml2)library(dplyr)
我们来看一下3月的数据,有气温风力和风向等数据,它的网址是:/beijing3yuetianqi/
网页上把天气分成了上、中、下旬天气
我们先标记它的网址
url<-/beijing3yuetianqi/
提取数据
table<-read_html(url,encoding="utf-8")%>%html_table(.,header=T,trim=TRUE)data<-table[[1]]
这样网页数据就被我们提取出来了,非常简单,我们来看一下
虽然数据提取上来了,但是有2个问题,一是数据中含有很多汉字和乱码,二是这只是其中的3月数据,我们想要的是3-10月的数据整合在一起,二是要消除汉字和乱码,只要纯数据。我们观察了一下,3-10月的数据中网址的变化,主要是中间的数字不同,
如4月:/beijing4yuetianqi/
5月:/beijing5yuetianqi/
由此我们可以推导出3-10月的网址,这个方法不适用与所有网站
allurl<-paste0("/beijing",3:10,"yuetianqi")allurl
我们把网址推导出来后,我们把它写入循环
先建一个空值
bc<-NULL
循环,第二行代码主要是先读取网页,在从网页读取表格
for (i in 1:8) {table<-read_html(allurl[i],encoding="utf-8")%>%html_table(.,header=TRUE,trim=TRUE)bc[[i]]<-table[[1]]}
这里要注意一下,因为它是三个表而且每个表头的变量名不一样,我们要建立一个列表把数据装起来,而不能使用类似mytable<-rbind(mytable,fun(i))的代码,这样会出错,要先要列表储存起来再改成数据框合并。
我们看到在bc里面已经包含8个列表,就是我们需要的全部数据了,每一个都是其中一个月份的数据,我们先打开看看
gg<-bc[[1]]###读取列表1的数据
我们可以看到(上图)数据里有汉字有代码,我们要对它进行清洗一下,我们先对它的类型做转变,把它变成矩阵
gg<-matrix(unlist(bc[[1]]), ncol=7)####只能设置列数,不要设置行数
我们可以看到(上图)和原来差不多有点小变化,我们要注意一下,bc的列表数据不是每一个行数都一样,有些是36行,有些是37行,所以我们矩阵的时候只能设置列数,不要设置行数,不然会对齐不了,所以我们设置ncol=7,这一步是比较关键的
进一步把数据转成数据框格式,其实就是在外面包一个data.frame(),我们可以看到数据没有什么变化,但是类型改变了
gg<-data.frame(matrix(unlist(bc[[1]]), ncol=7))
接下来我们就是要删掉带有日期的行,带有北京的行,字母bdadvbox的行
df1<-df[-grep("bdadvbox", df$X1),]###删掉字母bdadvbox的行df1<-df1[-grep("北京", df1$X1),]###删掉带有北京的行df1<-df1[-grep("日期", df1$X1),]####删掉带有日期的行
打开df1看看
可以看到数据已经整理好了,我们其他月份只要重复这个步骤就可以得出数据了,OK,我们写个循环把它弄出来,其实就是重复上面的步骤
建3个空值
mytable<-NULLdf<-NULLdf1<-NULL
循环
for (i in 1:8) {fun<-function(m){df<-data.frame(matrix(unlist(bc[[i]]), ncol=7))df1<-df[-grep("bdadvbox", df$X1),]df1<-df1[-grep("北京", df1$X1),]df1<-df1[-grep("日期", df1$X1),]}mytable<-rbind(mytable,fun(i))}
最后得出mytable就是我们需要的数据了
简单整理一下
library(openair)library(stringr)data1<-mytablecolnames(data1)<-c("time","htp","ltp","dw","nw","fx","fl")data1$time1<-paste0("",data1$time)data1$time1<-as.Date(data1$time1,"%Y年%m月%d日")data1$date<-data1$time1data1$date<-paste0(data1$date," ","12:00:00")data1$htp<-str_extract(data1$htp, "\\d+")#把数字提取出来
整理好后的数据(上图)就可以用于分析了,我们用来绘制一个热力日历图(就是最高温度的日历图),因为不是本章重点,我简单一点直接代码了
dat171 <- filter(data1,Year==)[,c(2,9)]dat171$month <- as.integer(strftime(dat171$date, '%m')) #生成月dat171$monthf<-factor(dat171$month,levels=as.character(3:10),labels=c("Mar","Apr","May","Jun","Jul","Aug","Sep","Oct"),ordered=TRUE)#生成月因子变量dat171$weekday<-as.integer(strftime(dat171$date, '%u'))#生成周dat171$weekdayf<-factor(dat171$weekday,levels=(1:7),labels=(c("Mon","Tue","Wed","Thu","Fri","Sat","Sun")),ordered=TRUE)#生成周因子变量dat171$yearmonth<- strftime(dat171$date, '%m%Y') #生成月数dat171$yearmonthf<-factor(dat171$yearmonth)dat171$week<- as.integer(strftime(dat171$date, '%W'))#生成周数dat171<-dat171 %>% group_by(monthf)%>%mutate(monthweek=1+week-min(week))dat171$day<-strftime(dat171$date, "%d")ggplot(dat171, aes(weekdayf, monthweek, fill=htp)) + geom_tile(colour = "white") + scale_fill_gradientn(colours=rev(brewer.pal(11,'Spectral')))+geom_text(aes(label=day),size=3)+facet_wrap(~monthf ,nrow=3) +scale_y_reverse()+xlab("Day") + ylab("Week of the month") +theme(strip.text = element_text(size=11,face="plain",color="black"))
生成了北京3月—10月的热力日历图,由上图可知北京的最高温度变化情况,越红温度就越高。
你以为本章到此结束了,不不不,还有赠送关于R爬虫的电子书活动,公众号回复:书籍1,可以获得书籍:《基于R语言的自动数据收集–网络抓取和文本挖掘实用指南》,就是下图这本
讲了很多关于R语言数据抓取、HTTP、正则化、SQL等内容,对于我们进行网页数据抓取非常有帮助。