Статьи
Зростання хокеїстів: аналізуємо дані всіх чемпіонатів світу в поточному столітті
- дані
- Чи ростуть хокеїсти? Грубе (періодне) порівняння
- когортний аналіз
- Чи ростуть хокеїсти? регресійний аналіз
- інтерпретація моделей
- Порівняння з населенням
- Селекція в спорті
- На майбутнє
- Reproducibility
Днями завершився черговий чемпіонат світу з хокею.
За переглядом матчів народилася ідея. Коли в перервах телевізійна камера показує йдуть до роздягальні гравців, важко не помітити, наскільки вони величезні. На тлі тренерів, функціонерів команд, співробітників льодової арени, журналістів або просто фанатів вони, як правило, виглядають дуже переконливо.
Ось, наприклад, висхідні зірки фінського хокею, Патрік Лайне і Олександр Барков, разом з відданими шанувальниками
І я задався питаннями. Чи справді хокеїсти вище звичайних людей? Як змінюється зростання хокеїстів з часом в порівнянні зі звичайними людьми? Чи є стійкі міждержавні розходження?
дані
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) # nice 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 <тисячі дев'ятсот дев'яносто сім, 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 = 'RUS') # 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, TJ, & Bray, BE (2010) і підготовка до аналізу # download the data from Hatton, TJ, & Bray, BE (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 for each country 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))
На майбутнє
Цікаво буде подивитися, чи впливають фізичні дані на ігрову статистику хокеїстів. Натрапив на цікаву статтю, опубліковану в дуже пристойному науковому журналі, в якій автори знайшли кореляцію між співвідношенням пропорцій особи хокеїста і середньою кількістю штрафних хвилин за гру.
Графік з зазначеної статті
Reproducibility
Повний R скрипт, який відтворює результати моєї статті, тут .
Використана версія R-3.2.4
Всі пакети станом на 2016-03-14. У разі пакетних несовместимостей, даний код буде гарантовано відтворено при використанні пакета checkpoint із зазначенням відповідної дати.
Як змінюється зростання хокеїстів з часом в порівнянні зі звичайними людьми?
Чи є стійкі міждержавні розходження?
Багато це чи мало?
Питання: вичищати повторні записи для одних і тих же людей?
Скільки ж разів хокеїсти удостоюються честі зіграти за національні збірні на чемпіонатах світу?