Mountain Race

Animation of my Strava efforts on one of my local climbs

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 (Pebesma and Bivand 2023) object
• Include an assertive test (Fischetti 2023) for uniqueness of the key variables

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 (Pedersen and Robinson 2025) 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!

Acknowledgments

This work was completed using R v. 4.4.1 (R Core Team 2024) and the following R packages: assertr v. 3.0.1 (Fischetti 2023), crew v. 1.3.0 (Landau 2025), distill v. 1.6 (Dervieux et al. 2023), fs v. 1.6.6 (Hester, Wickham, and Csárdi 2025), gganimate v. 1.0.11 (Pedersen and Robinson 2025), gifski v. 1.32.0.2 (Ooms, Kornel Lesiński, and Authors of the dependency Rust crates 2025), knitr v. 1.51 (Xie 2014, 2015, 2025), pins v. 1.4.1 (Silge, Wickham, and Luraschi 2025), rmarkdown v. 2.30 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2025), scales v. 1.4.0 (Wickham, Pedersen, and Seidel 2025), sf v. 1.0.23 (Pebesma 2018; Pebesma and Bivand 2023), shiny v. 1.12.1 (Chang et al. 2025), tarchetypes v. 0.13.2 (Landau 2021a), targets v. 1.11.4 (Landau 2021b), tidyverse v. 2.0.0 (Wickham et al. 2019), transformr v. 0.1.5 (Pedersen 2024).