我们做临床研究常见的烦恼为没有好的数据，目前气象网站上有很多关于气象因素和空气质量数据，但是没有系统的整理和格式等问题，我们使用起来非常不方便，而且很费时间，我们可以使用R语言爬虫工具对网站上的数据进行抓取，然后对数据进行整合，最后进行分析，达到事半功倍的效果，先申明一下，爬取工具不是病毒，原理我就不废话这么多了，主要是对实际操作进行讲解。
今天我们要爬取的网站是PM2.5网，为什么选这个网站，因为它上面没有反爬虫的措施，比较好抓取数据，我试了一下几乎大部分类似的R包都可以抓取数据，非常适合新手练手。
网址为：http://www.pm25s.com/
它上面有个历史天气，可以查询既往的天气情况，我们点开它
在这个界面可以查询每个城市的既往天气情况，假设我们想获得2020年3月-10月北京，气温和风力等数据的情况。为什么我不查一整年的，因为其他月份缺失数据较多，但是一样可以做的，有兴趣的可以自己试一下。我们先导入相关的R包
library(rvest)
library(xml2)
library(dplyr)
我们来看一下3月的数据，有气温风力和风向等数据，它的网址是：http://www.pm25s.com/beijing3yuetianqi/
网页上把天气分成了上、中、下旬天气
我们先标记它的网址
url<-http://www.pm25s.com/2020beijing3yuetianqi/
提取数据
table<-read_html(url,encoding="utf-8")%>%html_table(.,header=T,trim=TRUE)
data<-table[[1]]
这样网页数据就被我们提取出来了，非常简单，我们来看一下
虽然数据提取上来了，但是有2个问题，一是数据中含有很多汉字和乱码，二是这只是其中的3月数据，我们想要的是3-10月的数据整合在一起，二是要消除汉字和乱码，只要纯数据。我们观察了一下，3-10月的数据中网址的变化，主要是中间的数字不同，
如4月：http://www.pm25s.com/beijing4yuetianqi/
5月：http://www.pm25s.com/beijing5yuetianqi/
由此我们可以推导出3-10月的网址，这个方法不适用与所有网站
allurl<-paste0("http://www.pm25s.com/2020beijing",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))
接下来我们就是要删掉带有日期的行，带有2020年北京的行，字母bdadvbox的行
df1<-df[-grep("bdadvbox", df$X1),]###删掉字母bdadvbox的行
df1<-df1[-grep("2020年北京", df1$X1),]###删掉带有2020年北京的行
df1<-df1[-grep("日期", df1$X1),]####删掉带有日期的行
打开df1看看
可以看到数据已经整理好了，我们其他月份只要重复这个步骤就可以得出数据了，OK，我们写个循环把它弄出来，其实就是重复上面的步骤
建3个空值
mytable<-NULL
df<-NULL
df1<-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("2020年北京", df1$X1),]
df1<-df1[-grep("日期", df1$X1),]
}
mytable<-rbind(mytable,fun(i))
}
最后得出mytable就是我们需要的数据了
简单整理一下
library(openair)
library(stringr)
data1<-mytable
colnames(data1)<-c("time","htp","ltp","dw","nw","fx","fl")
data1$time1<-paste0("2020年",data1$time)
data1$time1<-as.Date(data1$time1,"%Y年%m月%d日")
data1$date<-data1$time1
data1$date<-paste0(data1$date," ","12:00:00")
data1$htp<-str_extract(data1$htp, "\\d+")#把数字提取出来
整理好后的数据（上图）就可以用于分析了，我们用来绘制一个热力日历图（就是最高温度的日历图），因为不是本章重点，我简单一点直接代码了
dat171 <- filter(data1,Year==2020)[,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"))
生成了2020年北京3月—10月的热力日历图，由上图可知2020年北京的最高温度变化情况，越红温度就越高。
你以为本章到此结束了，不不不，还有赠送关于R爬虫的电子书活动，公众号回复：书籍1，可以获得书籍：《基于R语言的自动数据收集–网络抓取和文本挖掘实用指南》，就是下图这本
讲了很多关于R语言数据抓取、HTTP、正则化、SQL等内容，对于我们进行网页数据抓取非常有帮助。
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
