Зростання хокеїстів: аналізуємо дані всіх чемпіонатів світу у поточному столітті


На днях завершився черговий чемпіонат світу з хокею.
За переглядом матчів народилася ідея. Коли в перервах телевізійна камера показує йдуть до роздягальні гравців, важко не помітити, наскільки вони величезні. На тлі тренерів, функціонерів команд, працівників льодової арени, журналістів, або просто фанатів вони, як правило, виглядають дуже переконливо.
Ось, приміром, висхідні зірки фінської хокею, Патрік Лайні і Олександр Барков, разом з відданими шанувальниками
Джерело
І я задався питаннями. Дійсно хокеїсти вище звичайних людей? Як змінюється зростання хокеїстів з часом в порівнянні зі звичайними людьми? Є стійкі міждержавні відмінності?
Дані
IIHF, організація, що проводить чемпіонати світу з хокею, щороку публікує склади команд з інформацією про зріст і вагу кожного гравця. Архів цих даних тут.
Я зібрав разом усіх чемпіонатів світу з 2001 по 2016 роки. Від року до року формат представлення даних злегка змінюється, що вимагає деяких зусиль по їх очищенню. Не представляючи, як грамотно автоматизувати процес, всі дані копіював вручну, що зайняло трохи більше 3 годин. Об'єднаний датасет виклав у відкритий доступ.
R code. Підготовка до роботи, завантаження даних
# load required packages
require(dplyr) # data manipulation
require(lubridate) # easy manipulations with dates
require(ggplot2) # visualization
require(ggthemes) # themes for ggplot2
require(cowplot) # noce alignment of the ggplots
require(RColorBrewer) # generate color palettes
require(texreg) # easy export of regression tables
require(xtable) # export a data frame into an html table

# download the IIHF data set; if there are some problems, you can download manually
# using the stable URL (https://dx.doi.org/10.6084/m9.figshare.3394735.v2)
df <- read.csv('https://ndownloader.figshare.com/files/5303173')

# color palette
brbg11 <- brewer.pal(11,'BrBG')

Ростуть хокеїсти? Грубе (періодна) порівняння
Для початку порівняємо середній зріст гравців на всіх 16 чемпіонатах світу.

R code. Малюнок 1. Зміна середнього зросту хокеїстів на чемпіонатах світу, 2001-2016 рр.
# mean height by championship
df_per <- df %>% group_by(year) %>%
summarise(height=mean(height))

gg_period_mean <- ggplot(df_per, aes(x=year,y=height))+
geom_point(size=3,color=brbg11[9])+
stat_smooth(method='lm',size=1,color=brbg11[11])+
ylab('height, cm')+
xlab('year of competition')+
scale_x_continuous(breaks=seq(2005,2015,5),labels=seq(2005,2015,5))+
theme_few(base_size = 15)+
theme(panel.grid=element_line(colour = 'grey75',size=.25))

gg_period_jitter <- ggplot(df, aes(x=year,y=height))+
geom_jitter(size=2,color=brbg11[9],alpha=.25,width = .75)+
stat_smooth(method='lm',size=1,se=F,color=brbg11[11])+
ylab('height, cm')+
xlab('year of competition')+
scale_x_continuous(breaks=seq(2005,2015,5),labels=seq(2005,2015,5))+
theme_few(base_size = 15)+
theme(panel.grid=element_line(colour = 'grey75',size=.25))

gg_period <- plot_grid(gg_period_mean,gg_period_jitter)

Позитивний тренд очевидний. За півтора десятиліття середній зріст хокеїста на чемпіонаті світу збільшився майже на 2 сантиметра (ліва панель). Начебто незначний приріст на тлі досить великої варіації (права панель). Багато це чи мало? Щоб відповісти на питання, треба коректно порівняти з населенням (але про це ближче до кінця статті).
Когортный аналіз
Більш коректний спосіб вивчення зміни в рості передбачає порівняння за когортам народження. Тут ми зустрічаємося з цікавим нюансом — деякі хокеїсти брали участь не в одному чемпіонаті світу. Питання: вичищати повторні записи для одних і тих же людей? Якщо нам цікавий середній зріст хокеїста на чемпіонаті (як на картинці вище), мабуть, не має сенсу зачищати. Але якщо ми хочемо простежити зміну зростання хокеїстів як таке, на мій погляд, було б неправильно привласнювати більшу вагу тим гравцям, які регулярніше потрапляли на чемпіонати світу. Тому для подальшого аналізу я очистив дані від повторних записів одних і тих же гравців.
R code. Підготовка даних до когортному аналізу
# remove double counts
dfu_h <- df %>% select(year,name,country,position,birth,cohort,height) %>%
spread(year,height)
dfu_h$av.height <- apply(dfu_h[,6:21],1,mean,na.rm=T)
dfu_h$times_participated <- apply(!is.na(dfu_h[,6:21]),1,sum)

dfu_w <- df %>% select(year,name,country,position,birth,cohort,weight) %>%
spread(year,weight)
dfu_w$av.weight <- apply(dfu_w[,6:21],1,mean,na.rm=T)

dfu <- left_join(dfu_h %>% select(name,country,position,birth,cohort,av.height,times_participated),
dfu_w %>% select(name,country,position,birth,cohort,av.weight),
by = c('name','country','position','birth','cohort')) %>%
mutate(bmi = av.weight/(av.height/100)^2)

Загальна кількість спостережень скоротилася з 6292 до 3333. Якщо хокеїст брав участь більш ніж в одному чемпіонаті світу, дані про зріст і вагу я усреднял, оскільки зростання і (особливо) вага окремо взятого хокеїста міг змінюватися з часом. Скільки ж разів хокеїсти удостоюються честі зіграти за національні збірні на чемпіонатах світу? В середньому трохи менше 2 разів.

R code. Малюнок 2. Гістограма розподілу хокеїстів за кількістю участей в ЧС
# frequencies of participation in world championships

mean(dfu$times_participated)

df_part <- as.data.frame(table(dfu$times_participated))

gg_times_part <- ggplot(df_part,aes(y=Freq,x=Var1))+
geom_bar(stat='identity',fill=brbg11[9])+
ylab('# of players')+
xlab('times participated (out of 16 possible)')+
theme_few(base_size = 15)

Але є і унікуми. Подивимося, хто з гравців взяв участь як мінімум в 10 чемпіонатах світу. Таких гравців виявилося 14.
R code. Таблиця 1. Лідери участі в чемпіонатах світу
# the leaders of participation in world championships
# save the table to html
leaders <- dfu %>% filter(times_participated > 9)
View(leaders)
print(xtable(leaders), type="html", file="table_leaders.html")

name country position birth cohort av.height times_participated av.weight bmi
1 ovechkin alexander RUS F 1985-09-17 1985 188.45 11 98.36 27.70
2 nielsen daniel DEN D 1980-10-31 1980 182.27 11 79.73 24.00
3 staal kim DEN F 1978-03-10 1978 182.00 10 87.80 26.51
4 green morten DEN F 1981-03-19 1981 183.00 12 85.83 25.63
5 masalskis edgars LAT G 1980-03-31 1980 176.00 12 79.17 25.56
6 ambuhl andres SUI F 1983-09-14 1983 176.80 10 83.70 26.78
7 granak dominik SVK D 1983-06-11 1983 182.00 10 79.50 24.00
8 madsen morten DEN F 1987-01-16 1987 189.82 11 86.00 23.87
9 redlihs mikelis LAT F 1984-07-01 1984 180.00 10 80.40 24.81
10 cipulis martins LAT F 1980-11-29 1980 180.70 10 82.10 25.14
11 holos jonas NOR D 1987-08-27 1987 180.18 11 91.36 28.14
12 bastiansen anders NOR F 1980-10-31 1980 190.00 11 93.64 25.94
13 ask morten NOR F 1980-05-14 1980 185.00 10 88.30 25.80
14 forsberg kristian NOR F 1986-05-05 1986 184.50 10 87.50 25.70
Олександр Овечкін, 11 разів! Але тут треба зазначити, що не для всіх хокеїстів в принципі можливо було взяти участь у всіх 16 чемпіонатах: залежить когорти народження (наскільки ігрова кар'єра перетнулася саме з цим періодом спостереження), від того, чи брала участь збірна гравця у всіх чемпіонатах світу (див. малюнок 3) і потрапляв гравець стабільно в збірну; нарешті, є ще НХЛ, стабільно відволікаючий кращих з кращих від участі в чемпіонатах світу.

R code. Малюнок 3. Участь збірних на чемпіонатах світу з хокею в 2001-2016 рр.
# countries times participated
df_cnt_part <- df %>% select(year,country,no) %>%
mutate(country=factor(paste(country))) %>%
group_by(country,year) %>%
summarise(value=sum(as.numeric(no))) %>%
mutate(value=1) %>%
ungroup() %>%
mutate(country=factor(country, levels = rev(levels(country))),
year=factor(year))

d_cnt_n <- df_cnt_part %>% group_by(country) %>%
summarise(n=sum(value))

gg_cnt_part <- ggplot(data = df_cnt_part, aes(x=year,y=country))+
geom_point(color=brbg11[11],size=7)+
geom_text(data=d_cnt_n,aes(y=country,x=17.5,label=n,color=n),size=7,fontface=2)+
geom_text(data=d_cnt_n,aes(y=country,x=18.5,label=' '),size=7)+
scale_color_gradientn(colours = brbg11[7:11])+
xlab(NULL)+
ylab(NULL)+
theme_bw(base_size = 25)+
theme(legend.position='none',
axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.5))

Ростуть хокеїсти? Регресійний аналіз
Регресійний аналіз дозволяє більш коректно відповісти на питання про зміну зростання гравців. В даному випадком з допомогою мультиноминальной лінійної регресії предсказыватся зростання хокеїста в залежність від когорти народження. Включаючи специфікацію регресиионной моделі різні додаткові (контрольні) змінні, ми отримуємо значення найбільш цікавить нас коефіцієнта "при інших рівних". Наприклад, додаючи до пояснює змінним крім когорти народження позицію гравця на поле, ми отримуємо взаємозв'язок зростання і когорти, очищену від ефекту відмінностей в залежності від позиції; додаючи в контрольны змінні країни, отримуємо результат, очищений від міждержавних відмінностей. Зрозуміло, якщо контрольні змінні самі виявляються значущими, на це теж варто звернути увагу.
Регресійні моделі (особливо лінійні регресії) дуже чутливі до аутлаерам (див., наприклад, статтю брата). Не вдаючись глибоко в цю велику тему, я лише прибрав з аналізу когорти, для яких ми маємо дуже невелика кількість представників.
R code. Прибираємо маленькі когорти
# remove small cohorts
table(dfu$cohort)
dfuc <- dfu %>% filter(cohort<1997,cohort>1963)

Не бажаючи різати дані сильно, я прибрав тільки когорти 1963, 1997 і 1998 років народження, для яких у нас є менше 10 гравців.
Отже, результати рагрессионного аналізу. У кожній наступній моделі я додаю одну змінну.
Залежна змінна: зростання хокеїста.
Пояснюють перемеенные: 1) когорта народження; 2) + позиція на полі (порівняння з захисниками); 3) + країна (порівняння з Росією).
R code. Таблиця 2. Результати регресійного аналізу
# relevel counrty variable to compare with Russia
dfuc$country <- relevel(dfuc$country,ref = 'UA')

# regression models
m1 <- lm(data = dfuc,av.height~cohort)
m2 <- lm(data = dfuc,av.height~cohort+position)
m3 <- lm(data = dfuc,av.height~cohort+position+country)

# export the models to html
htmlreg(list(m1,m2,m3),file = 'models_height.html'single.row = T)

Statistical models
Model 1 Model 2 Model 3
(Intercept) -10.17 (27.67) -18.64 (27.01) 32.59 (27.00)
cohort 0.10 (0.01)*** 0.10 (0.01)*** 0.08 (0.01)***
positionF -2.59 (0.20)*** -2.59 (0.20)***
positionG -1.96 (0.31)*** -1.93 (0.30)***
countryAUT -0.94 (0.55)
countryBLR -0.95 (0.53)
countryCAN 1.13 (0.46)*
countryCZE 0.56 (0.49)
countryDEN -0.10 (0.56)
countryFIN 0.20 (0.50)
countryFRA -2.19 (0.69)**
countryGER -0.61 (0.51)
countryHUN -0.61 (0.86)
countryITA -3.58 (0.61)***
countryJPN -5.24 (0.71)***
countryKAZ -1.16 (0.57)*
countryLAT -1.38 (0.55)*
countryNOR -1.61 (0.62)**
countryPOL 0.06 (1.12)
countrySLO -1.55 (0.58)**
countrySUI -1.80 (0.53)***
countrySVK 1.44 (0.50)**
countrySWE 1.18 (0.48)*
countryUKR -1.82 (0.59)**
countryUSA 0.54 (0.45)
R2 0.01 0.06 0.13
Adj. R2 0.01 0.06 0.12
Num. obs. 3319 3319 3319
RMSE 5.40 5.27 5.10
***p < 0.001, **p < 0.01, *p < 0.05

Інтерпретація моделей

Модель 1. Збільшення когорти на один рік відповідає збільшенню зростання хокеїстів на 0.1 див. Коефіцієнт статистично значущий, але при цьому модель пояснює лише 1% варіації залежної змінної. В принципі це не проблема, оскільки моделювання носить пояснюючий характер, завдання передбачення не ставиться. Тим не менш, низький коефіцієнт детермінації показує, що повинні бути інші змінні, набагато краще пояснюють відмінності між хокеїстами у зростанні.
Модель 2. Захисники — найвищі гравці в хокеї. Воротарі нижче на 2 см, нападники — на 2.6 див. Всі коефіцієнти статистично значущі. Объясненная варіація залежної змінної зростає до 6%. При цьому коефіцієнт при змінній когорта народження не змінюється.
Модель 3. Додавання контрольних змінних для країн цікаво з двох причин. По-перше, деякі відмінності статистично значущі і цікаві самі по собі. Так, наприклад, шведи, словаки і канадці статистично значимо вище наших гравців. Більшість націй значно нижче нас, японці аж на 5.2 см, італійці — на 3.6 см, французи — на 2.2 см (див. рисунок 4). По-друге, введення контрольних змінних для країн значно зменшує коефіцієнт при змінній когорта народження — до 0.08. Це означає, що міждержавні відмінності пояснюють частина відмінностей за когортам народження. Коефіцієнт детермінації моделі зростає до 13%.
R code. Малюнок 4. Зростання хокеїстів по країнам
# players' height by country
gg_av.h_country <- ggplot(dfuc ,aes(x=factor(cohort),y=av.height))+
geom_point(color='grey50',alpha=.25)+
stat_summary(aes(group=country),geom='line',fun.y = mean,size=.5,color='grey50')+
stat_smooth(aes(group=country,color=country),geom='line',size=1)+
#geom_hline(yintercept = mean(height),color='red',size=.5)+
facet_wrap(~country,ncol=4)+
coord_cartesian(ylim = c(170,195))+
scale_x_discrete(labels=paste(seq(1965,1995,10)),breaks=paste(seq(1965,1995,10)))+
theme_few(base_size = 15)+
theme(legend.position='none',
panel.grid=element_line(colour = 'grey75',size=.25))

Найбільш повна модель показує, що збільшення зростання хокеїстів відбувається зі швидкістю 0.08 см в рік. Це означає приріст 0.8 см за десятиліття або на 2.56 см за 32 роки з 1964 по 1996. Зверніть увагу, що при обліку контрольних змінних швидкість збільшення зростання хокеїстів виявляється приблизно у півтора рази нижче, ніж при більш грубому аналізі середніх значень (малюнок 1): 0.8 см за десятиліття проти приблизно 1.2 див.
Перш ніж ми, нарешті, постараємося зрозуміти, наскільки значним виявляється збільшення зростання, хочу звернути увагу ще на один цікавий момент. Введення контрольних змінних передбачає фіксацію відмінностей між категоріями при єдиному нахилі регресійної лінії (єдиний коефіцієнт при головній пояснювальної змінної). Це не завжди добре і може замаскувати значні відмінності в тісноті зв'язку між досліджуваними змінними в підвибірках. Так, наприклад, роздільне моделювання залежності зростання гравців від амплуа (малюнок 5) показує, що взаємозв'язок найбільш яскраво виражена для воротарів і найменш помітна для захисників.

R code. Малюнок 5. Кореляція між ростом і когортою роздільно для захисників, форвардів та воротарів
dfuc_pos <- dfuc
levels(dfuc_pos$position) <- c('Defenders','Forwards','Goalkeeprs')

gg_pos <- ggplot(dfuc_pos ,aes(x=cohort,y=av.height))+
geom_jitter(aes(color=position),alpha=.5)+
stat_smooth(method = 'lm', se = T,color=brbg11[11],size=1)+
scale_x_continuous(labels=seq(1965,1995,5),breaks=seq(1965,1995,5))+
scale_color_manual(values = brbg11[c(8,4,10)])+
facet_wrap(~position,ncol=3)+
xlab('birth cohort')+
ylab('height, cm')+
theme_few(base_size = 20)+
theme(legend.position='none',
panel.grid=element_line(colour = 'grey75',size=.25))

R code. Таблиця 3. Модель 3 роздільно для підвибірок захисників, форвардів та воротарів
# separate models for positions
m3d <- lm(data = dfuc %>% filter(position=='D'),av.height~cohort+country)
m3f <- lm(data = dfuc %>% filter(position=='F'),av.height~cohort+country)
m3g <- lm(data = dfuc %>% filter(position=='G'),av.height~cohort+country)
htmlreg(list(m3d,m3f,m3g),file = '2016/160500 Hockey players/models_height_pos.html'single.row = T,
custom.model.names = c('Model 3 D','Model 3 F','Model 3 G'))

Statistical models
Model 3 D Model 3 F Model 3 G
(Intercept) 108.45 (46.46)* 49.32 (36.73) -295.76 (74.61)***
cohort 0.04 (0.02) 0.07 (0.02)*** 0.24 (0.04)***
countryAUT 0.14 (0.96) -2.01 (0.75)** 0.47 (1.47)
countryBLR 0.30 (0.87) -1.53 (0.73)* -2.73 (1.55)
countryCAN 1.55 (0.78)* 0.39 (0.62) 3.45 (1.26)**
countryCZE 0.87 (0.84) 0.30 (0.67) 0.63 (1.36)
countryDEN -0.60 (0.95) 0.10 (0.75) -0.19 (1.62)
countryFIN -0.55 (0.89) -0.04 (0.67) 2.40 (1.32)
countryFRA -3.34 (1.15)** -2.06 (0.93)* 1.39 (2.07)
countryGER 0.48 (0.85) -1.40 (0.72) -0.65 (1.33)
countryHUN -1.32 (1.47) -0.70 (1.16) 0.65 (2.39)
countryITA -2.08 (1.08) -4.78 (0.82)*** -2.02 (1.62)
countryJPN -4.13 (1.26)** -6.52 (0.94)*** -2.27 (1.98)
countryKAZ -1.23 (0.95) -1.82 (0.79)* 1.79 (1.58)
countryLAT -0.73 (0.95) -1.39 (0.75) -3.42 (1.49)*
countryNOR -3.25 (1.07)** -1.06 (0.85) -0.10 (1.66)
countryPOL 0.82 (1.89) -0.58 (1.55) 0.37 (2.97)
countrySLO -1.57 (0.99) -1.54 (0.79) -2.25 (1.66)
countrySUI -1.98 (0.91)* -2.36 (0.71)*** 1.12 (1.47)
countrySVK 2.94 (0.87)*** 0.81 (0.67) -0.70 (1.50)
countrySWE 0.75 (0.81) 1.24 (0.65) 1.37 (1.33)
countryUKR -1.37 (1.01) -1.77 (0.80)* -3.71 (1.66)*
countryUSA 0.76 (0.78) -0.08 (0.62) 2.58 (1.26)*
R2 0.09 0.10 0.24
Adj. R2 0.07 0.09 0.20
Num. obs. 1094 1824 401
RMSE 5.08 5.08 4.87
***p < 0.001, **p < 0.01, *p < 0.05
Роздільне моделювання показує, що в когорти 1964-1996 років народження, середній зріст хокеїстів, які брали участь у чемпіонатах світу в 2001-2016 роках, збільшувався зі швидкістю 0.4 см за десятиления для захисників, 0.7 см — для нападників і (!) 2.4 см — для воротарів. За три десятиления середній зріст воротарів збільшився на 7 см!
Настав час порівняти ці зміни з середніми значеннями для населення.
Порівняння з населенням
Результати регресійного аналізу фіксують значні міждержавні відмінності. Тому має сенс порівнювати за країнами: хокеїстів певної країни з чоловічим населенням цієї країни.
Для порівняння зростання хокеїстів з середніми показниками чоловічого населення я використовував дані з релевантної наукової статті PDF). Дані я скопіював з статті (використавши чудову програмку tabula) і теж розмістив у відкритому доступі.
R code. Завантаження даних Hatton, T. J., & Bray, B. E. (2010) і підготовка до аналізу
# download the data from Hatton, T. J., & Bray, B. E. (2010). 
# Long run trends in the heights of European men, 19th–20th centuries. 
# Economics & Human Biology, 8(3), 405-413. 
# http://doi.org/10.1016/j.ehb.2010.03.001
# stable URL, copied data (https://dx.doi.org/10.6084/m9.figshare.3394795.v1)
df_hb <- read.csv('https://ndownloader.figshare.com/files/5303878')

df_hb <- df_hb %>%
gather('country','h_pop',2:16) %>%
mutate(period=paste(period)) %>%
separate(period,c('t1','t2'),sep = '/')%>%
transmute(cohort=(as.numeric(t1)+as.numeric(t2))/2,country,h_pop)

# calculate hockey players' cohort height averages country for each
df_hoc <- dfu %>% group_by(country,cohort) %>%
summarise(h_hp=mean(av.height)) %>%
ungroup()

На жаль, дані про динаміку зростання населення перетинаються лише з 8 країнами з мого хокейного датасета: Австрія, Данія, Фінляндія, Франція, Німеччина, Італія, Норвегія, Швеція.
R code. Пересічні дані
# countries in both data sets
both_cnt <- levels(factor(df_hb$country))[which(levels(factor(df_hb$country)) %in% levels(df_hoc$country))]
both_cnt


R code. Малюнок 6. Порівняння динаміки збільшення зросту чоловічого населення і хокеїстів
gg_hoc_vs_pop <- ggplot()+
geom_path(data = df_hb %>% filter(country %in% both_cnt), aes(x=cohort,y=h_pop),
color=brbg11[9],size=1)+
geom_point(data = df_hb %>% filter(country %in% both_cnt), aes(x=cohort,y=h_pop),
color=brbg11[9],size=2)+
geom_point(data = df_hb %>% filter(country %in% both_cnt), aes(x=cohort,y=h_pop),
color='white',size=1.5)+
geom_point(data = df_hoc %>% filter(country %in% both_cnt), aes(x=cohort,y=h_hp),
color=brbg11[3],size=2,pch=18)+
stat_smooth(data = df_hoc %>% filter(country %in% both_cnt), aes(x=cohort,y=h_hp),
method='lm',se=F,color=brbg11[1],size=1)+
facet_wrap(~country,ncol=2)+
ylab('height, cm')+
xlab('birth cohort')+
theme_few(base_size = 15)+
theme(panel.grid=element_line(colour = 'grey75',size=.25))

У всіх проанализировнных країнах хокеїсти вище стеднестатистических чоловіків на 2-5 див. Але це не дивно — у спорті значна селекція.
Примітно інше. У розвинених країнах світу особливо бурхливе збільшення зросту чоловічого населення відбувалося в першій середині 20 століття. До когорти приблизно 1960-х років народження зріст чоловіків наблизився до плато і пеерстал бурхливо збільшуватися. Тренд середнього зросту хокеїстів у всіх країнах (крім чомусь Данії) ніби продовжив призупинені багаторічний тренд всього чоловічого населення.
Для когорт європейців, народжених у першій половині 20 століття, темпи збільшення середнього зросту варіювалися від 1.18 до 1.74 см за десятиления в залежності від країни (малюнок 7). Починаючи з 1960-х років цей показник опустився до рівня 0.15-0.80 за 10 років.

R code. Малюнок 7. Середня динаміка зростання чоловічого населення
# growth in population

df_hb_w <- df_hb %>% spread(cohort,h_pop) 
names(df_hb_w)[2:26] <- paste('y',names(df_hb_w)[2:26])

diffs <- df_hb_w[,3:26]-df_hb_w[,2:25]

df_hb_gr<- df_hb_w %>%
transmute(country,
gr_1961_1980 = unname(apply(diffs[,22:24],1,mean,na.rm=T))*2,
gr_1901_1960 = unname(apply(diffs[,9:21],1,mean,na.rm=T))*2,
gr_1856_1900 = unname(apply(diffs[,1:8],1,mean,na.rm=T))*2) %>%
gather('period','average_growth',2:4) %>%
filter(country %in% both_cnt) %>%
mutate(country=factor(country,levels = rev(levels(factor(country)))),
period=factor(period,labels = c('1856-1900','1901-1960','1961-1980')))

gg_hb_growth <- ggplot(df_hb_gr, aes(x=average_growth,y=country))+
geom_point(aes(color=period),size=3)+
scale_color_manual(values = brbg11[c(8,3,10)])+
scale_x_continuous(limits=c(0,2))+
facet_wrap(~period)+
theme_few()+
xlab("average growth in men's height over 10 years, cm")+
ylab(NULL)+
theme_few(base_size = 20)+
theme(legend.position='none',
panel.grid=element_line(colour = 'grey75',size=.25))

На тлі стагнуючого тренда в населенні збільшення зростання хокеїстів виглядає досить значним. А акселерація серед воротарів взагалі безпрецедентна.
Не варто забувати і про селекцію. Розбіжність трендів у населення і серед хокеїстів, ймовірно, свідчить про посилення селекції — хокей вимагає все більшого зростання для успішної кар'єри.
Селекція в спорті
Проглядаючись наукову літературу по темі я натрапив на примітний результат. Виявляється, у професійному спорті переважають люди, народжені в першій половині року. Пояснюється це тим, що спортивні секції, як правило, формують дитячі команди з когортам народження. Таким чином, народжені на початку року, завжди мають трохи більше прожитого часу за плечима, що часто прямо виражається у фізичній перевазі над однолітками, народженими під кінець року. Неважко перевірити цей результат на нашому датасете.

R code. Малюнок 8. Розподіл хокеїстів за місяцями народження
# check if there are more players born in earlier months
df_month <- df %>% mutate(month=month(birth)) %>%
mutate(month=factor(month,levels = rev(levels(factor(month)))))

gg_month <- ggplot(df_month,aes(x=factor(month)))+
geom_bar(stat='count',fill=brbg11[8])+
scale_x_discrete(breaks=1:12,labels=month.name)+
xlab('month of birth')+
coord_flip()+
theme_few(base_size = 20)+
theme(legend.position='none',
panel.grid=element_line(colour = 'grey75',size=.25))

Справді, респределение досить сильно зміщена в бік ранніх місяців. Якщо розбити дані по декадах народження, то неозброєним оком видно, що ефект посилюється з часом (малюнок 9). Побічно це свідчить про те, що селекція в хокеї стає жорсткішим.

R code. Малюнок 9. Розподіл хокеїстів за місяцями народження, роздільно по декадах народження
# facet by decades
df_month_dec <- df_month %>%
mutate(dec=factor(substr(paste(cohort),3,3),labels = paste('born in',c('1960s','1970s','1980s','1990s'))))

gg_month_dec <- ggplot(df_month_dec,aes(x=factor(month)))+
geom_bar(stat='count',fill=brbg11[8])+
scale_x_discrete(breaks=1:12,labels=month.abb)+
xlab('month of birth')+
facet_wrap(~dec,ncol=2,scales = 'free')+
theme_few(base_size = 20)+
theme(legend.position='none',
panel.grid=element_line(colour = 'grey75',size=.25))

На майбутнє
Цікаво буде подивитися, чи впливають фізичні дані на ігрову статистику хокеїстів. Натрапив на цікаву статтю, опубліковану в дуже пристойному науковому журналі, в якій автори знайшли кореляцію між співвідношенням пропорцій обличчя хокеїста і середньою кількістю штрафних хвилин за гру.
Графік з зазначеної статті [джерело](http://rspb.royalsocietypublishing.org/content/275/1651/2651)
Reproducibility
Повний R скрипт, що відтворює результати моєї статті, тут.
Використана версія R-3.2.4
Всі пакети станом на 2016-03-14. У разі пакетних несумісностей, даний код буде гарантовано відтворено при використанні пакету checkpoint з зазначенням відповідної дати.
Джерело: Хабрахабр

0 коментарів

Тільки зареєстровані та авторизовані користувачі можуть залишати коментарі.