Introduction

For my final project, I have chosen the Olympics dataset from the TidyTuesday project. This dataset contains information about athletes and their corresponding National Olympic Committees (NOC). My goal is to merge the athlete data with the region data to analyze the performance of different regions and explore insights through visualizations.

Data Loading and Merging

In this section, I load the required libraries, import the datasets, and merge them using the noc (National Olympic Committee) column.

options(timeout = 300)

library(data.table)
## 
## Attaching package: 'data.table'
## The following object is masked from 'package:base':
## 
##     %notin%
library(ggplot2)

olympics <- fread("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-07-27/olympics.csv") 
noc_regions <- fread("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-07-27/regions.csv")


setDT(olympics)
setDT(noc_regions)

olympics_merged <- merge(olympics, noc_regions, by.x = "noc", by.y = "NOC", all.x = TRUE)

str(olympics_merged)
## Classes 'data.table' and 'data.frame':   271116 obs. of  17 variables:
##  $ noc   : chr  "AFG" "AFG" "AFG" "AFG" ...
##  $ id    : int  502 1076 1101 1745 4628 5285 5582 5678 5679 5841 ...
##  $ name  : chr  "Ahmad Shah Abouwi" "Jammal-ud-Din Affendi" "Mohammad Anwar Afzal" "Mohammad Aktar" ...
##  $ sex   : chr  "M" "M" "M" "M" ...
##  $ age   : int  NA 28 NA 17 22 NA 17 NA NA 22 ...
##  $ height: int  NA NA NA 156 NA NA NA NA NA NA ...
##  $ weight: num  NA NA NA 48 NA 52 NA NA NA NA ...
##  $ team  : chr  "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
##  $ games : chr  "1956 Summer" "1936 Summer" "1948 Summer" "1980 Summer" ...
##  $ year  : int  1956 1936 1948 1980 1964 1972 1936 1948 1948 1936 ...
##  $ season: chr  "Summer" "Summer" "Summer" "Summer" ...
##  $ city  : chr  "Melbourne" "Berlin" "London" "Moskva" ...
##  $ sport : chr  "Hockey" "Hockey" "Football" "Wrestling" ...
##  $ event : chr  "Hockey Men's Hockey" "Hockey Men's Hockey" "Football Men's Football" "Wrestling Men's Light-Flyweight, Freestyle" ...
##  $ medal : chr  NA NA NA NA ...
##  $ region: chr  "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
##  $ notes : chr  "" "" "" "" ...
##  - attr(*, ".internal.selfref")=<pointer: 0x105f68040> 
##  - attr(*, "sorted")= chr "noc"

Data Filtering and Aggregation

In this section, we filter the dataset to focus on the 2016 Summer Olympics and aggregate the data to calculate the total number of medals won by each region. We then visualize the top 10 regions using ggplot2.

medals_2016 <- olympics_merged[year == 2016 & season == "Summer" & !is.na(medal)]

top_regions <- medals_2016[, .(Total_Medals = .N), by = region]

top_10_regions <- top_regions[order(-Total_Medals)][1:10]

print(top_10_regions)
##        region Total_Medals
##        <char>        <int>
##  1:       USA          264
##  2:   Germany          159
##  3:        UK          145
##  4:    Russia          115
##  5:     China          113
##  6:    France           96
##  7: Australia           82
##  8:     Italy           72
##  9:    Canada           69
## 10:     Japan           64
ggplot(top_10_regions, aes(x = reorder(region, Total_Medals), y = Total_Medals, fill = region)) +
  geom_col() +                                               
  geom_text(aes(label = Total_Medals), hjust = -0.2) +       
  coord_flip() +                                             
  scale_fill_brewer(palette = "Set3") +                      
  theme_bw() +                                               
  labs(                                                      
    title = "Top 10 Regions by Total Medals in 2016 Summer Olympics",
    x = "Region",
    y = "Total Number of Medals"
  ) +
  theme(legend.position = "none")                            

## Athlete Demographics: Age, Height, and Weight

In this section, we will explore the physical characteristics of the athletes, such as their age, height, and weight, using various ggplot2 geometries including histograms, boxplots, scatter plots, and density plots.

olympics_clean <- olympics_merged[!is.na(age) & !is.na(height) & !is.na(weight)]

ggplot(olympics_clean, aes(x = age)) +
  geom_histogram(binwidth = 2, fill = "skyblue", color = "black") +
  theme_minimal() +                                           
  labs(                                                      
    title = "Distribution of Athlete Ages",
    x = "Age (Years)",
    y = "Frequency"
  )

ggplot(olympics_clean, aes(x = sex, y = age, fill = sex)) +
  geom_boxplot() +
  scale_fill_brewer(palette = "Set2") +                       
  theme_light() +
  labs(
    title = "Age Distribution by Sex",
    x = "Sex",
    y = "Age (Years)"
  )

ggplot(olympics_clean, aes(x = height, y = weight)) +
  geom_point(alpha = 0.1, color = "darkgreen") +              
  theme_classic() +
  labs(
    title = "Height vs Weight of Olympic Athletes",
    x = "Height (cm)",
    y = "Weight (kg)"
  )

athletes_2016 <- olympics_clean[year == 2016]
ggplot(athletes_2016, aes(x = height, y = weight, color = sex)) +
  geom_point(alpha = 0.3) +                                   
  geom_smooth(method = "lm", color = "black") +               
  scale_color_brewer(palette = "Dark2") +
  theme_bw() +
  labs(
    title = "Height vs Weight in 2016 Olympics (with Trend Line)",
    x = "Height (cm)",
    y = "Weight (kg)"
  )
## `geom_smooth()` using formula = 'y ~ x'

ggplot(olympics_clean, aes(x = height, fill = sex)) +
  geom_density(alpha = 0.5) +
  scale_fill_brewer(palette = "Accent") +
  theme_minimal() +
  labs(
    title = "Density of Athlete Heights by Sex",
    x = "Height (cm)",
    y = "Density"
  )