前言

“现代奥运会”包括从1896年雅典到2016年里约奥运会的所有奥运会。奥运会不仅仅是世界各国运动健将的盛会，透过它的发展历史与发展趋势，可以了解全球的近代发展史，不仅仅包括体育发展史，而且还包括人文政治。

作为体育竞技爱好者，对奥运会这项全球性的体育盛会，怎么能没有一个透彻的了解呢？

我此次的研究，将对从1896年雅典到2016年的里约奥运会进行探索，目标有三：

详细的展示奥运的总体内容，比如每年有多少运动员、多少国家参与到奥运会，每年有多少竞技项目，哪个国家赢得的奖牌最多等等；
对这一百多年奥运会的发展趋势进行探索，比如一些体育项目的运动员身高体重变化趋势、参与国家在地理上的遍布趋势、男性与女性运动员的比例变化趋势等等。
不仅如此，我还会发现展示一些有趣的细节，比如你会知道绘画和诗歌曾经也是奥运会的项目吗？你知道我国在奥运会获得的奖牌大部分是女性运动员贡献的吗？你知道奥运史上年龄最大的运动员有97岁吗？

本次研究数来源：开源数据网站kaggle上的数据集“120 years of Olympic history: athletes and results”

导入数据集

library(parallel)
library(doParallel)
library(VIM)
library(ggplot2)
library(DMwR)
library(dplyr)
library(sqldf)
library(gridExtra)
library(ggthemes)
library(plotly)
library(maps)

n_Cores <- detectCores()
cluster_Set <- makeCluster(n_Cores)
registerDoParallel(cluster_Set)

olympic_data <- read.csv("athlete_events.csv",stringsAsFactors = F)
olympic_data <- data.frame(olympic_data)
olympic_data$Sex <- factor(olympic_data$Sex)
olympic_data$NOC <- factor(olympic_data$NOC)
olympic_data$Games <- factor(olympic_data$Games)
olympic_data$Season <- factor(olympic_data$Season)
olympic_data$City <- factor(olympic_data$City)
olympic_data$Sport <- factor(olympic_data$Sport)
olympic_data$Event <- factor(olympic_data$Event)
olympic_data$Medal <- factor(olympic_data$Medal,levels = c("Gold","Silver","Bronze","Noranking"))

瞧一瞧

str(olympic_data)

## 'data.frame':    271116 obs. of  15 variables:
##  $ ID    : int  1 2 3 4 5 5 5 5 5 5 ...
##  $ Name  : chr  "A Dijiang" "A Lamusi" "Gunnar Nielsen Aaby" "Edgar Lindenau Aabye" ...
##  $ Sex   : Factor w/ 2 levels "F","M": 2 2 2 2 1 1 1 1 1 1 ...
##  $ Age   : int  24 23 24 34 21 21 25 25 27 27 ...
##  $ Height: int  180 170 NA NA 185 185 185 185 185 185 ...
##  $ Weight: num  80 60 NA NA 82 82 82 82 82 82 ...
##  $ Team  : chr  "China" "China" "Denmark" "Denmark/Sweden" ...
##  $ NOC   : Factor w/ 230 levels "AFG","AHO","ALB",..: 42 42 56 56 146 146 146 146 146 146 ...
##  $ Games : Factor w/ 51 levels "1896 Summer",..: 38 49 7 2 37 37 39 39 40 40 ...
##  $ Year  : int  1992 2012 1920 1900 1988 1988 1992 1992 1994 1994 ...
##  $ Season: Factor w/ 2 levels "Summer","Winter": 1 1 1 1 2 2 2 2 2 2 ...
##  $ City  : Factor w/ 42 levels "Albertville",..: 6 18 3 27 9 9 1 1 17 17 ...
##  $ Sport : Factor w/ 66 levels "Aeronautics",..: 9 33 25 62 54 54 54 54 54 54 ...
##  $ Event : Factor w/ 765 levels "Aeronautics Mixed Aeronautics",..: 160 398 349 710 623 619 623 619 623 619 ...
##  $ Medal : Factor w/ 4 levels "Gold","Silver",..: NA NA NA 1 NA NA NA NA NA NA ...

summary(olympic_data)

##        ID             Name           Sex             Age       
##  Min.   :     1   Length:271116      F: 74522   Min.   :10.00  
##  1st Qu.: 34643   Class :character   M:196594   1st Qu.:21.00  
##  Median : 68205   Mode  :character              Median :24.00  
##  Mean   : 68249                                 Mean   :25.56  
##  3rd Qu.:102097                                 3rd Qu.:28.00  
##  Max.   :135571                                 Max.   :97.00  
##                                                 NA's   :9474   
##      Height          Weight          Team                NOC        
##  Min.   :127.0   Min.   : 25.0   Length:271116      USA    : 18853  
##  1st Qu.:168.0   1st Qu.: 60.0   Class :character   FRA    : 12758  
##  Median :175.0   Median : 70.0   Mode  :character   GBR    : 12256  
##  Mean   :175.3   Mean   : 70.7                      ITA    : 10715  
##  3rd Qu.:183.0   3rd Qu.: 79.0                      GER    :  9830  
##  Max.   :226.0   Max.   :214.0                      CAN    :  9733  
##  NA's   :60171   NA's   :62875                      (Other):196971  
##          Games             Year         Season      
##  2000 Summer: 13821   Min.   :1896   Summer:222552  
##  1996 Summer: 13780   1st Qu.:1960   Winter: 48564  
##  2016 Summer: 13688   Median :1988                  
##  2008 Summer: 13602   Mean   :1978                  
##  2004 Summer: 13443   3rd Qu.:2002                  
##  1992 Summer: 12977   Max.   :2016                  
##  (Other)    :189805                                 
##              City               Sport       
##  London        : 22426   Athletics : 38624  
##  Athina        : 15556   Gymnastics: 26707  
##  Sydney        : 13821   Swimming  : 23195  
##  Atlanta       : 13780   Shooting  : 11448  
##  Rio de Janeiro: 13688   Cycling   : 10859  
##  Beijing       : 13602   Fencing   : 10735  
##  (Other)       :178243   (Other)   :149548  
##                                  Event              Medal       
##  Football Men's Football            :  5733   Gold     : 13372  
##  Ice Hockey Men's Ice Hockey        :  4762   Silver   : 13116  
##  Hockey Men's Hockey                :  3958   Bronze   : 13295  
##  Water Polo Men's Water Polo        :  3358   Noranking:     0  
##  Basketball Men's Basketball        :  3280   NA's     :231333  
##  Cycling Men's Road Race, Individual:  2947                     
##  (Other)                            :247078

数据清洗

aggr(olympic_data,prop = F,numbers = T)

由于没有取得奖牌“Medal”项会被记录为缺失值，所以用“Noranking”代替。

olympic_data$Medal[is.na(olympic_data$Medal)] <- "Noranking"
aggr(olympic_data,prop = F,numbers = T)

数据集由于一些不为人知的原因，身高和体重同时缺失得太多了，由于后面我们有对身高和体重进行探索研究的打算，此处就不做插补了，以免对后面的研究产生不良的影响，后面探索的时候过滤掉即可。

参与的国家、体育项目、运动员的数量

参与的国家

df1 <- sqldf("select Year,Season,count(distinct NOC) nums
              from olympic_data
              group by Year,Season",row.names = T) %>%
  data.frame()

windowsFonts(yahei = windowsFont(family = "Microsoft YaHei"))

mytheme <- theme(legend.title = element_blank(),
                 plot.title = element_text(hjust = 0.5,size = 18,family = "yahei"),
                 axis.title = element_text(size = 13,family = "yahei"))

ggplot(df1,aes(Year,nums,color = Season))+
  geom_point(size = 2)+
  geom_line()+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "参加的国家数目",title = "参加奥运会的国家数目的变化")

体育项目

df2 <- sqldf("select Year,Season,count(distinct Event) nums
              from olympic_data
              group by Year,Season",row.names = T) %>%
  data.frame()

ggplot(df2,aes(Year,nums,color = Season))+
  geom_point(size = 2)+
  geom_line()+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "项目数",title = "每届奥运会体育项目数量的变化")

参与的运动员

df3 <- sqldf("select Year,Season,count(distinct ID) nums
              from olympic_data
              group by Year,Season",row.names = T) %>%
  data.frame()

ggplot(df3,aes(Year,nums,fill = Season))+
  geom_bar(stat = "identity")+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "人数",title = "历届奥运会的参与人数")+
  geom_vline(xintercept = 1914,lty = 2)+
  geom_vline(xintercept = 1918,lty = 2)+
  geom_vline(xintercept = 1939,lty = 2)+
  geom_vline(xintercept = 1945,lty = 2)+
  annotate("text",x = c(1914,1942),y = c(6000,6000),
           label = c("第一次世界大战","第二次世界大战"),size = 3.5,angle = 45,family = "yahei")

ggplot(df3,aes(Year,nums,color = Season))+
  geom_point(size = 2)+
  geom_line()+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "人数",title = "历届奥运会的参与人数")+
  annotate("text",x = c(1904,1932,1956,1976,1980),
           y = c(400,1800,3100,6100,5300),
           label = c("1904 美国圣路易斯","1932 洛杉矶","1956 墨尔本",
                     "1976 加拿大蒙特利尔","1980 莫斯科"),size = 3)

夏季奥运会：

除去几次特别的奥运会之外，参加奥运会的国家数量呈稳步快速上升的态势，至1996年亚特兰大奥运会开始趋于稳定，逐年缓慢增长；
历届奥运会运动项目从上世界中叶开始也呈逐年快速增长的态势，至2000年悉尼奥运会开始逐渐趋于稳定；
历届参与的运动员和参与国家一样，数量呈稳步快速上升的态势，至1996年亚特兰大奥运会开始趋于稳定。

冬季奥运会：

1980年以前都被夏季奥运会掩盖了光辉，也有场地、气候等硬性条件限制。在1980年以前都发展得很缓慢，至1980年纽约冬奥会之后，参与的国家、运动员以及项目数都呈逐年增长的态势，目前为止还没有停止增长的趋势。

有趣的奥运历史：

在1912年到1948年间举办的奥运会，有5个非体育运动的项目，包括：建筑，雕刻，绘画，文学和音乐；
冬奥会至1994年开始就不和夏季奥运会在同年举办了；
第一次世界大战和第二次世界大战期间没有举办过奥运会；
1906年夏季奥林匹克运动会，于1906年4月22日至5月2日在希腊雅典举行，这次奥运会也称为1906年届间运动会。这次运动会是在第三届与第四届的国际奥林匹克运动会之间所举办的，故称“届间运动会”（Intercalated Games），由于没有冠上“国际奥林匹克运动会”的名称，因此比赛期间所颁发的奖牌，也没有被国际奥林匹克委员会所正式承认。
在整个奥运历史上，有5届奥运会参与国家和运动员数量的大幅下降，分别是：

1904年美国圣路易斯奥运会：此次夏季奥运会由于在北美大陆举办，交通不便，导致到多数国家不愿意参加；另外，除了交通问题，同时爆发的日俄战争导致国际关系紧迫也是此届奥运会人数大幅减少的原因之一。

1932年洛杉矶奥运会同1904年圣路易斯奥运会一样，也因费用问题而使参赛的运动员人数显著减少；就是在此次奥运会中，我国首次派出了一个3人组成的代表团，但运动员仅刘长春一人，由于准备不足，仓促上阵，刘长春未能发挥出自己的水平，在100米和200米预赛中落选。后因旅途劳顿，体力不支，放弃了400米的比赛。不过，刘长春开创了中国参加奥运会比赛的历史，对中国体育的发展影响深远。

1956年墨尔本奥运会上充斥着国际紧张局势，埃及，伊拉克和黎巴嫩抵制苏伊士危机的事件。由于苏联的参与，荷兰，西班牙和瑞士也退出了奥运会。在奥运会开幕前两周，我国决定不参与，因为当时的中华民国正在竞争。

1976年加拿大蒙特利尔夏季奥运会：为了抗议曾率领橄榄球队访问种族主义南非的新西兰代表团参加本届奥运会，坦桑尼亚等22个非洲国家联合抵制本届奥运会。但此年的冬季奥运会人数并未受到影响，因为非洲国家的运动员在冬奥会中影响不大。

1980年莫斯科奥运会：1980年3月21日，为抗议苏联于1979年入侵阿富汗的行为，美国总统吉米·卡特宣布美国将抵制本届奥运会。美国的决定得到全球50多个国家的响应，包括日本、加拿大、西德和中国。还有一些国家宣布将不会以国家代表团出席奥运会，开幕式入场以及获胜后只以奥运会会旗代替。这使得最终只有80个国家参与本届奥运会。

运动员的性别

夏运会和冬运会的男女比例

df4 <- sqldf("select Year,Season,Sex,count(distinct ID) nums
              from olympic_data
              group by Year,Season,Sex",row.names = T) %>%
  data.frame()

sum_m_num <- sqldf("select sum(nums)
              from df4
              where Season = 'Summer' and Sex = 'M'")
sum_f_num <- sqldf("select sum(nums)
              from df4
              where Season = 'Summer' and Sex = 'F'")
win_m_num <- sqldf("select sum(nums)
              from df4
              where Season = 'Winter' and Sex = 'M'")
win_f_num <- sqldf("select sum(nums)
              from df4
              where Season = 'Winter' and Sex = 'F'")

ggplot(df4,aes(Season,nums,fill = Sex))+
  geom_bar(stat = "identity")+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "人数",title = "冬奥会和夏奥会的男女比例")+
  annotate("text",x = c("Summer","Summer","Winter","Winter"),y = c(140000,60000,30000,10000),
           label = c(paste(round(sum_f_num/(sum_f_num+sum_m_num),4)*100,"%"),
                     paste(round(sum_m_num/(sum_f_num+sum_m_num),4)*100,"%"),
                     paste(round(win_f_num/(win_f_num+win_m_num),4)*100,"%"),
                     paste(round(win_m_num/(win_f_num+win_m_num),4)*100,"%")),color = "darkred")+
  theme(legend.position = "right")

历届奥运会男女人数

历届夏季奥运会男女运动员人数

df5 <- sqldf("select Year,Sex,sum(nums) nums
              from df4
              where Season = 'Summer'
              group by Year,Sex",row.names = T)
ggplot(df5,aes(Year,nums,group = Sex,color = Sex))+
  geom_point()+
  geom_line()+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "人数",title = "历届夏季奥运会男女运动员人数")

历届冬季奥运会男女运动员人数

df6 <- sqldf("select Year,Sex,sum(nums) nums
              from df4
              where Season = 'Winter'
              group by Year,Sex",row.names = T)
ggplot(df6,aes(Year,nums,group = Sex,color = Sex))+
  geom_point()+
  geom_line()+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = "人数",title = "历届冬季奥运会男女运动员人数")

df7 <- sqldf("select Year,NOC,Sex,count(distinct ID) nums
              from olympic_data
              where Year in (2016,1996,1976,1956,1936)
              group by Year,NOC,Sex",row.names = T)
df8 <- sqldf("select Year,NOC,sum(case
                                  when Sex = 'M' then nums 
                                  else 0 end ) Male,
                              sum(case
                                  when Sex = 'F' then nums 
                                  else 0 end ) Female
              from df7
              group by Year,NOC",row.names = T) %>%
  data.frame()
df8$Year <- factor(df8$Year)

ggplot(df8,aes(Male,Female,color = Year,group = Year))+
  geom_point(alpha = 0.6)+
  geom_smooth(method = "lm",se = F)+
  geom_abline(intercept=0, slope=1, lty = 2,lwd = 1)+
  theme_economist()+
  mytheme+
  theme(legend.position = "right")+
  labs(x = "男运动员",y = "女运动员",title = "运动员的男女比例")

在历届夏季奥运会中，男性运动员的参与人次占比74.33%，女性运动员参与人次占比25.67%；在历届冬季奥运会中，男性运动员参与人次占比71.83%，女性运动员参与人次占比28.17%；
在夏季奥运会中，除去几届特殊情况之外，男性运动员的增长在1996年达到顶峰，之后的夏季奥运会中，男性运动员数量有所下降；而女性运动员的数量一直稳步上升，特别是在1980年以后;
冬季奥运会中，不论是男性运动员还是女性运动员，数量都是稳步增长的，特别是在1980年以后;
我们纵观整个奥运历史，虽然男性运动员占比一直高于女性运动员，但是我们可以看到，随着奥运会的发展，女性运动员的占比一直在提升，到2016年为止，整体上已经快要和男性运动员占比持平了。而且，近几届奥运会中，已经有很多国家女性运动员的数量高于男性运动员（上图虚线以上的点对应的国家）。

运动员的年龄

age_data <- olympic_data[complete.cases(olympic_data[,4]),]

ggplot(age_data,aes(Age))+
  geom_histogram(bins = 30,fill = "turquoise3",color = "white")+
  theme_economist()+
  mytheme+
  labs(x = NULL,y = NULL,title = "运动员的年龄分布")+
  geom_vline(xintercept = median(age_data$Age),lty = 2,lwd = 1,color = "deeppink")+
  scale_x_continuous(breaks = seq(min(age_data$Age),max(age_data$Age),5))

ggplot(age_data,aes(Age,group = Sex,fill = Sex,alpha = 0.6,palette = "npg"))+
  geom_density()+
  theme_economist()+
  mytheme+
  theme(legend.position = "right",
        axis.title = element_blank())+
  labs(title = "男女运动员的年龄分布")

min_age <- sqldf("select * from olympic_data where Age = (select min(Age) from olympic_data)")
min_age

##      ID               Name Sex Age Height Weight
## 1 71691 Dimitrios Loundras   M  10     NA     NA
##                            Team NOC       Games Year Season   City
## 1 Ethnikos Gymnastikos Syllogos GRE 1896 Summer 1896 Summer Athina
##        Sport                                 Event  Medal
## 1 Gymnastics Gymnastics Men's Parallel Bars, Teams Bronze

max_age <- sqldf("select * from olympic_data where Age = (select max(Age) from olympic_data)")
max_age

##       ID                   Name Sex Age Height Weight          Team NOC
## 1 128719 John Quincy Adams Ward   M  97     NA     NA United States USA
##         Games Year Season      City            Sport
## 1 1928 Summer 1928 Summer Amsterdam Art Competitions
##                                         Event     Medal
## 1 Art Competitions Mixed Sculpturing, Statues Noranking

25岁左右是运动员的黄金年龄。
从整体分布看，女性运动员的年龄整体略小于男性运动员。
纵观整个奥运史，年龄最小的运动员仅为10岁。在1896年第一届奥运会中，一名代表德国出战的叫“Dimitrios Loundras”的小男孩在男子体操双杠的项目中夺得了团体铜牌。
1928年阿姆斯特丹夏季奥运会中，一名97岁高龄的美国“运动员”，参加了雕刻的“运动项目”，但并未获得名次。这个记录应该是不会被打破了。

运动员的身高和体重

由于1960年之前的运动员的身高和体重数据严重缺失，在这里我只探讨1960年及以后的奥运会。

身高

f1960_data <- sqldf("select *
                     from olympic_data
                     where Year >= 1960",row.names = T)

f1960_data <- f1960_data[complete.cases(f1960_data[,c("Height","Weight")]),]

ggplot(f1960_data,aes(as.factor(Year),Height,fill = Sex))+
  geom_boxplot()+
  theme_economist()+
  mytheme+
  theme(axis.title = element_blank(),
        axis.text.x = element_text(angle = 90))

体重

ggplot(f1960_data,aes(as.factor(Year),Weight,fill = Sex))+
  geom_boxplot()+
  theme_economist()+
  mytheme+
  theme(axis.title = element_blank(),
        axis.text.x = element_text(angle = 90))

随着奥运会的发展，运动员的平均身高和体重都有所增长。但是这不能得出身高越高、体重越重就能取得更好的成绩的结论，不同的运动项目，对身高和体重有不同的要求。我们对参与人数大于100人的运动大类进行探索分析。

pop_soprts1 <- sqldf("select Sport,count(distinct ID) c
                      from f1960_data
                      where Year = 1960
                      group by Sport having c >= 100",row.names = T) %>%
  data.frame()
pop_soprts2 <- sqldf("select Sport,count(distinct ID) c
                      from f1960_data
                      where Year = 2016
                      group by Sport having c >= 100",row.names = T) %>%
  data.frame()
pop_sport <- merge(pop_soprts1,pop_soprts2,by = "Sport")

pop_data <- sqldf("select *
                   from f1960_data
                   where Year in (1960,2016)
                   and Sport in (select Sport from pop_sport)",row.names = T) %>%
  data.frame()
pop_data$Year <- factor(pop_data$Year)
pop_data$Height <- as.numeric(pop_data$Height)

pop_data2 <- sqldf("select Sport,Year,avg(Height) Height
                    from pop_data
                    group by Sport,Year",row.names = T)
pop_data3 <- sqldf("select Sport,Year,avg(Weight) Weight
                    from pop_data
                    group by Sport,Year",row.names = T)
pop_data4 <- dcast(pop_data2,Sport ~ Year)
pop_data5 <- dcast(pop_data3,Sport ~ Year)
pop_data4$diffheight <- pop_data4$`2016`-pop_data4$`1960`
pop_data5$diffweight <- pop_data5$`2016`-pop_data5$`1960`

fpop_data <- cbind(pop_data4[,c(1,4)],pop_data5[,4]) %>%
  data.frame()
options(digits=3)
names(fpop_data)[3] <- "diffweight"

fpop_p <- ggplot(fpop_data,aes(diffheight,diffweight,color = Sport))+
  geom_point(size = 2)+
  theme(legend.position = "none")+
  labs(x = "身高",y = "体重",title = "各类运动的运动员身高体重变化趋势")+
  geom_vline(xintercept = 0)+
  geom_hline(yintercept = 0)+
  mytheme









ggplotly(fpop_p)

第一象限内的点代表运动员的平均身高和体重增长的运动，包括：游泳、篮球、拳击、赛艇、水球、皮划艇、击剑、摔跤；
第二象限内的点代表运动员的平均体重增加、平均身高减小的运动，包括：举重；
第三象限内的点代表运动员的平均体重和的身高都减小的运动，包括：帆船、曲棍球、射击、田径、体操；
第四象限内的点代表运动员的平均身高增加、平均体重减小的运动，包括：足球、自行车、马术。

奥运会的地理因素

我们以40年为单位，将奥运会的参与国家的遍布在世界地图上展现出来。

nations_data <- read.csv("noc_regions.csv")

Athina <- sqldf("select NOC,count(*) nums
                 from olympic_data
                 where Year =  1896 and Season = 'Summer'
                 group by NOC",row.names = T)
Berlin <- sqldf("select NOC,count(*) nums
                 from olympic_data
                 where Year =  1936 and Season = 'Summer'
                 group by NOC",row.names = T)
Munich <- sqldf("select NOC,count(*) nums
                 from olympic_data
                 where Year =  1972 and Season = 'Summer'
                 group by NOC",row.names = T)
Rio <- sqldf("select NOC,count(*) nums
                 from olympic_data
                 where Year =  2016 and Season = 'Summer'
                 group by NOC",row.names = T)
sporters1 <- merge(Athina,nations_data[,1:2],by = "NOC") %>%
  data.frame()
sporters2 <- merge(Berlin,nations_data[,1:2],by = "NOC") %>%
  data.frame()
sporters3 <- merge(Munich,nations_data[,1:2],by = "NOC") %>%
  data.frame()
sporters4 <- merge(Rio,nations_data[,1:2],by = "NOC") %>%
  data.frame()

world <- map_data("world")
world1 <- left_join(world,sporters1[,c(3,2)],by = "region")
world2 <- left_join(world,sporters2[,c(3,2)],by = "region")
world3 <- left_join(world,sporters3[,c(3,2)],by = "region")
world4 <- left_join(world,sporters4[,c(3,2)],by = "region")

ggplot(world1,aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = nums))+
  theme(panel.background = element_rect(fill = "steelblue1"),
        axis.title = element_blank())+
  scale_fill_gradient(low="gray70",high="red")+
  guides(fill = guide_colourbar(title = "人数"))

ggplot(world2,aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = nums))+
  theme(panel.background = element_rect(fill = "steelblue1"),
        axis.title = element_blank())+
  scale_fill_gradient(low="gray70",high="red")+
  guides(fill = guide_colourbar(title = "人数"))

ggplot(world3,aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = nums))+
  theme(panel.background = element_rect(fill = "steelblue1"),
        axis.title = element_blank())+
  scale_fill_gradient(low="gray70",high="red")+
  guides(fill = guide_colourbar(title = "人数"))

ggplot(world4,aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = nums))+
  theme(panel.background = element_rect(fill = "steelblue1"),
        axis.title = element_blank())+
  scale_fill_gradient(low="gray70",high="red")+
  guides(fill = guide_colourbar(title = "人数"))

从1896年的零星几点，到1936年北美洲及西欧地区几乎点亮，到1976年除非洲外的大部地区几乎点亮，再到2016年全世界几乎已经点亮。可以看到，至2016年，奥运会已经真正成为了全球性的体育盛事。
除格陵兰岛因为主权归属问题之外，玻利维亚也是灰色地区。这里是数据统计不全，我去查了下，2016年里约奥运会玻利维亚是有代表队参赛的。
但是时至今日，仍然有少部分地区参与度不足，包括：非洲的大部分地区、饱受战乱困扰的中东地区、东南亚地区以及蒙古国等国家。

奥运会的奖牌

奖牌数排名前20的国家

medal_data1 <- sqldf("select ID,Name,NOC,Sex,Sport,Medal
                     from olympic_data
                     where Medal in ('Gold','Silver','Bronze')",row.names = T)

medal_data2 <- sqldf("select NOC,Medal,count(Medal) nums
                      from medal_data1
                      where NOC in (select NOC
                                    from medal_data1
                                    group by NOC
                                    order by count(Medal) desc limit 20)
                      group by NOC,Medal",row.names = T)

ggplot(medal_data2,aes(reorder(NOC,nums,sum),nums,fill = Medal))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "国家",y = "奖牌数量")+
  mytheme

美国是奥运史上奖牌总数最多的国家，因为缺席了很多次奥运，我国排名仅第15。

奖牌排名前20的国家在哪些运动项目中获得的奖牌最多

medal_data3 <- sqldf("select NOC,Sport,count(Medal) nums
                      from medal_data1
                      where NOC in (select NOC
                                    from medal_data1
                                    group by NOC
                                    order by count(Medal) desc limit 20)
                      group by NOC,Sport
                      order by NOC,nums desc",row.names = T,drv = "SQLite") %>%
  data.frame()

medal_data4 <- medal_data3 %>% group_by(NOC) %>% dplyr::mutate(rank = dense_rank(-nums))

medal_data5 <- medal_data4[medal_data4$rank <= 5,]

ggplot(medal_data5,aes(reorder(NOC,nums,sum),nums,fill = Sport))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "国家",y = "奖牌数量")+
  mytheme

美国在田径、游泳等运动项目中优势最大,意大利在击剑等项目中获得的奖牌最多，澳大利亚在游泳、曲棍球等项目中获得的奖牌最多，中国在跳水、体操、兵乓球等项目中获得的奖牌最多。。。。。。

奖牌排名前20的国家男女运动员获取奖牌的比例

medal_data4 <- sqldf("select NOC,Sex,count(Medal) nums
                      from medal_data1
                      where NOC in (select NOC
                                    from medal_data1
                                    group by NOC
                                    order by count(Medal) desc limit 20)
                      group by NOC,Sex",row.names = T)

ggplot(medal_data4,aes(reorder(NOC,nums,sum),nums,fill = Sex))+
  geom_bar(stat = "identity")+
  coord_flip()+
  labs(x = "国家",y = "奖牌数量")+
  mytheme

男性运动员获得绝大部分的奖牌的国家有：英国、法国、意大利、瑞典、匈牙利、挪威、芬兰、瑞士；
男性运动员获得较多的奖牌的国家有：德国、加拿大、澳大利亚、荷兰、日本；
男女运动员获得差不多数量的奖牌的国家有：俄国（俄罗斯）、韩国；
女性运动员获得奖牌略多的国家有：罗马尼亚；
女性运动员获得大多数奖牌的国家有：中国。

总结

1.参与的国家数量、体育项目的数目、参与运动员的数量：

除去5次特别的奥运会之外，参加奥运会的国家数量呈稳步快速上升的态势，至1996年亚特兰大奥运会开始趋于稳定，逐年缓慢增长；这5次特别的奥运会分别是：1904年美国圣路易斯奥运会,1932年洛杉矶奥运会,1956年墨尔本奥运会，1976年加拿大蒙特利尔奥运会,1980年莫斯科奥运会。
历届奥运会运动项目从上世界中叶开始也呈逐年快速增长的态势，至2000年悉尼奥运会开始逐渐趋于稳定；
历届参与的运动员和参与国家一样，数量呈稳步快速上升的态势，至1996年亚特兰大奥运会开始趋于稳定。

2.参与运动员的性别、年龄、身高和体重：

在历届夏季奥运会中，男性运动员的参与人次占比74.33%，女性运动员参与人次占比25.67%；在历届冬季奥运会中，男性运动员参与人次占比71.83%，女性运动员参与人次占比28.17%；
在夏季奥运会中，除去几届特殊情况之外，男性运动员的增长在1996年达到顶峰，之后的夏季奥运会中，男性运动员数量有所下降；而女性运动员的数量一直稳步上升，特别是在1980年以后;
冬季奥运会中，不论是男性运动员还是女性运动员，数量都是稳步增长的，特别是在1980年以后;
25岁左右是运动员的黄金年龄。
从整体分布看，女性运动员的年龄整体略小于男性运动员。
随着奥运会的发展，运动员的平均身高和体重都有所增长；
我们纵观整个奥运历史，虽然男性运动员占比一直高于女性运动员，但是我们可以看到，随着奥运会的发展，女性运动员的占比一直在提升，到2016年为止，整体上已经快要和男性运动员占比持平了。而且，近几届奥运会中，已经有很多国家女性运动员的数量高于男性运动员。
运动员的平均身高和体重都增长的运动包括：游泳、篮球、拳击、赛艇、水球、皮划艇、击剑、摔跤；
运动员的平均体重增加、平均身高减小的运动包括：举重；
运动员的平均体重和的身高都减小的运动包括：帆船、曲棍球、射击、田径、体操；
运动员的平均身高增加、平均体重减小的运动包括：足球、自行车、马术。

3.奥运会的地理因素：

从1896年的零星几点，到1936年北美洲及西欧地区几乎点亮，到1976年除非洲外的大部地区几乎点亮，再到2016年全世界几乎已经点亮。可以看到，至2016年，奥运会已经真正成为了全球性的体育盛事。
除格陵兰岛因为主权归属问题之外，玻利维亚也是灰色地区。这里是数据统计不全，我去查了下，2016年里约奥运会玻利维亚是有代表队参赛的。
但是时至今日，仍然有少部分地区参与度不足，包括：非洲的大部分地区、饱受战乱困扰的中东地区、东南亚地区以及蒙古国等国家。

4.奥运会的奖牌：

美国是奥运史上奖牌总数最多的国家。因为缺席了很多次奥运，我国排名仅第15；
美国在田径、游泳等运动项目中优势最大,意大利在击剑等项目中获得的奖牌最多，澳大利亚在游泳、曲棍球等项目中获得的奖牌最多，中国在跳水、体操、兵乓球等项目中获得的奖牌最多。。。。。。
男性运动员获得绝大部分的奖牌的国家有：英国、法国、意大利、瑞典、匈牙利、挪威、芬兰、瑞士；
男性运动员获得较多的奖牌的国家有：德国、加拿大、澳大利亚、荷兰、日本；
男女运动员获得差不多数量的奖牌的国家有：俄国（俄罗斯）、韩国；
女性运动员获得奖牌略多的国家有：罗马尼亚；
女性运动员获得大多数奖牌的国家有：中国。

5.有趣的奥运历史：

在1912年到1948年间举办的奥运会，有5个非体育运动的项目，包括：建筑，雕刻，绘画，文学和音乐；
冬奥会至1994年开始就不和夏季奥运会在同年举办了；
第一次世界大战和第二次世界大战期间没有举办过奥运会；
1906年夏季奥林匹克运动会，于1906年4月22日至5月2日在希腊雅典举行，这次奥运会也称为1906年届间运动会。这次运动会是在第三届与第四届的国际奥林匹克运动会之间所举办的，故称“届间运动会”（Intercalated Games），由于没有冠上“国际奥林匹克运动会”的名称，因此比赛期间所颁发的奖牌，也没有被国际奥林匹克委员会所正式承认。
在整个奥运历史上，有5届奥运会参与国家和运动员数量的大幅下降，分别是：

纵观整个奥运史，年龄最小的运动员仅为10岁。在1896年第一届奥运会中，一名代表德国出战的叫“Dimitrios Loundras”的小男孩在男子体操双杠的项目中夺得了团体铜牌。
1928年阿姆斯特丹夏季奥运会中，一名97岁高龄的美国“运动员”，参加了雕刻的“运动项目”，但并未获得名次。这个记录应该是不会被打破了。
我国在奥运会获得的奖牌大部分是女性运动员贡献的。

————————————–感谢您的耐心阅读——————————————

奥林匹克运动会的发展过程与趋势

姚达

2019年6月27日

前言