当古代文人参加“中国好诗人”节目 | R爬虫&可视化第2季
作者:徐麟,数据分析师,就职于上海唯品会。热爱数据挖掘和分析,喜欢用R、Python玩点不一样的数据。个人公众号:数据森麟(微信ID:shujusenlin)
往期推荐:
前言
第一期的R爬虫&可视化专题中,与大家分享了关于电视台收视率爬取和可视化的一些内容,得到了许多朋友的关注,在这里向大家表示由衷的感谢。
第二期的专题中,会与大家聊聊在中国历史中留下浓墨重彩的古代文人们,究竟谁的作品最受欢迎,谁的人气最高,谁又最高产。本文将用现在流行的选秀节目形式在轻松的氛围中回答这些问题,并与大家分享一些爬虫和统计的知识。
相关Package
## 爬虫相关包
library(RCurl)
library(XML)
library(RSelenium)
## 处理字符串、汇总数据
library(plyr)
library(stringr)
海选
在任何一档选秀节目中,想要通过海选都需要有让人值得称赞的作品,关于诗人作品的评价,我们爬取了古诗文网(http://www.gushiwen.org/)中5000首诗,5000首词,1000首曲,500篇文言文的点赞数。将作者的点赞数进行累加,选取排名前100位的诗人,网站页面如下:
初赛阶段爬取代码如下(以唐诗数据为例):
while(i <= 500){
url <- paste('http://so.gushiwen.org/type.aspx?p=',i,
'&x=%E8%AF%97',sep='')
trynext=try(temp <- getURL(url,.encoding='utf-8'),silent=TRUE)
if ('try-error' %in% class(trynext)) next
doc <-htmlParse(temp)
title <- getNodeSet(doc,'//a[@style="font-size:18px; line-height:22px; height:22px;"]')
title <- sapply(title,xmlValue)
intro <- getNodeSet(doc,'//p[@class="source"]')
intro <- sapply(intro,xmlValue)
intro <- unlist(strsplit(intro,split=":"))
good <- getNodeSet(doc,'//div[@class="good"]')
good <- sapply(good,xmlValue)
good <- as.numeric(substr(good,2,100))
this_tangshi <- as.data.frame(matrix(intro,ncol=2,byrow=TRUE))
names(this_tangshi) <- c('dynasty','name')
this_tangshi$title <- title
this_tangshi$good <- good
tangshi <- rbind(tangshi,this_tangshi)
print(i)
i = i+1
}
需要特别指出的是,由于爬取的网站有时会出现爬取过程超时导致报错,我们因此采用了try/next 的函数组合,在爬取失败时,自动重新爬取该网页,避免了因此造成的循环提前结束。
初赛成绩计算
(我们自动筛除了全部点赞均来自于文言文的作者,以符合“中国好诗人”的主题,并且排除掉全部点赞数均来自于一部作品的作者)
total <- rbind(tangshi, songci, yuanqu, wenyan)
writer <- ddply(total,.(dynasty,name),summarise,
total_content=length(name),
total_good=sum(good),
shiwen_good=sum(good*(beizhu!='文言文')),
tangshi=sum(good*(beizhu=='唐诗')),
songci=sum(good*(beizhu=='宋词')),
yuanqu=sum(good*(beizhu=='元曲')),
wenyan=sum(good*(beizhu=='文言文'))
)
writer <- subset(total_content>1&name!='佚名'&total_good!=wenyan)
writer$good_paiming <- nrow(writer)-rank(writer$total_good)+1
writer <- subset(writer,paiming<=100)
我们将前100位的作者的作品数量和作品总点赞数分别作为x,y轴绘制散点图
我们发现原始数据集中在左下角,为了提高可读性,我们将横纵坐标分别log处理,并将点赞数前15位的作者姓名在下图中标注出来。我们此次采取了ggthemes中提供的theme_solarized模板绘制,其中有light这一重要参数,下面两图分别为light为TRUE/FALSE时的效果。
复赛
有了好的作品,也需要有一定的人气作为保证才能在高手如云的选秀节目中杀出重围,我们爬取了各位文人在百度的点赞数和转发数二者之和,并从中选出人气最高的50位进入最后决赛,需要注意的是,本次爬取依然需要借助RSelenium进行动态的爬取过程,页面及爬取的代码如下:(如下图杜牧的点赞数和转发数分别为9980、291)
remDr <- remoteDriver(remoteServerAddr = "127.0.0.1"
, port = 4444
, browserName = "chrome")
remDr$open()
url <- sprintf('https://baike.baidu.com/item/%s',writer$name[i])
remDr$navigate(url)
temp <- htmlParse(remDr$findElement(using='xpath',
'//*[@id="j-top-vote"]')$getElementAttribute("o uterHTML")[[1]],
encoding='utf-8')
renqi <- as.numeric(sapply(getNodeSet(temp,
'//span[@class="vote-count"]'),xmlValue))
temp <- htmlParse(remDr$findElement(using='xpath',
'//html/body/div[4]/div[2]/div/div[2]/div[1]/di v[2]')$
getElementAttribute("outerHTML")[[1]],encoding='utf-8')
zhuanfa <- as.numeric(sapply(getNodeSet(temp, '//span[@class="share-count"]'),xmlValue))
决赛
终于进入了最终的决赛,先来看一下50位进入决赛选手所在的赛区分布(生活朝代):
对于决赛选手,我们将根据其作品好评数(初赛作品好评数),作品数量(初赛入围作品数量),人气值(复赛好评数+转发数)三项指标获得最终的排名。在统一量纲标准化后,采取PCA(主成分分析法),分别得到各位选手PCA分解后在各个维度的分数,结合该维度方差占比得到综合分数。
代码如下:
writer$scale_good <- scale(writer$total_good,center=FALSE)
writer$scale_renqi <- scale(writer$total_renqi,center=FALSE)
writer$scale_content <- scale(writer$total_content,center=FALSE)
k <- princomp(cbind(writer$scale_good,writer$scale_renqi,writer$scale_content))
writer$pca_score_1 <- k$scores[,1]
writer$pca_score_2 <- k$scores[,2]
writer$pca_score_3 <- k$scores[,3]
writer$pca_score <- writer$pca_score_1*k$sdev[1]/sum(k$sdev)+
writer$pca_score_2*k$sdev[2]/sum(k$sdev)+
writer$pca_score_3*k$sdev[3]/sum(k$sdev)
最后给出完整的排名:
(由于PCA会自动对数据进行中心化,所以会出现最终得分为负分的情况)
现在我们可以回答文章开头提到的几个问题了。作品最受欢迎TOP3:李白、苏轼、杜甫,人气最高TOP3:李白、李清照、曹操,最高产TOP3:李白、苏轼、辛弃疾。
最终李白以三项均排名第一的巨大优势毫无悬念的获得了本次比赛的冠军,被小学生所热捧的苏轼和一直很忙的杜甫分获亚军和季军,排名四到十位的分别是:辛弃疾,白居易,陆游,李商隐,王维,李清照,刘禹锡。
公众号后台回复关键字即可学习
回复 R R语言快速入门免费视频
回复 统计 统计方法及其在R中的实现
回复 用户画像 民生银行客户画像搭建与应用
回复 大数据 大数据系列免费视频教程
回复 可视化 利用R语言做数据可视化
回复 数据挖掘 数据挖掘算法原理解释与应用
回复 机器学习 R&Python机器学习入门