Datannery: Mountain Race

Julian During

Idea

Every cyclist has a particular important climb. It might not be a big deal to anyone else, but any climb can be important!

My favorite local climb goes by the name of ‘Lochen’. It’s located outside of my local hometown Balingen in the southwest of Germany. It’s about 4.4 kilometers long with an average gradient of 6.9%.

This doesn’t sound like a hard climb. It might not even register as a regular big climb for most cyclists. But for me it’s one of the most iconic climbs.

In the following post, I will let different versions of me race against each other on my favorite local climb!

Data

The following libraries are used in this analysis:

library(tarchetypes)
library(conflicted)
library(transformr)
library(gganimate)
library(tidyverse)
library(lubridate)
library(targets)
library(distill)
library(assertr)
library(scales)
library(gifski)
library(pins)
library(fs)
library(sf)

conflict_prefer("filter", "dplyr")
conflict_prefer("lag", "dplyr")

theme_set(theme_void())

The data originates from my personal Strava account. If you have a Strava account and want to query your data like I do here, you can have a look at one of my previous posts.

Download the data here:

g_board <- board_gdrive("strava")
df_act <- filter(select(pin_read(g_board, "df_act_26845822"), 
     id, start_date, type), type == "Ride")
df_meas <- semi_join(filter(pin_read(g_board, "df_meas_26845822"), 
     !is.na(lat), !is.na(lng)), df_act, by = join_by(id))

Filter for the measurements that happened in a bounding box representing the mentioned climb:

mountain_race_bb <- function(df_meas, lat_min, lat_max, lng_min,
                              lng_max) {
  df_meas |>
    filter(
      lat >= lat_min, lat <= lat_max, lng >= lng_min, lng <= lng_max,
    ) |>
    select(-heartrate)
}
df_mountain_race_bb_lochen <- mountain_race_bb(df_meas, 48.218171, 48.231383, 8.842964, 
     8.86219)

Take a first look at the raw data:

glimpse(df_mountain_race_bb_lochen)

Rows: 45,186
Columns: 15
$ series_type     <chr> "distance", "distance", "distance", "distanc…
$ original_size   <int> 2152, 2152, 2152, 2152, 2152, 2152, 2152, 21…
$ resolution      <chr> "high", "high", "high", "high", "high", "hig…
$ id              <chr> "16017478862", "16017478862", "16017478862",…
$ distance        <dbl> 3674.6, 3679.0, 3683.6, 3689.0, 3695.0, 3701…
$ time            <int> 806, 807, 808, 809, 810, 811, 812, 813, 814,…
$ altitude        <dbl> 884.0, 884.0, 883.9, 883.8, 883.7, 883.4, 88…
$ velocity_smooth <dbl> 4.56, 4.46, 4.36, 4.56, 4.94, 5.32, 5.86, 6.…
$ moving          <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TR…
$ grade_smooth    <dbl> -1.1, -1.1, -1.5, -2.7, -2.8, -3.4, -4.1, -4…
$ lat             <dbl> 48.21818, 48.21821, 48.21825, 48.21829, 48.2…
$ lng             <dbl> 8.852876, 8.852852, 8.852821, 8.852780, 8.85…
$ temp            <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …
$ watts           <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …
$ cadence         <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …

Further preprocess the data:

Divide the measurements into segments by time
Turn the data into a sf object

For the division into segments define a tolerance time:

tol_sec <- 30

mountain_race <- function(df_mountain_race_bb, tol_sec) {
  df_mountain_race <- df_mountain_race_bb |>
    mutate(
      seg_id = cumsum(!(lag(time, default = first(time)) >= time - tol_sec)),
      .by = id)
  
  sf_mountain_race <- df_mountain_race |>
    arrange(id, seg_id, time) |>
    st_as_sf(
      coords = c("lng", "lat"), dim = "XY", crs = st_crs(4326))
  
  sf_mountain_race |>
    verify(is_uniq(id, seg_id, time))
}
sf_mountain_race_lochen <- mountain_race(df_mountain_race_bb_lochen, tol_sec)

Determine one reference segment. Filter for id and a time interval. After filtering, combine the point geometries and cast into a linestring.

mountain_race_ref <- function(sf_mountain_race, ref_id, min_time, max_time) {
  sf_mountain_race |>
    filter(id == ref_id, time >= min_time, time <= max_time) |>
    summarise(geometry = st_combine(geometry), do_union = FALSE) |>
    st_cast("LINESTRING")
}
sf_mountain_race_ref_lochen <- mountain_race_ref(sf_mountain_race_lochen, "6153936896", 
     959, 2122)

Add a buffer to the reference segment. This will be used to filter the other activities for relevant points.

sf_mountain_race_ref_buffer_lochen <- st_buffer(sf_mountain_race_ref_lochen, dist = 20)

Take a look at the reference segment and the buffer:

ggplot() +
  geom_sf(data = sf_mountain_race_ref_buffer_lochen) +
  geom_sf(data = sf_mountain_race_ref_lochen)

Using this reference segment, filter all points that are inside of it. Filter out segments that do not have the same length as the original reference segment. Calculate the standardized time so that all filtered segments start at the same time.

mountain_race_seg <- function(sf_mountain_race, sf_mountain_race_ref,
                              sf_mountain_race_ref_buffer) {
  sf_mountain_race_seg <- st_intersection(
    sf_mountain_race, sf_mountain_race_ref_buffer)
  
  sf_mountain_race_seg_sum <- sf_mountain_race_seg |>
    group_by(id, seg_id) |>
    summarise(
      count_points = n_distinct(geometry), .groups = "drop",
      do_union = FALSE) |>
    filter(count_points > 1) |>
    st_cast("LINESTRING") |>
    mutate(length = st_length(geometry)) |>
    filter(length >= 0.96 * st_length(sf_mountain_race_ref))
  
  sf_mountain_race_seg |>
    semi_join(as_tibble(sf_mountain_race_seg_sum), by = join_by(id, seg_id)) |>
    as_tibble() |>
    arrange(id, seg_id, time) |>
    mutate(
      time_delta = time - lag(time, default = first(time)),
      time_norm = cumsum(time_delta),
      .by = c(id, seg_id), .keep = "unused") |>
    mutate(
      lng = map_dbl(geometry, 1), lat = map_dbl(geometry, 2),
      .keep = "unused")
}
df_mountain_race_seg_lochen <- mountain_race_seg(sf_mountain_race_lochen, sf_mountain_race_ref_lochen, 
     sf_mountain_race_ref_buffer_lochen)

Visualisation

Make a first static ggplot visualisation. Keep the plot rather minimal. Use ggplot2::theme_void as a general theme:

vis_mountain_race <- function(df_mountain_race) {
  df_mountain_race |>
    ggplot(
      aes(x = lng, y = lat, group = id)
    ) +
    geom_path(alpha = 0.2)
}
gg_mountain_race_lochen <- vis_mountain_race(df_mountain_race_seg_lochen)
gg_mountain_race_lochen

gg_mountain_race_lochen

As you can see there are a lot of paths on one road. These are my bike rides on the ‘Lochen’ pass.

To further explore the data, make a first animated visualisation with the gganimate package:

gg_anim_mountain_race_lochen <- gg_mountain_race_lochen + transition_reveal(time_norm)

gg_anim_mountain_race_lochen

In this animated version of the plot, you can see that not all bike rides start at the bottom of the climb. Determine these activities:

wrong_direction <- function(df_mountain_race_seg) {
  df_mountain_race_seg |>
    group_by(id, seg_id) |>
    summarise(
      start_altitude = altitude[time_norm == min(time_norm)],
      end_altitude = altitude[time_norm == max(time_norm)],
      .groups = "drop"
    ) |>
    filter(end_altitude < start_altitude)
}
df_wrong_direction_lochen <- wrong_direction(df_mountain_race_seg_lochen)

Exclude activities that start at the top of the climb:

df_mountain_race_uphill_lochen <- anti_join(df_mountain_race_seg_lochen, df_wrong_direction_lochen, 
     by = join_by(id, seg_id))

With the cleaned up data, we can repeat the animated plot:

gg_mountain_race_uphill_lochen <- vis_mountain_race(df_mountain_race_uphill_lochen)
gg_anim_mountain_race_uphill_lochen <- gg_mountain_race_uphill_lochen + transition_reveal(time_norm)

gg_anim_mountain_race_uphill_lochen

Now it looks much cleaner and the rides are more comparable to one another.

I very much like how the plot turned out. I hope I can find some time in the future to do more of this type of animation!

Mountain Race

Idea

Data

Visualisation

Corrections

Reuse

Citation