28-rvest包爬取科学辟谣网
2020-01-28 本文已影响0人
wonphen
1、加载R包
> library(pacman)
> p_load(rvest,httr,stringr,tidyverse,textclean)
2、伪造访问终端
> #伪装访问终端
> UserAgent = c(
+ "Mozilla/5.0 (Windows NT 6.1; rv:2.0.1) Gecko/20100101 Firefox/4.0.1",
+ "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.16 Safari/537.36",
+ "Mozilla/5.0 (Windows NT 6.1; Intel Mac OS X 10.6; rv:7.0.1) Gecko/20100101 Firefox/7.0.1",
+ "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.63 Safari/537.36 OPR/18.0.1284.68",
+ "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0)",
+ "Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0)",
+ "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.2; Trident/6.0)",
+ "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_9_1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.63 Safari/537.36",
+ "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1",
+ "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:7.0.1) Gecko/20100101 Firefox/7.0.1",
+ "Opera/9.80 (Macintosh; Intel Mac OS X 10.9.1) Presto/2.12.388 Version/12.16",
+ "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_9_1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.63 Safari/537.36 OPR/18.0.1284.68",
+ "Mozilla/5.0 (iPad; CPU OS 7_0 like Mac OS X) AppleWebKit/537.51.1 (KHTML, like Gecko) CriOS/30.0.1599.12 Mobile/11A465 Safari/8536.25",
+ "Mozilla/5.0 (iPad; CPU OS 8_0 like Mac OS X) AppleWebKit/600.1.3 (KHTML, like Gecko) Version/8.0 Mobile/12A4345d Safari/600.1.4",
+ "Mozilla/5.0 (iPad; CPU OS 7_0_2 like Mac OS X) AppleWebKit/537.51.1 (KHTML, like Gecko) Version/7.0 Mobile/11A501 Safari/9537.53",
+ "Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_6_8; en-us) AppleWebKit/534.50 (KHTML, like Gecko) Version/5.1 Safari/534.50",
+ "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-us) AppleWebKit/534.50 (KHTML, like Gecko) Version/5.1 Safari/534.50",
+ "Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0",
+ "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/69.0.3497.100 Safari/537.36"
+ )
3、爬取分类列表及其链接
> url <- "https://piyao.kepuchina.cn/rumor/rumorlist?type=0&title=&keyword=0&page="
>
> # 随机选择访问终端
> header <- paste0("`User-Agent`=",UserAgent[sample(length(UserAgent)-1,1)])
> webpage <- url %>% html_session(add_headers(.,headers=header))
>
> # 获取分类名称
> cmt <- html_node(webpage,"div.rumor-type-list.slidedown")
> cabs <- html_nodes(cmt,"a.type-btn") %>% html_text() %>% gsub(" |\n|HOT","",.) %>% str_trim(.,side = "both") ;cabs
Result: [1] "全部" "食品安全" "营养健康" "疾病防治"
Result: [5] "美容健身" "生活解惑" "天文地理" "生物"
Result: [9] "数理化" "交通运输" "航空航天" "前沿科技"
Result: [13] "能源环境" "农业技术" "建筑水利"
> # 获取每个类别的短链接
> link <- html_nodes(cmt,"a.type-btn") %>% html_attr("href")
> # 将短链接拼接为长链接
> links <- paste0("https://piyao.kepuchina.cn",link,"&page=")
>
> # 获取每个分类的编号
> id <- link %>% gsub("[/rumor//rumorlist?type=]","",.) %>% gsub("kwd0|&","",.) %>% as.numeric(.);id
Result: [1] 0 2 15 1 16 6 9 7 8 11 3 4 5 10 12
> # 合并为数据框
> df.link <- data.frame(cabs=cabs,link=links,id=id,num=0)
4、构造爬取每一篇文章的函数
> get_content <- function(url) {
+ # 是否验证https服务器对等证书（peer's certificate），值为1则验证，为0则不验证
+ set_config(config(ssl_verifypeer=0L))
+ # 随机选择访问终端
+ header <- paste0("`User-Agent`=",UserAgent[sample(length(UserAgent)-1,1)])
+ html <- url %>% html_session(add_headers(.,headers=header))
+
+ # 标题
+ biaoti <- html %>% html_nodes("div.content > h2") %>% html_text() %>% gsub("谣言:","",.);biaoti
+
+ # 谣言
+ yy <- html %>% html_nodes("div.content > div.con-text > p") %>%
+ replace_html(.) %>% str_trim(side = "both") %>% paste(.,collapse = "\n") %>%
+ str_trim(side = "both")
+
+ # 检测文章中有没有清晰的标出“谣言”和“辟谣”
+ if(str_detect(yy,"谣言：")) {
+ yaoyan <- yy %>% str_split_fixed(.,"辟谣：",2) %>% unlist(.)
+ yaoyan <- yaoyan[1,1] %>% gsub("谣言：|\n","",.);yaoyan
+ piyao <- yy %>% str_split_fixed(.,"辟谣：",2) %>% unlist(.)
+ piyao <- piyao[1,2] %>% gsub("辟谣：|\n","",.);piyao
+ } else {
+ yaoyan = biaoti
+ piyao = yy
+ }
+
+ # 检测文章中有没有“辟谣专家”，没有则从表头去取
+ if(str_detect(yy,"辟谣专家：")) {
+ pyzj <- yy %>% str_split_fixed(.,"辟谣专家：",2) %>% unlist(.)
+ pyzj <- pyzj[1,2] %>% str_split_fixed(.,"\n",2)
+ pyzj <- pyzj[1,1];pyzj
+ } else {
+ pyzj <- html %>% html_nodes("div.content > p.from-msg") %>% html_text() %>%
+ str_split_fixed(.,"辟谣专家：",2) %>% gsub(" |\n","",.) %>% unlist(.)
+ pyzj <- pyzj[1,2];pyzj
+ ifelse(pyzj=="",NA,pyzj)
+ }
+
+ # 复核专家
+ if(str_detect(yy,"复核专家：")) {
+ fhzj <- yy %>% str_split_fixed(.,"复核专家：",2) %>% gsub("\n","",.) %>% unlist(.)
+ fhzj <- fhzj[1,2];fhzj
+ } else {
+ fhzj = NA;fhzj
+ }
+
+ # 合并数据
+ df.cnt <- data.frame(title=biaoti,rumor=yaoyan,correction=piyao,expert1=pyzj,expert2=fhzj)
+
+ # 返回数据
+ return(df.cnt)
+ }
5、爬取各类别文章数量
> url.cab <- paste0("https://piyao.kepuchina.cn/rumor/rumorlist?type=",df.link$id,"&title=&keyword=0&page=1")
>
> # 构造存储文章数量的向量
> count <- rep(0,length(df.link$cabs))
>
> # 迭代所有的分类，从2开始表示不爬取“全部”分类
> for (i in 2:length(url.cab)) {
+ # 随机选择访问终端
+ header <- paste0("`User-Agent`=",UserAgent[sample(length(UserAgent)-1,1)])
+ html <- url.cab[i] %>% html_session(add_headers(.,headers=header))
+
+ # 初始化数量
+ count[i] <- 0
+
+ # 是否存在下一页
+ next.page <- html_nodes(html,"div.page > a") %>% html_text(.) %>% paste(.,collapse = "") %>%
+ str_detect(.,"下一页");next.page
+
+ # 当存在“下一页”时
+ while (next.page) {
+ # 计数
+ count[i] <- count[i] + 12
+
+ # 找到含有"下一页"的链接跳转
+ html <- html %>% follow_link("下一页")
+ # 是否存在下一页
+ next.page <- html_nodes(html,"div.page > a") %>% html_text(.) %>% paste(.,collapse = "") %>%
+ str_detect(.,"下一页");next.page
+ }
+
+ # 当前页面文章数量
+ num.arch <- html_nodes(html,"div.rumor-data-list > ul > li") %>% length(.);num.arch
+ # 计数
+ count[i] <- count[i] + num.arch
+
+ # 将计数值加入到向量对应的位置
+ df.link$num[i] <- count[i]
+ }
> print(df.link)
Result: cabs
Result: 1 全部
Result: 2 食品安全
Result: 3 营养健康
Result: 4 疾病防治
Result: 5 美容健身
Result: 6 生活解惑
Result: 7 天文地理
Result: 8 生物
Result: 9 数理化
Result: 10 交通运输
Result: 11 航空航天
Result: 12 前沿科技
Result: 13 能源环境
Result: 14 农业技术
Result: 15 建筑水利
Result: link
Result: 1 https://piyao.kepuchina.cn/rumor/rumorlist?type=0&keyword=0&title=&page=
Result: 2 https://piyao.kepuchina.cn/rumor/rumorlist?type=2&keyword=0&title=&page=
Result: 3 https://piyao.kepuchina.cn/rumor/rumorlist?type=15&keyword=0&title=&page=
Result: 4 https://piyao.kepuchina.cn/rumor/rumorlist?type=1&keyword=0&title=&page=
Result: 5 https://piyao.kepuchina.cn/rumor/rumorlist?type=16&keyword=0&title=&page=
Result: 6 https://piyao.kepuchina.cn/rumor/rumorlist?type=6&keyword=0&title=&page=
Result: 7 https://piyao.kepuchina.cn/rumor/rumorlist?type=9&keyword=0&title=&page=
Result: 8 https://piyao.kepuchina.cn/rumor/rumorlist?type=7&keyword=0&title=&page=
Result: 9 https://piyao.kepuchina.cn/rumor/rumorlist?type=8&keyword=0&title=&page=
Result: 10 https://piyao.kepuchina.cn/rumor/rumorlist?type=11&keyword=0&title=&page=
Result: 11 https://piyao.kepuchina.cn/rumor/rumorlist?type=3&keyword=0&title=&page=
Result: 12 https://piyao.kepuchina.cn/rumor/rumorlist?type=4&keyword=0&title=&page=
Result: 13 https://piyao.kepuchina.cn/rumor/rumorlist?type=5&keyword=0&title=&page=
Result: 14 https://piyao.kepuchina.cn/rumor/rumorlist?type=10&keyword=0&title=&page=
Result: 15 https://piyao.kepuchina.cn/rumor/rumorlist?type=12&keyword=0&title=&page=
Result: id num
Result: 1 0 0
Result: 2 2 206
Result: 3 15 528
Result: 4 1 516
Result: 5 16 76
Result: 6 6 294
Result: 7 9 24
Result: 8 7 41
Result: 9 8 44
Result: 10 11 5
Result: 11 3 4
Result: 12 4 21
Result: 13 5 19
Result: 14 10 7
Result: 15 12 21
6、根据各类别谣言数量画图
> ggplot(df.link[-1,],aes(x=reorder(cabs,num),y=num)) +
+ geom_bar(stat = "identity",fill = "violetred") +
+ coord_flip() +
+ labs(x="",y="",title = "各类型谣言数量") +
+ geom_text(aes(label = num)) +
+ theme(plot.title = element_text(hjust = 0.5),
+ axis.text.x = element_blank(),
+ axis.ticks.x = element_blank())
各类别谣言数量
7、爬取文章内容
> # "全部"分类下的第一页
> url.all <- paste0("https://piyao.kepuchina.cn/rumor/rumorlist?type=",df.link$id[1],"&title=&keyword=0&page=1");url.all
Result: [1] "https://piyao.kepuchina.cn/rumor/rumorlist?type=0&title=&keyword=0&page=1"
> # 创建存储所有内容的数据框
> df.content <- data.frame()
>
> # 随机选择访问终端
> header <- paste0("`User-Agent`=",UserAgent[sample(length(UserAgent)-1,1)])
>
> html <- url.all %>% html_session(add_headers(.,headers=header))
>
> # 是否存在下一页
> next.page <- html_nodes(html,"div.page > a") %>% html_text(.) %>% paste(.,collapse = "") %>%
+ str_detect(.,"下一页")
>
> # 当存在“下一页”时
> while (next.page) {
+ # 获取链接
+ links <- html %>% html_nodes("div.rumor-data-list > ul > li > a") %>% html_attrs(.) %>%
+ unlist(.) %>% as.vector(.)
+
+ # 获取网页内容
+ for (lk in links) {
+ # 调用函数获取数据
+ df.cnt <- get_content(lk)
+ # 合并数据
+ df.content <- rbind(df.cnt,df.content)
+ }
+ # 找到含有"下一页"的链接跳转
+ html <- html %>% follow_link("下一页")
+ # 是否存在下一页
+ next.page <- html_nodes(html,"div.page > a") %>% html_text(.) %>% paste(.,collapse = "") %>%
+ str_detect(.,"下一页")
+ }
>
> # 获取链接
> links <- html %>% html_nodes("div.rumor-data-list > ul > li > a") %>% html_attrs(.) %>%
+ unlist(.) %>% as.vector(.)
>
> for (lk in links) {
+ # 调用函数获取信息
+ df.cnt <- get_content(lk)
+ # 合并数据
+ df.content <- rbind(df.cnt,df.content)
+ }
>
> # 写入文件
> # write.csv(df.content,"rumors_base.csv")
8、文本整理
> # dt <- read.csv("rumors_base.csv",header = T,stringsAsFactors = F)
>
> # 去除rumor中的HTML标记、网址、反斜杠、空格等
> df.content$rumor <- df.content$rumor %>% replace_html(.) %>% replace_url(.) %>%
+ gsub("alt=[\"0-9_a-zA-Z> ]*.[jpg|JPG]\">","",.) %>% gsub(" ","",.)
>
> # 随机输出一条记录
> print(df.content[sample(1:length(df.content),1),])
Result: title
Result: 2 美国加拿大叫停仰卧起坐
Result: rumor
Result: 2 美国加拿大叫停仰卧起坐很多朋友锻炼身体时，会通过做仰卧起坐来增强腹部力量。但是很多人都
不知道做仰卧起坐的危害，加拿大滑铁卢大学脊柱生物力学教授StuartMcGill表示：仰卧起坐能够给脊椎造成
上百磅（几十公斤）的压力，最终带来椎间盘突出症。同时，刚练腹肌的朋友，腹肌力量很弱，身体会很自
然的借用胯部和腰部的力量，腹肌训练基本没什么效果。国内很多中小学还坚持要学生达标完成，我国的港
澳台地区已经在各类学校改变了仰卧起坐的传统姿式，明白“双手抱头”不科学的道理。而我国内地的大、中、
小学目前仍没有做出调整。对此，教育主管部门亟待出台关于仰卧起坐的标准，保护孩子们的健康。
Result: correction
Result: 2 伤害脊椎的不是仰卧起坐，而是双手抱头仰卧起坐是锻炼腹肌常用的方法之一，也是我国《国家学
生体质健康标准》中对腰腹力量测试的指标。强健的腹肌不仅是对我们腹部肌肉力量的展示，同时还有利于
腰围的控制、预防骨盆前倾、维持脊柱生理平衡等作用。经常进行仰卧起坐锻炼，能增强核心肌力，还对提
高青少年灵敏、协调、反应、平衡等身体素质、掌握更多的运动技能和运动项目，也是大有帮助的。但最近
网上流传着这么一个说法：进行仰卧起坐练习会增加脊椎损伤风险，美国加拿大叫停仰卧起坐。实际上仰卧
起坐不但没有被叫停，反而在世界范围内被我国、美国、加拿大、新加坡、中国香港等多个国家和地区采纳
为健康体质测评标准测评指标之一，但各国测试标准动作形式要求上最大的不同之处在于上肢摆放位置。我
国《国家学生体质健康标准》所规定的“双手交叉贴于脑后”的标准姿势与欧洲青少年体能测试、加拿大健康、
体育教育和休闲协会体适能测试方法一致；新加坡则使用双手罩耳形式，香港学校体适能奖励计划和美国运
动医学会健康体适能检测则使用双臂胸前交叉形式。那么仰卧起坐损伤脊椎的说法是从哪里来的呢？其实这
一说法的始作俑者事件是中国台湾TVBS新闻台2014年8月22日的一则报道。报道说，一名25岁的台湾男子在
做了几个仰卧起坐后，觉得颈部以下全身无力，当地医生检查后解释称，男子以手抱头的方式仰卧起坐，导
致颈椎内血管受不了连续施力而爆裂，血块压迫神经，进而导致颈部以下全身瘫痪。“仰卧起坐致瘫”的消息，
虽是个案，但的确发生在我们身边。那么仰卧起坐“致瘫”是什么原因呢？其实抱头仰卧起坐才是“致瘫”的罪魁
祸首。2014及2018版《国家学生体质健康标准》中对仰卧起坐动作的要求均是“受试者仰卧于软垫上，两腿稍
分开，屈膝呈90度，两手手指交叉贴于脑后。同伴按压其踝关节，以固定下肢”。这里需要划一下重点了：“两
手手指交叉贴于脑后”。在我们实际锻炼过程中“两手手指交叉贴于脑后”被理解为“双手抱头”是错误的。正确动
作中，双手仅仅是起到托住颈椎，防止颈部后伸(仰头)，造成背部肌肉紧张影响动作质量的作用。而在实际锻
炼甚至是部分测试过程中，你会看到很多人会靠双手抱头来发力，将头猛地向体前一拉，殊不知，双手强力
向前拉动头部的动作会对颈椎造成巨大压力，加上头颈部关节、肌肉力量相对较弱，这一拉可能引发运动损
伤甚至会导致颈椎脱位、危及生命。由此可见，仰卧起坐动作是否正确的一个关键要领是看双手是否“抱头”。
对于家长担心的仰卧起坐存在损伤脊椎风险却仍作为我国的大、中、小学《国家学生体质健康标准》表示担
忧的问题。这里首先对家长的担忧表示理解，但是目前没有实验数据直接证明仰卧起坐与脊柱损伤之间存在
直接关系。所以，大家可以放心的进行仰卧起坐，但进行仰卧起坐练习时要掌握好动作要领和锻炼的度，记
住不要在身体疲劳的情况下做仰卧起坐，不要借助扭动身体来使身体抬起、更不要采用双手抱头的方式做仰
卧起坐。其次，青少年为了加强腹肌力量，做仰卧起坐也可避免手抱头动作，如：双手交叉抱胸前，或者双
手放身体两侧、前侧，做的过程也不要“猛振”，慢起慢落即可；此外锻炼也可根据需求，动作不一定起落完
整，上体抬起做一半（“虾卷”），也可以达到锻炼腹肌的效果了。辟谣专家：武东明 国家体育总局体育科学
研究所国民体质研究中心<U+00A0> 副研究员复核专家：孙飙 南京体育学院 教授出品人：科普中国-科学辟
谣
Result: expert1
Result: 2 武东明 国家体育总局体育科学研究所国民体质研究中心<U+00A0> 副研究员
Result: expert2
Result: 2 孙飙 南京体育学院 教授出品人：科普中国-科学辟谣
> #写入文件
> write.csv(df.content[,c("title","rumor","correction","expert1","expert2")],"rumors.csv")
最终效果
