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.
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"
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"
)
Finally, we use data.table to aggregate the total number
of medals awarded in each Olympic year and visualize this historical
trend.
medals_trend <- olympics_merged[!is.na(medal), .(Total_Medals = .N), by = year][order(year)]
ggplot(medals_trend, aes(x = year, y = Total_Medals)) +
geom_line(color = "red", size = 1) +
geom_point(color = "red", size = 2) +
theme_minimal() +
labs(
title = "Total Medals Awarded Over Time",
x = "Year",
y = "Total Medals"
)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.