上周《我是歌手》吵吵闹闹地落幕了，这一季是我最关注的一季，很认真的从头看到尾。网上各种讨论，特别反感那些说看到谁谁谁就不想看了的说法，其实单纯地去听他们的歌声，会觉得即使是之前不看好的那些歌手都能给你很多惊喜和感动。以前对清华哥哥的印象是歌都很好听，但是自己唱不红，翻唱都会变红啊，现在喜欢上他的声音了啊！不管这个节目有没有什么内部操作黑幕，单纯听他们的歌还是挺好的。当然，这篇文章的主旨不在此，我们要看的如题《我是歌手》节目中，出场顺序和名词的关系。关系肯定是有的，节目里自己都说到了，出场顺序很重要，这里我想用R来尝试分析这其中的细节关系。
数据是三季我是歌手除去突围赛半决赛总决赛的其余场次歌手们的出场顺序和名次，以及得票率（部分场次没有具体的得票率记为NA），一共31场，31*7=217行数据。基本数据结构如下：
数据可以查看到基本内容如下：
singerData <-read.table("clipboard",header=T)
head(singerData,n=5)
1. 出场顺序与名次的数量关系
先把所有三季数据按出场顺序及排名做一个简单的统计：
table(data.frame(order=singerData$order,rank=singerData$rank))
都是数字，看起来很无感，试试用气泡图来看这个结果呢？
order.rank <-data.frame(a=c(rep(1,7),rep(2,7),rep(3,7),rep(4,7),rep(5,7),rep(6,7),rep(7,7)),b=c(rep(1:7,7)))
for(i in 1:7){
for (j in 1:7) {
order.rank$c[(i-1)*7+j] <-table(data.frame(order=singerData$order,rank=singerData$rank))[i,j]
}
}
symbols(order.rank$a,order.rank$b,order.rank$c,inches=0.40,bg="lavender",xlab="Singers'Order",ylab="Singers' Rank")
这个图好像也没有太多的很直观的信息，但是大概能看出来数据比较集中在从点(1,7)到点(7,1)这条线的周边。
2. 每一出场顺序下的平均名次
这里把算出每个出场次序的平均名次算出后，用折线图展示出来。
order.avgRank <- data.frame(order=1:7)
for(i in1:7){
order.avgRank$avgRank[i] <-mean(singerData$rank[singerData$order==i])
}
plot(order.avgRank$order,order.avgRank$avgRank,type="l",xlab="Singer'Order",ylab="Average Rank")
这个图就能很明显的看出来歌手最终的名次与其出场顺序存在近似负相关的关系。看看每一季的结果是不是都类似呢？
season.order.avgRank<- data.frame(s1=numeric(0),s2=numeric(0),s3=numeric(0))
for(i in1:3){
for(j in 1:7){
season.order.avgRank[j,i]<-mean(singerData$rank[singerData$season==i&singerData$order==j],na.rm=TRUE)
}
}
season.order.avgRank
matplot(season.order.avgRank,type="o",col=1:3,lty=1:3)
legend(5.5,5.5,c("第一季","第二季","第三季"),col=1:3,lty=1:3)
三季我是歌手，出场次序跟名次的关系，第一季第二季其实不是很明显，第三季有一个很明显的近似负相关的关系。
换个方式，查看得票率和出场次序的关系。
season.order.avgRate <-data.frame(s1=numeric(0),s2=numeric(0),s3=numeric(0))
for(i in 1:3){
for(j in 1:7){
season.order.avgRate[j,i]<-mean(singerData$percentage[singerData$season==i&singerData$order==j],na.rm=TRUE)
}
}
season.order.avgRate
matplot(season.order.avgRate,type="o",col=1:3,lty=1:3)
legend(1,19,c("第一季","第二季","第三季"),col=1:3,lty=1:3)
其实不用看就可以想象，跟名次与出场顺序的关系类似，肯定是第三季的特征会比较明显。这说明什么？第三季的观众比较不理智？第三季的歌手水平比较接近，所以观众才会屈从最直接的感受？请自行想象猜测！
3. 线性回归方式尝试找出其中关系
在第一部分气泡图的基础上做。
symbols(order.rank$a,order.rank$b,order.rank$c,inches=0.40,bg="lavender",xlab="Singers'Order",ylab="Singers' Rank") model=lm(rank~order,data=singerData) abline(model,lty=1,col=2) summary(model)
得到的回归方程式：rank = 4.74194-0.18799*order
Residuals：残差，上面给出了残差的最大值、最小值、中位数、上四分位数、下四分位数，可以看出符合正态分布。
Coefficients：系数，Estimate是预测的系数上面是截距，下面是斜率。
Residual standarderror：标准残差
Multiple R-squared ：R^2值
Adjusted R-squared：调整R^2值，跟R^2值一样都是在0-1的范围内，越接近1表明这个模型可参考价值越大，越接近0表示可参考价值越小。
F-statistic：F统计量
p-value：p值
从模型的统计量能够看出，这个方程参考价值很低，不是一个很显著的线性模型。
4. 歌手的平均得票率
这里是把歌手的平均得票率计算出来，求其平均得票率，可以看出哪个歌手的整体表现比较好。与主题无关，只是一个小的统计。结果可以看到，林志炫稳居榜首，所以？你自己领会就好！
singers <-unique(singerData$singer)
avgRate <- numeric(0)
for(i in 1:length(singers)){
avgRate[i] <-mean(singerData$percentage[singerData$singer==singers[i]],na.rm=TRUE)
}
singersAvgRate <-data.frame(singers=singers,avgRate=avgRate)
singersAvgRate <- singersAvgRate[order(-singersAvgRate[,2]),]
fix(singersAvgRate)
有任何问题和建议欢迎指出，转载请注明出处，谢谢！