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

研究1896年至2016年奥运会运动员的数据集，主要指标有身高、体重、年龄、国籍、参与项目、是否获得金/银/铜牌。通过运用R软件对数据作描述性统计、可视化分析。先了解数据集的基本信息，例如首次创办奥运的时间、比赛项目；再得到有关运动员的信息，例如身体指标；再观察各国获奖牌数的情况。

先运行dplyr包，是一个对dataframe作数据分析很有用的package

library(dplyr)

然后我们就来读写这个数据表了，以下是一些基本信息

athlete = read.csv("athlete_events.csv")
names(athlete) #看有哪些指标

unique(athlete$Sport)#奥运会有哪些基本项目类别
length(unique(athlete$Sport)) #类别个数
sort(table(athlete$Sport),decreasing = T) #大致看一下参与人数、项目举办次数多的几项运动
chn = athlete[which(athlete$NOC == "CHN"),]
chn[order(chn$Year),][1,]
#1932年中国首次出战奥运。

接下来可以做点数据可视化，用到ggplot2包

a2 = athlete %>% filter(Season == "Summer") %>% group_by(Year,Season) %>% summarise(number_of_ath = n()) #看异常值，判断标准：前一年和后一年都比该年参赛人数多至少2000人
for (i in 2:nrow(a2)-1){
  if (a2$number_of_ath[i+1] > a2$number_of_ath[i] +2000){
    if (a2$number_of_ath[i-1] > a2$number_of_ath[i] +2000){
      print (a2$Year[i])
    }
  }
}
a2$number_of_ath[9]-a2$number_of_ath[10]
a2$number_of_ath[13]-a2$number_of_ath[14]

1932和1956年夏季奥运会参赛人数分别比前一年少2000余人和3000余人，经查阅知，1932年洛杉矶奥运会由于费用问题，而1956年在美苏影响下国际局势动荡，多国弃权。

再看下运动员人数分布

ggplot(na.omit(athlete)) + geom_density(aes(x=Age,fill=Sex),alpha = 0.5) +  labs(title = "distribution of age") #不同性别的年龄段密度图分析

library(MASS)   #男/女运动员在夏/冬的年龄分布
par(mfrow=c(2,2))
malesummer = athlete %>% filter(Sex == "M") %>% filter(Season == "Summer")
malewinter = athlete %>% filter(Sex == "M") %>% filter(Season == "Winter")
femalesummer = athlete %>% filter(Sex == "F") %>% filter(Season == "Summer")
femalewinter = athlete %>% filter(Sex == "F") %>% filter(Season == "Winter")
hist(malesummer$Age , xlim = c(0,60),xlab = "age", main ="summer male athletes'age" )
hist(malewinter$Age , xlim = c(0,60),xlab = "age", main ="winter male athletes'age")
hist(femalesummer$Age , xlim = c(0,60),xlab = "age", main ="summer female athletes'age")
hist(femalewinter$Age , xlim = c(0,60),xlab = "age", main ="winter female athletes'age")

可看到，运动员主要年龄都分布在15-35岁之间，其中男性20-30岁之间居多，女性为15-30岁之间居多。

进一步看男女夏冬两季运动员的年龄分布，总体呈现出略微左偏的正态分布，均值为25左右。

身高体重之间的关系

# 近20年来运动员的身高、体重
ath20 <- athlete %>% filter(!is.na(Height), !is.na(Weight), Year > 2017-20)
ggplot(ath20,aes(x = as.factor(Year), y = Weight, fill = Sex)) + geom_boxplot() + labs(title = "Athletes' Weight" , xlab = "year") #体重
ggplot(ath20,aes(as.factor(Year), y = Height, fill = Sex)) + geom_boxplot() + labs(title = "Athletes' Height" , xlab = "year") #身高
ggplot(athlete,aes(x = Weight, y = Height)) + geom_point(aes(color=Sex),cex = 0.2 , alpha = 0.5) + facet_wrap(~Sex) + geom_smooth(method="lm") + ggtitle("Weight vs Height") #体重与身高

运动员在不同年龄拿奖牌数的散点图和拟合曲线

a3 = athlete %>% group_by(Age,Sex) %>% summarise(sum_of_medals = n())
ggplot(a3,aes(x=Age,y=sum_of_medals))+geom_point(size=1)+geom_smooth(se=FALSE) + scale_x_continuous(breaks = seq(0, 100, 10)) + labs(y = "sum of medals", title = "Total number of medals VS Age ")
ggplot(a3,aes(x=Age,y=sum_of_medals,color=Sex))+geom_point(size=1)+geom_smooth(se=FALSE) + scale_x_continuous(breaks = seq(0, 100, 10))  + labs(y = "sum of medals", title = "Medals won by different sexes VS Age ")
#运动员在不同年龄拿奖牌数的散点图和拟合曲线。
#按性别划分

可以看到27岁之前的运动员平均获奖牌数随着年龄的增长而增长，之后就随着年龄增长而减少，45岁之后基本没有获得奖牌的可能。再按性别划分，男性拿奖牌数的拐点在28岁左右，即在此之前拿奖牌数随着年龄的增长而增长，在此之后随着年龄的增长而减少，而女性是在25岁左右。

统计了近20年（1998年-2017年）各国累积所获奖牌数（单位：百），各国名称由三个大写英文字母的代码所表示。得到前15名的数据，与另一数据集匹配，将各国按大洲划分。可以看到美国遥遥领先，中国位居第四。欧洲有较多国家入榜，说明可能欧洲种族在运动比赛方面的基因优势。

continents = read.csv("conti_country.csv") %>% select(NOC,Continent)
x1 = athlete %>% filter(Year>2017-20) %>% group_by(NOC) %>% filter(Medal != "<NA>") %>% summarise(num_of_medals = n()/100) %>% arrange(desc(num_of_medals)) #近20年来各国累计获得奖牌数（单位：百）
x = x1[1:15,] %>% left_join(continents) #得到前十五名的数据，并匹配大洲

x$fac=factor(x$Continent)  #因子变量
x$col[x$fac=="Asia"]="red"  #设颜色
x$col[x$fac=="Europe"]="blue"
x$col[x$fac=="Africa"]="darkgreen"
x$col[x$fac=="Oceania"]="purple"
x$col[x$fac=="North America"]="pink"
x$col[x$fac=="South America"]="yellow"
dotchart(x$num_of_medals, labels=x$NOC,cex=0.6,groups=factor(x$Continent), gcolor="black", main="Accumulative number of medals in the past 20 years(hundred)",col = x$col,pch = 19 ,xlab = "medals(hundred)")