Olympische spelen

Olympische Data Spelen

Inleiding

In deze blogpost wordt een analyse op data van de Olympische spelen van 1960 t/m 2016 uitgevoerd. We zullen kijken naar het aantal gewonnen medailles, de verdeling van BMI-waardes van sporters en het sentiment van mensen over de olympische spelen op Twitter. Zie hieronder de bron van onze data analyse.

Data Bron
120 years of Olympic history: athletes and results https://www.kaggle.com/heesoo37/120-years-of-olympic-history-athletes-and-results

Het beste sportland uit de geschiedenis van de Olympische spelen

Als je opzoek gaat naar het best presterende land op de olympische spelen door de jaren heen, kan je op internet een hoop vinden. De medaillespiegels van alle olympische spelen zijn slechts één zoekopdracht op Google van je verwijderd. Al snel zal je dan kunnen concluderen dat de Verenigde Staten bijna altijd winnen op de zomerspelen, terwijl Noorwegen of Rusland altijd bovenaan meedoen in de winterspelen. Echter kan je jezelf de vraag stellen of dit allemaal wel zo eerlijk is. Rusland en de Verenigde Staten hebben namelijk vele malen meer inwoners dan bijvoorbeeld Nederland of Nieuw Zeeland. De kans dat daar een goede sporter tussen zit is dus aanzienlijk groter. In dit hoofdstuk wordt de medaillespiegel eens van een andere kant bekeken. Daarvoor zijn de volgende vragen opgesteld:

  • Wat is de medaillespiegel aller tijden kijkend naar het aantal inwoners van een land?
  • Wat is het verschil tussen deze medaillespiegel en de conventionele medaillespiegel?

Data verzamelen

Om tot de antwoorden op de vragen van dit hoofdstuk te komen, is er verschillende data nodig. De belangrijkste elementen zijn: behaalde medailles, land/team, inwonersaantallen, jaartallen en zomer/winterspelen. De meeste elementen zijn al te vinden in de grote olympische spelen dataset die wordt gebruikt in deze blog. Deze dataset bevat echter geen inwonersaantallen per land. De dataset met inwonersaantallen per land is de vinden in het package wbstats, de statistieken van de world bank. De volgende code laadt deze data in:

data_population <- wb(indicator = "SP.POP.TOTL", startdate = 1900, enddate = 2160)

Het wbstats package bevat inwonersaantallen per land vanaf 1960. De medaille analyse wordt dus gedaan over alle spelen die van 1960 tot 2016 hebben plaatsgevonden.

Data cleaning

Er is echter één groot probleem wat opgelost moet worden voordat deze dataset te koppelen is aan de olympische dataset: landen en teams zijn in de afgelopen 60 jaar wel eens veranderd. Bijvoorbeeld: Duitsland is lang verdeeld geweest in Oost- en West-Duitsland en Rusland behoorde vroeger tot de Sovjet Unie. De world bank heeft dit allemaal strak getrokken, dus worden de namen die we nu voor landen gebruiken daar ook gebruikt. De inwonersaantallen van Oost- en West-Duitsland zijn dus opgeteld om een aantal voor Duitsland te krijgen. Om dit op een goede manier in de Olympische dataset te krijgen worden de medailles ook op die manier opgeteld. Hoewel dit politiek misschien gevoelig ligt, is het in dit geval de beste oplossing. Door via een regex te joinen, zijn alle verschillen tussen de datasets gevonden en daarna opgelost.

Hierdoor is het mogelijk om de datasets te joinen en worden alle inwonersaantallen aan de olympische dataset toegevoegd. Daardoor staan alle benodigde elementen bij elkaar in één grote dataset.

############### population cleaning
pop_clean <- data_population %>%
# Voor de duidelijkheid krijgen sommige kolommen een andere naam.
  rename(year = date,
         code = iso3c,
         population = value) %>%
# Alleen de benodigde kolommen worden geselecteerd en in de goede volgorde gezet. 
  select(country, year, population, code)

############### Het vinden van onregelmatigheden in de codes en namen van landen
#------- ONDERSTAAND HOEF JE NIET PER SE TE RUNNEN -------#
### Het doel van dit stukje code is om de verschillen in de naamgeving van landen te vinden. 
test_pop <- data_population %>%
# Omdat het alleen om de naamgeving gaat, hebben we elke naam maar één keer nodig.
# Dus wordt er gegroepeerd en samengevat. 
  group_by(country) %>%
  summarise(pop = mean(value),
            code = first(iso3c))

# Vervolgens wordt de populatiedata met de NOC data gekoppeld om de verschillen te zien.
# Dit gebeurd met een regex join. Een regex join kan dingen die ongeveer hetzelfde zijn toch joinen. 
noc_pop_data <- regex_right_join(test_pop, data_noc, by = c(country = "region"))
# Nog niet alles is gejoined. Dus er wordt gefilterd op NAs en dat stukje van het dataframe wordt klaargemaakt voor een volgende join. 
noc_pop_na <- noc_pop_data %>%
  filter(is.na(pop)) %>%
  select(NOC, region, notes)

# Het NA deel van de vorige join wordt hier op landcode gejoined om nog meer successen te krijgen. 
noc_pop_code_join <- left_join(noc_pop_na, test_pop, by = c(NOC = "code"))
# De gejoinede data wordt hieronder data wordt hieronder klaargemaakt om aan de regex join vast te plakken.
noc_pop_data <- noc_pop_data %>%
  filter(is.na(pop) == FALSE) %>%
  select(-code)

# Hieronder wordt de op regex gejoinede en de op code gejoinede data aan elkaar vastgeplakt. 
noc_pop_data <- rbind(noc_pop_data, noc_pop_code_join)
# De verschillen in de landnamen zijn nog moeilijk te zien, daarom worden wat hulpmiddels gemaakt. 
noc_pop_data <- noc_pop_data %>%
  select(NOC, region, country, pop, notes) %>%
  arrange(region) %>%
  group_by(region) %>%
# De data is hierboven gegroepeerd per regio (landnaam uit olympische dataset) en de volgende kolom telt hoe vaak een land voorkomt.
# Zodra dit getal groter dan 1 is, is er blijkbaar een verschil in de notatie van een land(code) in de datasets.
  mutate(count = 1:n()) %>%
  ungroup() %>%
# Hieronder wordt nog een extra kolom aangemaakt die aangeeft of landnamen hetzelfde zijn of niet. 
  mutate(region_country = region == country)

############### Replacement Vectors 
# Alle verschillen in landnamen zijn door het vorige stukje code duidelijk geworden. 
# Hieronder zijn drie vectoren aangemaakt die in een str_replace_all functie gebruikt kunnen worden. 
# Zodra die functie gebruikt wordt, worden alle waarden veranderd in de 'goede' naam. 
country_replacement <- c("Hong Kong SAR, China" = "Hong Kong",
                         "Macao SAR, China" = "China",
                         "Antigua and Barbuda" = "Antigua",
                         "Bahamas, The" = "Bahamas",
                         "Brunei Darussalam" = "Brunei",
                         "Cabo Verde" = "Cape Verde",
                         "Congo, Dem. Rep." = "Democratic Republic of the Congo",
                         "Egypt, Arab Rep." = "Egypt",
                         "Gambia, The" = "Gambia",
                         "Iran, Islamic Rep." = "Iran",
                         "Cote d'Ivoire" = "Ivory Coast",
                         "Kyrgyz Republic" = "Kyrgyzstan",
                         "Lao PDR" = "Laos",
                         "North Macedonia" = "Macedonia",
                         "Micronesia, Fed. Sts." = "Micronesia",
                         "Korea, Dem. People’s Rep." = "North Korea",
                         "Russian Federation" = "Russia",
                         "St. Lucia" = "Saint Lucia",
                         "Slovak Republic" = "Slovakia",
                         "Korea, Rep." = "South Korea",
                         "Eswatini" = "Swaziland",
                         "Syrian Arab Republic" = "Syria",
                         "Taiwan" = "China",
                         "Venezuela, RB" = "Venezuela",
                         "Yemen, Rep." = "Yemen"
                         )
noc_replacement <- c("ANZ" = "AUS",
                     "NFL" = "CAN",
                     "BOH" = "CZE",
                     "TCH" = "CZE",
                     "FRG" = "GER",
                     "GDR" = "GER",
                     "SAA" = "GER",
                     "CRT" = "GRE", 
                     "MAL" = "MAS",
                     "NBO" = "MAS",
                     "EUN" = "RUS",
                     "URS" = "RUS",
                     "SCG" = "SRB",
                     "YUG" = "SRB",
                     "UAR" = "SYR",
                     "TPE" = "CHN",
                     "WIF" = "TTO",
                     "VNM" = "VIE",
                     "YAR" = "YEM",
                     "YMD" = "YEM",
                     "RHO" = "ZIM"
                     )
region_replacement <- c("Boliva" = "Bolivia",
                        "Trinidad" = "Trinidad and Tobago",
                        "UK" = "United Kingdom",
                        "USA" = "United States")

############### Verder Cleanen 
pop_clean <- pop_clean %>%
# De landnamen uit de populatie dataset die niet overeenkomen met die uit de NOC dataset worden hier aangepast. 
  mutate(country = str_replace_all(country, country_replacement)) %>%
# Vervolgens wordt de data klaargemaakt om te kunnen joinen met NOC data. 
  group_by(country, year) %>%
  summarise(population = sum(population)) %>%
  ungroup() %>%
  mutate(Year = as.numeric(year)) %>%
  select(country, Year, population)

noc_clean <- data_noc %>%
# De landcodes en namen die niet overeenkomen met de populatie dataset worden hier aangepast. 
  mutate(NOC = str_replace_all(NOC, noc_replacement),
         region = str_replace_all(region, region_replacement)) %>%
  mutate(country = ifelse(NOC == "HKG", "Hong Kong", region)) %>%
# De data wordt vervolgens klaargemaakt om te kunnen joinen met populatie data.
  select(-notes, -region) %>%
  unique()

atleten_clean <- atleten_clean %>%
# Er waren ook nog wat foutieve codes in de olympische dataset, die worden hier aangepast.
  mutate(NOC = str_replace_all(NOC, noc_replacement)) %>%
# De olympische dataset loopt van 1896-2016 en de populatie van 1960-2016.
# De olympische dataset wordt dus gefilterd aangezien we aan de oudere data weinig hebben in deze analyse. 
  filter(Year >= 1960)

############### Joinen alle data
# De populatie data wordt hier aan de NOC data gekoppeld, waardoor we per deelnemend team het inwonersaantal hebben per jaar. 
noc_pop_clean <- left_join(noc_clean, pop_clean, by = "country")

# De populatie en NOC data wordt gejoined met de olympische data, waardoor we per Spelen per land het inwonersaantal hebben. 
country_performance_data <- left_join(atleten_clean, noc_pop_clean, by = c("NOC", "Year"))

Visualisaties

Het idee is om de medaille spiegels in een bar plot weer te geven. Hiervoor moet de data gegroepeerd worden. Om de medailles een weging te geven (goud is beter dan zilver of brons), krijgt een gouden medaille het cijfer 3, een zilveren 2 en een bronzen 1. Door te groeperen worden alle medailles per land en seizoen opgeteld, waardoor elk land een totale score heeft voor de zomer- en winterspelen. Van de inwonersaantallen wordt een gemiddelde over de jaren heen genomen. Om het aantal behaalde medailles per inwonersaantal te verkrijgen worden eerst alle inwonersaantallen door 1 miljoen gedeeld. Vervolgens wordt de medaillescore gedeeld door dat laatste inwonersaantal. Zo krijgen we een gewogen aantal behaalde medailles per miljoen inwoners van een land.

Hiermee worden vier plots gemaakt:

  • Top 30 medaillespiegel zomerspelen (absoluut).
  • Top 30 medaillespiegel winterspelen (absoluut).
  • Top 30 medaillespiegel zomerspelen (per miljoen inwoners).
  • Top 30 medaillespiegel winterspelen (per miljoen inwoners).

Aan de laatste twee plots worden per land tussen haakjes ook nog de absolute waarden weergegeven om het in perspectief te kunnen stellen. Dit resulteert in de volgende beelden:

############### Data visualisatie 
# Voor de visualisatie zijn nog een aantal aanpassingen nodig. 
con_perf_ana <- country_performance_data %>%
# Hier wordt een kolom aangemaakt met het aantal inwoners per land * 1 miljoen. 
  mutate(pop_x_mil = (population / 1000000)) %>%
  select(country, Year, Season, Medal, pop_x_mil) %>%
  arrange(country, Year) %>%
# Om alle medailles op te kunnen tellen worden ze omgezet in getallen. 
# De medailles krijgen wel allemaal een weging. 
  mutate(Medal = ifelse(is.na(Medal), 0,
                        ifelse(Medal == "Gold", 3,
                               ifelse(Medal == "Silver", 2, 1)))) %>%
# Om de data fatsoenlijk te kunnen visualiseren wordt de data gegroepeerd per land en seizoen (winter of zomerspelen).
  group_by(country, Season) %>%
# Het aantal medailles wordt bij elkaar opgeteld en er wordt een gemiddeld aantal inwoners genomen over die 1960-2016.
  summarise(Medals = sum(Medal),
            avg_pop_x_mil = mean(pop_x_mil)) %>%
  ungroup() %>%
# Het aantal medailles per seizoen wordt uit elkaar getrokken om een zomer en winter kolom te maken. 
  pivot_wider(names_from = Season, values_from = Medals) %>%
# De vorige actie zorgt ervoor dat elk land er dubbel in staat (winter en zomer).
# Hieronder wordt dat probleem op de lossen door het aantal medailles op te sommen. 
# Er is namelijk een winter en zomer kolom. Zodra er in winter iets staat is zomer 0. Dus kunnen die rijen per land worden opgeteld.
  mutate(Summer = ifelse(is.na(Summer), 0, Summer),
         Winter = ifelse(is.na(Winter), 0, Winter)) %>%
  group_by(country) %>%
  summarise(avg_pop_x_mil = mean(avg_pop_x_mil),
            Summer = sum(Summer),
            Winter = sum(Winter))

# Hier wordt de performance van een land in de zomer gemaakt. 
con_perf_sum <- con_perf_ana %>%
  select(-Winter) %>%
  filter(is.na(country) == FALSE) %>%
# De volgende kolom berekend het aantal behaalde medailles per miljoen inwoners van een land. 
  mutate(med_per_mil = round(Summer / avg_pop_x_mil,0)) %>%
  arrange(desc(Summer))

# Hier wordt de performance van een land in de winter gemaakt.
con_perf_win <- con_perf_ana %>%
  select(-Summer) %>%
  filter(is.na(country) == FALSE) %>%
# De volgende kolom berekend het aantal behaalde medailles per miljoen inwoners van een land. 
  mutate(med_per_mil = round(Winter / avg_pop_x_mil,0)) %>%
  arrange(desc(Winter))

# De volgende ggplot geeft de top 30 landen weer op basis van het totaal aantal behaalde medailles op de zomerspelen. 
total_sum <- ggplot(head(con_perf_sum, n = 30), 
                 aes(x = reorder(country, Summer), 
                     y = Summer)) +
  coord_flip() +
  geom_bar(stat = "identity", fill = "#20B2AA") +
  labs(title = "Totaal aantal gewonnen medailles per land van 1960-2016 \n in de Olympische zomerspelen (top 30)",
       y = "Aantal gewonnen medailles",
       x = "Land") +
  geom_text(aes(label = Summer),
            color = "black",
            position = position_stack(vjust = 0.5),
            size = 2,
            fontface = 2)

# De volgende ggplot geeft de top 30 landen weer op basis van het totaal aantal behaalde medailles op de winterspelen.     
total_win <- ggplot(head(con_perf_win, n = 30), 
                 aes(x = reorder(country, Winter), 
                     y = Winter)) +
  coord_flip() +
  geom_bar(stat = "identity", fill = "#20B2AA") +
  labs(title = "Totaal aantal gewonnen medailles per land van 1960-2016 \n in de Olympische winterspelen (top 30)",
       y = "Aantal gewonnen medailles",
       x = "Land",
       fill = "Landen") +
  geom_text(aes(label = Winter),
            color = "black",
            position = position_stack(vjust = 0.5),
            size = 2,
            fontface = 2)

# De winter en zomer (win/sum) datasets worden opnieuw op volgorde gezet. Ditmaal op basis van aantal medailles per miljoen inwoners. 
con_perf_sum_mil <- con_perf_sum %>%
  arrange(desc(med_per_mil))
con_perf_win_mil <- con_perf_win %>%
  arrange(desc(med_per_mil))

# De volgende ggplot geeft de top 30 landen weer op basis van het totaal aantal behaalde medailles per miljoen inwoners op de zomerspelen. 
# Aan de x as (na coordflip() de y as) wordt tussen haakjes het absolute aantal medailles weergegeven als perspectief. Dit wordt met de paste functie gedaan.
avg_sum <- ggplot(head(con_perf_sum_mil, n =30),
                  aes(x = reorder(paste(country, " (",Summer,")", sep = ""), med_per_mil),
                      y = med_per_mil)) +
  coord_flip() +
  geom_bar(stat = "identity", fill = "#20B2AA") +
  labs(title = "Totaal aantal gewonnen medailles per miljoen inwoners per land \n van 1960-2016 in de Olympische zomerspelen (top 30)",
       y = "Aantal gewonnen medailles",
       x = "Land",
       fill = "Landen") +
  geom_text(aes(label = med_per_mil),
            color = "black",
            position = position_stack(vjust = 0.5),
            size = 2,
            fontface = 2)

# De volgende ggplot geeft de top 30 landen weer op basis van het totaal aantal behaalde medailles per miljoen inwoners op de winterspelen. 
# Aan de x as (na coordflip() de y as) wordt tussen haakjes het absolute aantal medailles weergegeven als perspectief. Dit wordt met de paste functie gedaan. 
avg_win <- ggplot(head(con_perf_win_mil, n =30),
                  aes(x = reorder(paste(country," (",Winter,")", sep = ""), med_per_mil),
                      y = med_per_mil)) +
  coord_flip() +
  geom_bar(stat = "identity", fill ="#20B2AA") +
  labs(title = "Totaal aantal gewonnen medailles per miljoen inwoners per land \n van 1960-2016 in de Olympische winterspelen (top 30)",
       y = "Aantal gewonnen medailles",
       x = "Land",
       fill = "Landen") +
  geom_text(aes(label = med_per_mil),
            color = "black",
            position = position_stack(vjust = 0.5),
            size = 2,
            fontface = 2)

# Alle vier ggplots worden tegenover elkaar gezet om de resultaten te kunnen analyseren. 
# grid.arrange(total_sum, avg_sum, total_win, avg_win, ncol = 2)
total_sum

avg_sum

total_win

avg_win

Er is een duidelijk verschil te zien in de manier waarop de best presterende landen worden weergegeven. Als we alles gewoon optellen zijn het inderdaad de grote landen die bovenaan staan (linkerzijde). Als we kijken naar het aantal behaalde medailles per miljoen inwoners zien we iets heel anders. Bovenaan staan de Bahamas (zomer) en Liechtenstein (winter). Deze landen schieten uit omdat het piepkleine staten zijn die toevallig toch een aantal medailles hebben gewonnen door de jaren heen. Als we echt naar het verschil kijken, zien we dat de Verenigde Staten in de zomer van plek 1 naar plek 25 zijn gezakt. Rusland is in de winter van plek 1 naar plek 13 gezakt. Opvallend is verder dat de top 5 (per miljoen inwoners) over het algemeen hele andere landen bevat dan de top 5 absoluut. Als we het zo bekijken zijn Hongarije en Nieuw Zeeland (zomer) en de Scandinavische landen (winter) dus eigenlijk veel betere sportlanden dan de Verenigde Staten, Duitsland en Rusland. Verder lijken de resultaten in de zomerspelen ook iets meer verdeeld. Waar je in de absolute telling nog drie uitschieters hebt in de Verenigde Staten, Rusland en Duitsland, ligt het in de aantallen per miljoen veel dichter bij elkaar.

Conclusie

Tot slot nog een antwoord op de vragen. De eerste vraag die we ons stelden was:

Wat is de medaillespiegel aller tijden kijkend naar het aantal inwoners van een land?

Deze medaillespiegel laat zien dat geografisch gezien kleine landen toch relatief goed presteren op zowel de olympische zomer- als winterspelen. Je zou hieruit kunnen concluderen dat in Hongarije, Nieuw Zeeland, Australië, Ijsland, de Bahamas en de Scandinavische landen de meeste topsporters per miljoen inwoners hebben. Aangezien deze landen de meeste medailles per miljoen inwoners scoren op de Olympische Spelen.

De tweede vraag was: Wat is het verschil tussen deze medaillespiegel en de conventionele medaillespiegel?

Als je de medaillespiegels die op verschillende manieren zijn gemaakt naast elkaar legt zie je duidelijk dat de landen die we altijd bovenaan zien staan helemaal niet zo goed zijn als ze denken. Deze landen hebben gewoon meer inwoners dan de rest, waardoor zij met meer mensen naar de Spelen kunnen gaan en zo een grotere kans op winst hebben. Vooral de Verenigde Staten en Rusland zakken heel wat plaatsen af in de ranglijst. Als we willen kijken naar het beste sportland uit de geschiedenis van de Spelen, zullen we dus niet alleen naar het aantal behaalde medailles moeten kijken.

De invloed van BMI op de sportresultaten

  • Zijn er grote verschillen in BMI van atleten in verschillende olympische sporten?
  • Zit er verschil in gemiddelde BMI en leeftijd van atleten die medailles wel of niet hebben gewonnen?

Het algemeen beeld van een atleet is een afgetraind mens met een strak lijf. Een manier om het afgetrainde lijf uit te drukken in een cijfer is de Body Mass Index (BMI). Deze BMI wordt berekend door de volgende formule: BMI = gewicht (kg) / lengte² (m). Een gezond gewicht wordt gedefinieerd door een BMI waarde tussen de 18,5 en 25. Het is logisch dat de BMI van een worstelaar of judoka hoger ligt dan een gymnast.

Data cleaning

Om het BMI te kunnen berekenen zijn dus de lengte en het gewicht van een persoon nodig. De olympische dataset bevat kolommen die deze gegevens beschrijven. Echter, deze kolommen zijn maar voor 80% gevuld. Om ook de gegevens van de overige 20% te krijgen is een model gemaakt. Dit model gaat uit van een normale verdeling aangezien de lengte en het gewicht van mensen natuurlijk verdeeld is. Het model voorspelt op basis van leeftijd, geslacht en sport de lengte en het gewicht van een persoon. De sport is hierin belangrijk aangezien een basketballer gemiddeld langer is dan een voetballer. Ook is een sumo worstelaar gemiddeld zwaarder dan een gymnast. Door het model alles te laten voorspellen, is ook de overige 20% van de kolommen gevuld.

############### Atleten Cleaning
atleten_clean <- data_atleten %>%
  mutate(weight_fill = na.approx(Weight)) %>%
  mutate(test = 1) %>%
  group_by(Sport) %>%
  filter(sum(is.na(Weight)) != sum(test)) %>%
  select(-test) %>%
  ungroup()

model_weight <- glm(Weight ~ Sex + Age + Sport, data = atleten_clean, family = "gaussian") 
pred_weight <- predict(model_weight, newdata = atleten_clean)

model_height <- glm(Height ~ Sex + Age + Sport, data = atleten_clean, family = "gaussian")
pred_height <- predict(model_height, newdata = atleten_clean)

atleten_clean <- atleten_clean %>%
  mutate(weight_glm = ifelse(is.na(Weight), pred_weight, Weight),
         height_glm = ifelse(is.na(Height), pred_height, Height)) %>%
  mutate(weight_fill = round(weight_fill, 1),
         weight_glm = round(weight_glm, 1),
         height_fill = round(na.approx(Height),0),
         height_glm = round(height_glm, 0)) %>%
  select(ID:Age, height_glm, weight_glm, Team:Medal)

Visualisaties

Maar hoe liggen de verschillen per olympische sport? Onderstaande visualisaties geven weer hoe de BMI van atleten is verdeeld in een boxplot per sport. De eerste visualisatie geeft de sporten op de zomerspelen weer, de tweede de sporten van de winterspelen.

bmi_atleten_summer <- atleten_clean %>% 
                      mutate(Bmi = weight_glm / ((height_glm / 100) * (height_glm / 100))) %>% 
                      filter(Season == "Summer")

plot3 <- ggplot(bmi_atleten_summer, aes(x = Sport, y = Bmi, fill = Sport)) +
         geom_boxplot() +
         coord_flip() +
         theme(legend.position = "none")+
         ggtitle(label = "Samenvatting van BMI van atleten per sport")
plot3

In de figuur springen een aantal dingen er echt uit. Het eerste is dat de mediaan (Het streepje in de box) voor bijna alle sporten tussen de 20 en 25 ligt. De sporten waar de BMI het laagst ligt is bij de ritmische gymnasten en de synchroonzwemmers. De box ligt hier onder een BMI van 20. De sporten met de hoogste BMI zijn vooral judo, worstelen en gewichtheffen. Dit is volkomen logisch omdat deze atleten gebaat zijn bij een hoger gewicht om deze in de strijd te kunnen gooien. Verder zijn er een paar sporten die aan de hoge kant van de BMI zitten een beetje opmerkelijk. Baseball is daar een voorbeeld van. Blijkbaar heb je geen afgetraind lijf te hebben om uit te blinken in baseball. IJshockey (voor het eerste op de zomerspelen van 1920) en lacrosse zitten ook aan de hoge kant van BMI spectrum. Ook opmerkelijk te noemen zijn de puntjes die te zien zijn in de visualisatie. Deze puntjes geven de uitschieters weer. Voor gewichtheffen worstelen en judo is het logisch dat er hoge uitschieters zijn vanwege de zwaargewichtklasses. Bij atletiek is dit ook te verklaren door een aantal onderdelen zoals kogelstoten en discuswerpen, omdat deze atleten een hoger gewicht hebben dan bijvoorbeeld hardlopers en verspringers. Het meest opmerkelijke zijn de puntjes boven een BMI van 40. Bij tafeltennis is hier een uitschieter van, maar ook bij zeilen en roeien zitten er uitschieters bij. Wat zeer opmerkelijk is, want hoe zwaarder je bent hoe meer kracht er nodig is om vooruit te komen in het water.

bmi_atleten_winter <- atleten_clean %>% 
                      mutate(Bmi = weight_glm / ((height_glm / 100) * (height_glm / 100))) %>% 
                      filter(Season == "Winter")

plot4 <- ggplot(bmi_atleten_winter, aes(x = Sport, y = Bmi, fill = Sport)) +
               geom_boxplot() +
               coord_flip() +
               theme(legend.position = "none") +
               ggtitle(label = "Samenvatting van BMI van atleten per sport")
plot4