R数据分析｜可视化｜dplyr｜Kaggle奥运会数据集（二）

由于这个数据集较为庞大，想深入探究点东西，所以想缩小数据范围。那么我们就仅关注“男子球类运动”。这里用到的是grepl函数，其实筛选的是参与项目名里含“ball”的，所以可能有所错漏。这篇文章里的分析方法比较偏统计学，有涉及p值、假设检验、回归分析等等。

中美男子球类运动员历届平均身高分别为 194.7 米、191.1 米；历届平均年 龄都为 24.7 岁。为比较两国该类项目男运动员历届身高、年龄的差异，引入 t 检验。计算得关于身高的 p 值为 0.3129，大于 0.05；关于身高的 p 值为 0.9831， 大于 0.05，所以认为两国身高、年龄指标的数据有显著差异。再比较中美俄这两项指标，引入 ANOVA 检验，计算得关于身高的 p 值为 0.382，大于 0.05；关于身高的 p 值为 0.0591，大于 0.05，所以认为这三个国家身高、年龄指标的数据有显著差异。

male_ball = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% group_by(NOC) #各国男子球类项目

usa_chn_height = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% filter(NOC %in% c("USA","CHN")) %>% filter (Height != "NA") %>% group_by(Year,NOC) %>% summarise(height = mean(Height)) #中美国男子球类项目历届平均身高
usa_chn_age = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% filter(NOC %in% c("USA","CHN")) %>% filter (Age != "NA") %>% group_by(Year,NOC) %>% summarise(age = mean(Age)) 
#中美国男子球类项目历届平均年龄
usa_chn_rus_height = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% filter(NOC %in% c("USA","RUS","CHN")) %>% filter (Height != "NA") %>% group_by(Year,NOC) %>% summarise(height = mean(Height))
#中美俄国男子球类项目历届平均身高
usa_chn_rus_age = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% filter(NOC %in% c("USA","RUS","CHN")) %>% filter (Age != "NA") %>% group_by(Year,NOC) %>% summarise(age = mean(Age))
#中美俄国男子球类项目历届平均年龄
t.test(usa_chn_height$height ~ usa_chn_height$NOC)
t.test(usa_chn_age$age ~ usa_chn_age$NOC)
aov(usa_chn_rus_height$height ~ usa_chn_rus_height$NOC)
summary(aov(usa_chn_rus_height$height ~ usa_chn_rus_height$NOC))
aov(usa_chn_rus_age$age ~ usa_chn_rus_age$NOC)
summary(aov(usa_chn_rus_age$age ~ usa_chn_rus_age$NOC))
#为比较是否获奖牌数有显著差异，引入t检验。p值若小于0.05。则拒绝原假设，认为有显著差异。

为了解男子球类运动员获得奖牌数与身高、体重、年龄、参与人数的关系， 计算各国该项目运动员历届平均身高、体重、年龄、参与人数，先对每个单变量关于平均奖牌数运用 lm 函数，得到身高的 p 值为 0.0001542、体重的 p 值为 5.865e-05、年龄的 p 值为 0.01279、参与人数的 p 值为 6.477e-16。因为这四个指标可能会相互影响，所以将这四个指标按照 p 值由小到大的顺序，关于奖牌数用 lm 函数作多变量影响分析，可消除导致差异较大的因素对影响导致较小的因素的影响，得到的结论是只有参与人数有影响显著，线性回归模型为
$$M=0.4478\ast n$$
其中$M$为奖牌数，$n$为运动员人数。
而年龄关于奖牌数有可能不是线性的关系，尝试作曲线拟合回归，可以看到纵轴截距为 24 左右，且曲线非常平缓，所以认为男子球类项目在 24 岁左右获得奖牌数优势较大。

fit1 = lm(b6$medal ~ b6$height) #单变量线性回归
summary(fit1)
fit2 = lm(b6$medal ~ b6$weight)
summary(fit2)
fit3 = lm(b6$medal ~ b6$age)
summary(fit3)
fit4 = lm(b6$medal ~ b6$ath_m)
summary(fit4)
fit5 = lm(b6$medal ~ b6$ath_m + b6$weight + b6$height +b6$age)   #多变量
summary(fit5)     #发现只有ath_m因子显著
coef(fit4)#估计值
b6

library(ggplot2)
fit.lowess=lowess(b6$medal, b6$age)    #年龄关于奖牌数的多项式回归
fit.loess=loess(b6$age~b6$medal, data=b6)
fit.spline=smooth.spline(b6$medal, b6$age)
u = b6$medal
v = b6$age
plot(u, v ,xlab = "average medals of each year",ylab = "average age" )
lines(u,fitted(lm(v~u)) , lty = 2) 
lines(lowess(u,v) ,col = "blue" )
lines(u,predict(loess(v~u)),col = "red")
lines(fit.spline ,col = "green")
legend("bottomright", legend=c("lm","lowess","loess","smooth.spline"), col=c("black","blue","red","green"), lty=c(2,1,1,1),lwd = 1)
title("Medal vs Sex")

另外还想对曾经获得过男子球类项目奖牌的国家获的金/银/铜牌进行层次聚类分析，但是奖牌数不太好分类，我就自己定了个标准——获得金/银/铜牌数小于等于25，记作1；在26至50之间（包含50），记作2；大于50的记作3（因为获得金/银/铜牌数的中位数分别为25、25、19）。由此得到30个国家的指标数据的层次聚类分析图

#获得过男子球类项目奖牌的30国金银铜牌聚类分析
male_ball = athlete %>% filter(Sex == "M") %>% filter(grepl("ball",Sport)) %>% group_by(NOC) #各国男子球类项目
gmed = male_ball %>% filter(Medal == "Gold") %>% summarise(sum = n())   #各国金银铜的中位数
median(gmed$sum) 
smed = male_ball %>% filter(Medal == "Silver") %>% summarise(sum = n())
median(smed$sum)
bmed = male_ball %>% filter(Medal == "Bronze") %>% summarise(sum = n())
median(bmed$sum)
gold = male_ball %>% filter(Medal == "Gold") %>% summarise(gold = ifelse(n()>25,ifelse(n()>50,3,2),1)) #>50，记作3；26-50，记作2；1-25，记作1
silver = male_ball %>% filter(Medal == "Silver") %>% summarise(silver = ifelse(n()>25,ifelse(n()>50,3,2),1))
bronze = male_ball %>% filter(Medal == "Bronze") %>% summarise(bronze = ifelse(n()>25,ifelse(n()>50,3,2),1))
medal3 =gold %>% left_join(silver) %>% left_join(bronze)
medal3[is.na(medal3)] = 1
medaldf = data.frame(row.names = medal3$NOC , gold=medal3$gold,silver=medal3$silver,bronze=medal3$bronze)
medaldf    #获得过男子球类项目奖牌的30国金银铜牌数表

dd=dist(medaldf)
hc=hclust(dd)
plot(hc,hang=-1,cex=.8 )