ultramarathons_eda.Rmd

---
title: "Exploring ultramarathon dataset"
output: md_document
#output: html_notebook
---

```{r, echo=FALSE}
knitr::opts_chunk$set(echo = TRUE,
                      warning = FALSE,
                      message = FALSE)

options(dplyr.summarise.inform = FALSE)
```

## 1. Introduction

This dataset allows us to have a great look at the changes that have happened in ultramarathon racing and shows how both participation and the number of events have grown exponentially since the 1950's.

### 1.1 Load and check data

```{r dependencies, message = FALSE}
library(data.table)
library(dplyr)
library(magrittr)
library(ggplot2)
library(gridExtra)
library(scales)
library(stringr)
library(tidyr)
library(lubridate)
```

```{r, message=FALSE}
data <- fread('./data/TWO_CENTURIES_OF_UM_RACES.csv', sep = ',', header = TRUE)
#data <- fread('/kaggle/input/the-big-dataset-of-ultra-marathon-running/TWO_CENTURIES_OF_UM_RACES.csv', sep = ',', header = TRUE)
summary(data)
```

We can see that the dataset has events from 1798 to 2022 and there may be a few inaccuracies with the dataset, for example it's unlikely that anyone was born in 1193 would have run an ultramarathon since 1798. Most of the other fields are in character type, and so a bit of feature engineering will be required to make these fields a bit easier to analyse. We'll replace the spaces in the column names with underscores to make analysis slightly easier.

```{r, message=FALSE}
names(data) <- gsub(" ", "_", names(data))

(sapply(data, function(x) round(mean(is.na(x) | x == '')*100,2))) %>% 
  as.data.frame(.) %>% 
  setNames("Percent_Missing") %>%
  arrange(desc(Percent_Missing))
```

A glance at the missing entries shows 38% missing Athlete_club, along with 8% missing age related fields. Athlete_club isn't too important for my intial data exploratory analysis and so can be excluded.

```{r}
data %>%
  group_by(Year_of_event) %>%
  summarise(missing = sum(is.na(Athlete_year_of_birth)| Athlete_year_of_birth == ""),
            perc_missing = mean(is.na(Athlete_year_of_birth) | Athlete_year_of_birth == "")) %>%
  arrange(desc(missing))
```

The participants with missing year of birth/age category doesn't appear to be concentrated in a particular event or year. The count of these is the highest in the most recent years, but with a low overall percentage of missing fields due to higher overall participation numbers. Something to consider when analysing age or participants.

### 1.2 Data cleaning

Next we'll clean up some of the fields. There are also almost 1,800 entries that have Country = 'XXX' and Athlete_ID = 4033, with different genders and age categories, which need to be taken into consideration when analysing individual athlete results. The race results for these athletes appear to be correct though, so we'll leave them in the dataset.

```{r}
filter(data, Athlete_country =='XXX') %>% count(Athlete_country, Athlete_ID)
```

I'm only going to be considering single stage events, so I'll be removing events such as Marathon des Sables (MAR). These can be identified as they contain "/" in the Event_distance/length field, for example "249km/6Etappen".

```{r}
data %>%
    summarise(multievent_perc = mean(grepl('/', `Event_distance/length`)))
```

These entries account for 1.2% of all entries in the dataset, indicating that most people are running single stage events.

We'll also extract the location of the race from the Event_name, which is contained in the final set of brackets in the Event_name field. For example "Ultra Maratón des las Altas Montanas (UMAM) 80 Kms (MEX)" is in MEX.

```{r}
data_clean <- data %>%
  filter(!`Event_distance/length` %like% '/') %>% #filter out stage races
  mutate(race_location = str_extract(Event_name, "\\(([^()]*)\\)(?![^()]*\\()"), 
         race_location = str_replace_all(race_location, "[()]", "")) #location of race from event name
```

The length of an ultramarathons is either set in distance (eg 100km) or time (eg 24h), and the Event_distance/length contains both of these types, so we'll flag these seperately and convert all distance length races into km from miles.

```{r}
data_clean %<>%
          mutate(race_distance = as.numeric(str_extract(`Event_distance/length`, "[0-9.]+")), #distance or time of event
         race_unit = tolower(str_extract(`Event_distance/length`, "[a-zA-Z]+")), 
         race_distance = as.numeric(race_distance),
         race_type = if_else(race_unit %in% c('h', 'd'), 'time', 'distance'), #split out distance races from timed
         race_unit = if_else(race_type == 'time', race_unit, 
                        if_else(str_starts(race_unit, 'k'), 'km',
                        if_else(str_starts(race_unit, 'm'), 'm', 'other'))),
         distance_km = if_else(race_unit == 'km', race_distance, if_else(race_unit == 'm', race_distance*1.62, NA))) #convert miles into km
```

Although the dataset includes an Athlete_age_category field, these aren't standard across events, with German races using the DLV categories with the rest of the world using IAAF. This can be seen below with the categories "M20" and "M30" appearing in German races not not in the rest of the world. So we'll add a column for the athlete's age and calculate categories separately.

```{r}
data_clean %<>%
         mutate(athlete_age = as.numeric(Year_of_event) - as.numeric(Athlete_year_of_birth))

data_clean %>%
  mutate(location = if_else(race_location == 'GER', 'GER','RoW')) %>%
  count(location, Athlete_age_category) %>%
  pivot_wider(names_from = location, values_from = n) 
```

We'll convert the Athlete_performance column into a more usable format, splitting out the times athlete's have completed distance based events into a 'duration' formatted field, and the distance travelled for time based events.

```{r, warning=FALSE}
data_clean %<>%
  mutate( #standardise athlete performance values
         numeric_string = str_extract(Athlete_performance, "\\d+[:d.]+\\d+[:.]*\\d*"),
         athlete_units = str_extract(Athlete_performance, "[a-zA-Z ]+"),
         days = if_else(str_detect(Athlete_performance, "d"), 
                        as.numeric(str_extract(Athlete_performance, "\\d+(?=d)")), 
                        0),
         time = if_else(str_detect(Athlete_performance, ":"), 
                        as.duration(hms(str_extract(Athlete_performance, "(?<=d |^)\\d+:\\d+:\\d+"))), 
                        as.duration(0)),
         athlete_duration = as.duration(days(days)) + time,
         athlete_distance = case_when(
           str_detect(athlete_units, "km") ~ as.numeric(str_replace(numeric_string, "km", "")),
           TRUE ~ NA_real_
         ),
         days = NULL,
         time = NULL,
         numeric_string = NULL
  ) 

summary(data_clean)
```

Now the data is correctly formatted, a glimpse at the fields shows there are some potential issues. For example there are a number of entries when the time recorded is 0, also the youngest person is -30 years old and there is someone who is apparently born in 1193. There are also races which have 0 indicated as the number of finishers, which clearly can't be the case if there are finishers in the dataset. The Athlete_average_speed field also doesn't appear to be consistent with the maximum being 28,302 and median 7.3. 

Calculating the speed ourselves using the duration or distance the athlete has taken against the race distance shows a number that have run quicker than world record road marathon pace, which is likely to be incorrect. Digging into a few of these results suggests occasions when an athletes performance has been submitted into the incorrect race, for example if there is a 25k race along side a 50k race and the result of a 25k participant being placed under 50k. Similar to [a paper investigating trends in 100-mile races](https://doi.org/10.1038/s41598-023-28398-2), I'll exclude results that are quicker than 20k/h which are likely to be incorrect, along with those of duration 0. There are 298 such results.

There are also a few instances when the incorrect distance is recorded, for example for 'Pigtails Challenge 100 Km (USA)' being listed as 100 miles, leading to some abnormally quick times. There are likely to be other races with incorrect distances labelled, but this one stood out due to having the only record of someone running 100 miles in under 10 hours.

```{r}
data_clean %<>%
  mutate(race_unit = if_else(Event_name == 'Pigtails Challenge 100 Km (USA)', 'km', race_unit),
         distance_km = if_else(Event_name == 'Pigtails Challenge 100 Km (USA)', 100, distance_km)) %>%
  mutate(speed = if_else(race_type == 'distance', distance_km/(as.numeric(athlete_duration) / (60 * 60)),
                         athlete_distance / (race_distance * if_else(race_unit == 'd', 24, 1)))) %>%
  filter(speed < 20) 
```

Finally let's drop the columns we no longer require and take a look at what the new dataset looks like.

```{r}
data_clean %<>%
  dplyr::select(-c(Event_dates, `Event_distance/length`, Athlete_club, Athlete_performance))

head(data_clean)
```

## 2. Data exploration

### 2.1 Events

As we mentioned at the top, the dataset incudes results from 1798 to 2022 and includes races greater than 45km in length (or a performance of greater than 45km for a time based event) and doesn't include participants who did not finish the race. The dataset also includes a unique identifier for each participant, and so their performance can be tracked over multiple events.

We split the races into time based and distance based events, and we can see below how the number of both events and participants running ultramarathons has increased dramatically in recent years, asides from a recent reduction caused by pandemic related cancellations.

```{r}
data_clean %>%
  group_by(Year_of_event, race_type) %>%
  distinct(Event_name, race_type) %>% 
  count(Year_of_event, race_type) %>%
  ggplot(aes(x = Year_of_event, y = n, colour = race_type)) +
  theme_minimal() +
  geom_point() +
  scale_y_continuous(labels = comma) +
  ggtitle('Number of events per year') -> events.p

data_clean %>%
  count(Year_of_event, race_type) %>%
  ggplot(aes(x = Year_of_event, y = n, colour = race_type)) +
  theme_minimal() +
  geom_point() +
  scale_y_continuous(labels = comma) +
  ggtitle('Number of participants per year') -> athletes.p

grid.arrange(events.p, athletes.p, ncol = 1)
```

The plots above also show fairly clearly that distance based events are considerably more popular than time based; with below showing that 50km, 100km & 50 miles are the most common race distances, followed 6, 24 & 12 hour races.

```{r}
data_clean %>%
  distinct(Year_of_event, Event_name, race_distance, race_unit, race_type) %>%
  mutate(race_distance = paste0(race_distance, " ", race_unit)) %>%
  count(race_distance) %>%
  arrange(desc(n)) %>%
  head(n = 10)
```

The average number of participants is also greater for distance based events than time based. The average participants for distance events peaked in the 1970s and has been trending down since, as new smaller races are being created. The peak for the number of athletes for time based events in comparison is only in the past 10 years, indicating that new timed events aren't being created as regularly than distance events in proportion to the increased demand in ultra running.

Significantly more individual athletes are also to be running multiple ultramarathons per year compared to 50 years ago. Although this appears to be trending back downwards in recent years for timed events, the trend is still upwards for distance based events. However there was a spike in the dataset for events during the late 1800's, which are largely due to a combination of a small sample set and athletes competing in multiple [6 day events](https://en.wikipedia.org/wiki/6_Day_Race), which also include splits every 24 hours.

```{r}
data_clean %>%
  count(Year_of_event, race_type, Athlete_ID) %>% 
  group_by(Year_of_event, race_type) %>%
  summarise(average_races = mean(n)) %>%
  ggplot(aes(x = Year_of_event, y = average_races, colour = race_type)) +
  theme_minimal() +
  geom_point() +
  scale_y_continuous(labels = comma) +
  ggtitle('Average number of races per athlete') -> avgrace.p

data_clean %>%
  distinct(Year_of_event, race_type, Event_name, Event_number_of_finishers) %>% 
  group_by(Year_of_event, race_type) %>%
  summarise(average_athletes = mean(Event_number_of_finishers)) %>%
  ggplot(aes(x = Year_of_event, y = average_athletes, colour = race_type)) +
  theme_minimal() +
  geom_point() +
  scale_y_continuous(labels = comma) +
  ggtitle('Average number of athletes per race') -> avgathlete.p

grid.arrange(avgathlete.p, avgrace.p, ncol = 1)
```

A look at the individual events shows that Comrades Marathon (RSA) is the oldest ultramarathon that is still being run today, with the first Down Run being in 1921 and there being 47 Down Runs and 48 Up Runs since and each seeing over 220k finishers.

```{r}
data_clean %>%
  dplyr::select(Year_of_event, Event_name) %>%
  group_by(Event_name) %>%
  summarise(first_event = min(Year_of_event),
            last_event = max(Year_of_event),
            event_count = length(unique(paste0(Year_of_event,Event_name))),
            athlete_count = n()) %>%
  filter(last_event >= 2019) %>% 
  arrange(first_event) %>%
  head(n = 20)
```

Comrades also dominates for number of participants, along with Two Oceans Marathon (also in South Africa), seeing 20,027 finishers in 2000. The highest placed non-South African race was the La SaintéLyon 72 km (FRA) in 2017 which had 5,787 finishers.

```{r}
data_clean %>%
  distinct(Year_of_event, Event_name, Event_number_of_finishers) %>%
  arrange(desc(Event_number_of_finishers)) %>%
  head(n = 10)
```

Although two South African races dominiate in terms of number of runners every year, the USA hosts by far the largest number of events, both in terms of overall events in the dataset as well as the number of different events. There have been over 6,000 different events held in the USA, compared to just 267 in South Africa. France has the second highest number of races.

```{r}
data_clean %>%
  distinct(Year_of_event, Event_name, race_location, Event_number_of_finishers) %>%
  group_by(race_location) %>%
  summarise(first_event = min(Year_of_event),
            different_events = length(unique(Event_name)),
            total_events = n(),
            total_finishers = sum(Event_number_of_finishers)) %>%
  arrange(desc(total_finishers)) %>%
  head(n = 10)
```

We can see that there appears to have been a big uptick in participation since 1950, which is clarified by taking a look at a chart of the log of the number of events, so further analysis will be taken from 1950 onwards.

```{r}
data_clean %>%
    group_by(Year_of_event, race_type) %>%
    distinct(Event_name, race_type) %>% 
    count(Year_of_event, race_type) %>%
    ggplot(aes(x = Year_of_event, y = log(n), colour = race_type)) +
    theme_minimal() +
    geom_point() +
    scale_y_continuous(labels = comma) +
    ggtitle('Log of number of events per year') 
```

```{r}
data_clean_1950 <- data_clean %>% filter(Year_of_event >= 1950)
```

### 2.2 Athletes

The 7.4m race results have been obtained by 1.7m athletes, with the potential data issues mentioned in part 1.1 being negligible. USA make up the majority of both number of athletes and total finishers, followed by France and Japan. The average South African runner has completed 6.6 races, the highest amongst the major nations, driven by repeated completions of Comrades and Two Oceans.

```{r}
data_clean_1950 %>%
  group_by(Athlete_country) %>%
  summarise(athlete_count = length(unique(Athlete_ID)),
            total_finishers = n()) %>%
  add_row(Athlete_country = 'Total', 
          athlete_count = sum(.$athlete_count),
          total_finishers = sum(.$total_finishers)) %>%
  mutate(avg_races = total_finishers/athlete_count) %>%
  arrange(desc(athlete_count)) %>%
  head(n = 10)
```

After removing Athlete_ID 4033, Athlete 236 appears to have run the most number of ultramarathons in the world, totaling 801.

```{r}
data_clean_1950 %>%
  filter(Athlete_ID != 4033) %>%
  group_by(Athlete_ID) %>%
  summarise(race_count = n()) %>%
  arrange(desc(race_count)) %>%
  head(n = 10)
```

This runner completed their first ultramarathon in 2006 but has significantly increased his volume in the past few years, completing 118 in 2022, with almost all of the races taking place in TPE. The overwhelming majority of these races are under 50km, with 45km being the most frequent distance completed which is the shortest distance required to be recorded on the dataset.

```{r}
data_clean_1950 %>%
  filter(Athlete_ID == 236) %>%
  count(Year_of_event, race_location) %>%
  arrange(desc(Year_of_event))

data_clean_1950 %>%
  filter(Athlete_ID == 236) %>%
  mutate(race_distance = paste0(race_distance, race_unit)) %>%
  count(race_distance) %>%
  arrange(desc(n)) %>%
  head(n = 10)
```
The fastest times for the most popular race distances saw a steady decline between the 1960's to 1908's as the popularity grew, and has seen a more gradual decline since. The two fastest times for 100 miles were in 2022 and 2021 by Aleksandr Sorokin, as well as the fastest 50km times being run in 2022. The 50m and 100km both saw their quickest times set in the 1990's

```{r}
data_clean_1950 %>%
  mutate(race_distance = paste0(race_distance, race_unit)) %>%
  filter(race_distance %in% c('50km','100km','50m','100m')) %>%
  group_by(Year_of_event, race_distance) %>%
  summarise(quickest_time = as.duration(min(athlete_duration)),
            average_time = mean(athlete_duration)) %>% 
  ggplot(aes(x = Year_of_event, y = quickest_time/(60*60), colour = race_distance)) +
  geom_line() +
  theme_minimal() +
  ylab('time (h)') +
  ggtitle('fastest time') -> fast.time.p
  
plot(fast.time.p)
```

Although the fastest times have generally been trending quicker, the average times have been increasing since the 1980's for 50km, 50m and 100m races, and increasing since the 1990's for 100km. This is likely to be due to the increased participation rates; as a large range of people are setting themselves the challenge of completing an ultramarathon rather than just those who are setting out to win. It may also be due more people attempting increasingly challenging ultramarathons in terms of elevation and other conditions.

```{r}
data_clean_1950 %>%
  mutate(race_distance = paste0(race_distance, race_unit)) %>%
  filter(race_distance %in% c('50km','100km','50m','100m')) %>%
  group_by(Year_of_event, race_distance) %>%
  summarise(quickest_time = as.duration(min(athlete_duration)),
            average_time = mean(athlete_duration)) %>% 
  ggplot(aes(x = Year_of_event, y = average_time/(60*60), colour = race_distance)) +
  geom_line() +
  theme_minimal() +
  ylab('time (h)') +
  ggtitle('average time') -> avg.time.p

plot(avg.time.p)
```

### 2.3 Gender

Anyone who's been on the start line of a running race (ultramarathon or not) would be aware that the overwhelming majority of runners tend to be male. This is also apparent in this dataset with a little under 81% of runners identifying as male, 19% female with a negligible number of the entries being either 'other' or blank.

```{r}
data_clean_1950 %>%
  count(Athlete_gender) %>%
  mutate(proportion = percent(n/nrow(data_clean_1950), accuracy = 0.01))
```

The good news is though that the trend is that this gap is decreasing, with the last few years seeing 23% of finishers being female globally. The chart below shows that there was a gradual increase in female runners during the 1960's & 70's, a bigger increase during the 80's and 90's with the trend slowing down since. 

```{r}
data_clean_1950 %>%
  filter(Athlete_gender %in% c('M','F')) %>%
  count(Year_of_event, Athlete_gender) %>%
  group_by(Year_of_event) %>%
  mutate(percent = n/sum(n)) %>%
  ggplot(aes(x = Year_of_event, y = percent, fill = Athlete_gender)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'year', y = 'percentage', fill = 'gender') +
  ggtitle('Gender divide') +
  scale_y_continuous(labels = percent)
```

We can use the segmented package to split the regressions for each of these different regime changes. This suggests breaks of 1986 and 1998

```{r}
# Dataframe for percentage of female runners per year
female_perc <- data_clean_1950 %>%
  filter(Athlete_gender %in% c('M','F')) %>%
  count(Year_of_event, Athlete_gender) %>%
  group_by(Year_of_event) %>%
  mutate(percent = n/sum(n)) %>% 
  filter(Athlete_gender == 'F')

# segment the linear model
lin.mod <- lm(percent ~ Year_of_event, data = female_perc)
seg.mod <- segmented::segmented(lin.mod, seg.Z = ~Year_of_event, psi = c(1980, 2000))

# Show the summary of the segmented model
summary(seg.mod)
```

```{r}
newdata <- data.frame(Year_of_event = seq(min(female_perc$Year_of_event), max(female_perc$Year_of_event), length.out = 100))

# Generate predictions
newdata$pred <- predict(seg.mod, newdata = newdata)

# Plot the data and the regression line
ggplot(female_perc, aes(x = Year_of_event, y = percent)) +
  geom_point() +  # plot the data points
  geom_line(data = newdata, aes(y = pred), colour = 'red') +  # plot the regression line
  theme_minimal() +
  ggtitle('Segmented linear regression of female participation')
```
Although it's good news that the percentage of females is increasing, the bad news is that it doesn't look like it'll get close to 50% any time soon based on current trends; as the chart below shows, extending the predicted changes until 2100.

```{r}
# Extend dataframe with future years
future_years <- data.frame(Year_of_event = seq(max(female_perc$Year_of_event) + 1, max(female_perc$Year_of_event) + 80))

# Predict proportions for future years
future_years$percent <- predict(seg.mod, newdata = future_years, type = "response")
future_years$source <- 'predicted'

# Combine past data with future predictions
data_clean %>%
  filter(Year_of_event >= 1950,
         Athlete_gender %in% c('M','F')) %>%
  count(Year_of_event, Athlete_gender) %>%
  group_by(Year_of_event) %>%
  mutate(percent = n/sum(n)) %>% 
  filter(Athlete_gender == 'F') %>%
  mutate(source = 'observed') %>%
  dplyr::select(Year_of_event, percent, source) %>% 
  rbind(., future_years) %>%
  mutate(Male = 1-percent,
         Female = percent) %>% 
  dplyr::select(-percent) %>%
  pivot_longer(cols = c('Male', 'Female'), names_to = 'Gender', values_to = 'percent') %>% 
  mutate(gender_source = paste0(substr(Gender,1,1),'_', source)) %>%
  ggplot(aes(x = Year_of_event, y = percent, fill = gender_source)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = c("F_observed" = "#F8766D", "M_observed" = "#00BFC4", 
                               "F_predicted" = "#FFCCCC", "M_predicted" = "#33FFFF")) +
  theme_minimal() 
```

As can be expected, some countries have far higher female participation than others. A look at the top and bottom 5 countries in the past 5 years (that have more than 1 event) shows New Zealand, Iceland, USA, Finland and Australia all with over 33%, while on the other side, Pakistan, Kosovo, Andorra, India and Spain have the lowest percentages of 11% and lower.

```{r}
# highest & lowest female participation
data_clean_1950 %>%
  filter(Year_of_event >= 2017,
         Athlete_gender %in% c('M','F')) %>%
  group_by(Athlete_gender, race_location, Event_name) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(race_location) %>%
  summarise(event_count = n_distinct(Event_name),
            female_percent = sum(if_else(Athlete_gender == 'F', n, 0)) / sum(n)) %>% 
  ungroup() %>%
  filter(event_count > 1) %>%
  arrange(desc(female_percent)) %>%
  mutate(n = row_number(),
         female_percent = percent(female_percent, accuracy = 0.01)) %>% 
  filter(n < 6 | n > (nrow(.) - 5)) %>%
  dplyr::select(-n)
```

A look at the major nations shows that the USA has been leading the pack for a while, with GBR in second. Races in Spain and France have a long way to go to catch up.

```{r}
race_locations <- c('FRA','ESP','USA','GBR','GER','ITA','RSA')

data_clean_1950 %>%
  filter(Athlete_gender %in% c('M','F'),
         race_location %in% race_locations) %>%
  count(Year_of_event, Athlete_gender, race_location) %>%
  group_by(Year_of_event, race_location) %>%
  mutate(percent = n/sum(n)) %>% 
  filter(Athlete_gender == 'F') %>%
  ggplot(aes(x = Year_of_event, y = percent, colour = race_location)) +
  geom_line() +
  theme_minimal() +
  labs(x = 'year', y = 'percentage female') +
  ggtitle('Gender divide') +
  scale_y_continuous(labels = percent)
```

One thing that is apparent is the gap between the fastest males and females is closing, with the average fastest male finishing time now around 22% faster than the female finish time for each of the major race distances. The average time of female finishers to males is also decreasing.

```{r}
gender_pace <- data_clean_1950 %>%
  mutate(race_distance = paste0(race_distance, race_unit),
         event = paste0(Year_of_event, '_', Event_name)) %>% 
  filter(race_distance %in% c('50km','100km','50m','100m'),
         Athlete_gender %in% c('F','M')) %>% 
  group_by(Year_of_event, race_distance, event, Athlete_gender) %>%
  summarise(fastest_time = min(athlete_duration),
            average_time = mean(athlete_duration)) %>%
  pivot_wider(names_from = Athlete_gender, values_from = c(fastest_time, average_time)) %>%
  mutate(fastest_diff = (fastest_time_F - fastest_time_M)/fastest_time_M,
         average_diff = (average_time_F - average_time_M)/average_time_M) %>%
  ungroup()

gender_pace %>%
  group_by(Year_of_event, race_distance) %>%
  summarise(fastest_diff = mean(fastest_diff, na.rm = TRUE),
            average_diff = mean(average_diff, na.rm = TRUE)) %>% 
  ggplot(aes(x = Year_of_event, y = fastest_diff, colour = race_distance)) +
  geom_line() +
  theme_minimal() +
  ylab('percentage') +
  scale_y_continuous(labels = percent) +
  ggtitle('percentage difference of winning female to male finishing time') -> fast.female.p

gender_pace %>%
  group_by(Year_of_event, race_distance) %>%
  summarise(fastest_diff = mean(fastest_diff, na.rm = TRUE),
            average_diff = mean(average_diff, na.rm = TRUE)) %>% 
  ggplot(aes(x = Year_of_event, y = average_diff, colour = race_distance)) +
  geom_line() +
  theme_minimal() +
  ylab('percentage') +
  scale_y_continuous(labels = percent) +
  ggtitle('percentage difference of average female to male finishing time') -> avg.female.p

grid.arrange(fast.female.p, avg.female.p, ncol = 1)
```

There is also a growing percentage of races that are being won outright by female runners, seeing 7.6% of female winners in 2022.

```{r}
gender_pace %>% 
  mutate(female_winner = if_else(fastest_time_F < fastest_time_M,1,0)) %>%
  group_by(Year_of_event) %>%
  summarise(female_winners = sum(female_winner, na.rm = TRUE),
            female_winners_perc = female_winners/n()) %>%
  ggplot(aes(x = Year_of_event, y = female_winners_perc)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  scale_y_continuous(labels = percent) +
  ggtitle('percent of races with female winner')
```


### 2.4 Age

Along with the increased participation of female athletes, the age ranges of athletes has also diversified. As mentioned previously, the age categories differ based on race location, so the chart below just slices the ages into 5 year buckets. The increase in participants over 30 has progressively increased since the 60's, together with a decline in runners below 25, with runners under 20 almost vanishing; falling from a high of 18% in the 1960's to under 0.5% for the past few years.

```{r}
age_groups = data.frame(age_breaks = c(0,seq.int(20,70, by = 5), Inf))

data_clean_1950 %>%
  mutate(age_group = cut(athlete_age, age_groups$age_breaks)) %>%
  count(Year_of_event, age_group) %>%
  filter(complete.cases(.)) %>% 
  ungroup() %>% group_by(Year_of_event) %>%
  mutate(percent = n/sum(n)) %>%
  ggplot(aes(x = Year_of_event, y = percent, fill = age_group)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  ggtitle('athlete ages')
```

### 2.5 Nationality

The number of different nationalities per race continues to grow each year, although presumably this trend will stop at some point as every nationality is accounted for. This increase is likely to be due to athletes willing to travel further to run races than previously. It is possible that the increase is due to residents in each of these countries who are of a different nationality being picked up with the general increase in participation, but given that GBR tends to see the fewest runners of different nationalities, this is unlikely to be the case. It's more likely that GBR has fewer 'prestigious' races compared to races in USA or France.

```{r}
data_clean_1950 %>%
  filter(race_location %in% race_locations) %>%
  group_by(Year_of_event, race_location) %>%
  distinct(Athlete_country) %>%
  count(Year_of_event, race_location) %>%
  ggplot(aes(x = Year_of_event, y = n, colour = race_location)) +
  theme_minimal() +
  geom_point() +
  ggtitle('participant nationalities per race location')
```

Of the major nations, France and Italy see the most diversity in terms of nationalities of athletes in their races, which is mainly led by UTMB and CCC races. RSA saw the fewest number of foreign nationals running in 2021 & 2022, due to lower participants running Comrades due to post-Covid restrictions.

A look at the last set of races before Covid sees Comrades as the race with the greatest number of nationalities present, followed by the UTMB group of races.

```{r}
data_clean_1950 %>%
  filter(Year_of_event == 2019) %>%
  group_by(Year_of_event, Event_name, race_location) %>%
  distinct(Athlete_country) %>%
  count(Year_of_event, Event_name, race_location) %>%
  arrange(desc(n)) %>% head(n = 20)
```

The group of UTMB races (UTMB, CCC, OCC & TDS) have amongst the highest percentage of foreign participation of any major race. This has grown from 15% in 2004 to 56% in 2022 for UTMB after considering French, Italian and Swiss participants as running in their home country due to the nature of the start lines.

```{r}
utmb <- c('Ultra Trail Tour du Mont Blanc (UTMB) (FRA)',
          'Courmayeur-Champex-Chamonix (CCC) (ITA)',
          'Orsières-Champex-Chamonix (OCC) (SUI)',
          'Sur les Traces des Ducs de Savoie (TDS) (ITA)')

data_clean_1950 %>%
  filter(Event_name %in% utmb) %>%
  mutate(foreign_race = if_else(Athlete_country %in% c('FRA', 'ITA', 'SUI'), 0, 1)) %>%
  group_by(Year_of_event, Event_name) %>% 
  summarise(foreign_participation = sum(foreign_race)/n()) %>% 
  ggplot(aes(x = Year_of_event, y = foreign_participation, colour = Event_name)) +
  theme_minimal() +
  geom_point() +
  ggtitle('foreign participation per race utmb') +
  scale_y_continuous(labels = percent) +
  theme(legend.position="bottom", legend.direction="vertical")
```

In comparison, even though Comrades Marathon in South Africa tends to have the highest number of nationalities present, only 10% of the field are not South African.

```{r}
data_clean_1950 %>%
  filter(Event_name %in% c('Comrades Marathon - Down Run (RSA)','Comrades Marathon - Up Run (RSA)'),
         Year_of_event != 2022) %>%
  mutate(foreign_race = if_else(Athlete_country == race_location, 0, 1)) %>%
  group_by(Year_of_event, Event_name) %>% 
  summarise(foreign_participation = sum(foreign_race)/n()) %>% 
  ggplot(aes(x = Year_of_event, y = foreign_participation, colour = Event_name)) +
  theme_minimal() +
  geom_point() +
  ggtitle('foreign participation per Comrades race') +
  scale_y_continuous(labels = percent) +
  theme(legend.position="bottom", legend.direction="vertical")
```

## 3 Conclusion

It's clear to see from the analysis presented that the popularity of ultra-marathon running continues to increase substantially each year, both in terms of the number of participants and number of events available to take part in. The diverstity element is also improving, based on the data available, for gender, age and range of nationalities. The gender differences are steadily improving but has a long way to go to becoming more equal in terms of male/female ratio, and some countries such as Spain and France are a long way behind USA and UK.

Data not available in this dataset is ethnicity of participant, which has an even larger disparity than gender. The University of Lancaster [conducted a survey](https://static1.squarespace.com/static/617668ef2b69d5286e7fad19/t/63dbb7697374b920b8413c70/1675343728326/Trail+Ultra+Survey+Report.pdf) in 2022, consisting of over 1,000 respondants, of which 95% indicated their ethnicity as "White". Further analysis would be interesting to see whether or not this is a percentage that has changed at all over recent years