Getting Over It

Visualising my Transalp bike ride

In summer 2020, I crossed the alps with my road bike. I’ve recorded the whole ride and as a nice memory, I would like to visualise this ride.

Data

Load the other necessary libraries:

library(tarchetypes)
library(conflicted)
library(patchwork)
library(tidyterra)
library(tidyverse)
library(elevatr)
library(ggrepel)
library(targets)
library(raster)
library(scales)
library(terra)
library(pins)
library(fs)
library(sf)

conflicts_prefer(dplyr::filter)
conflicts_prefer(dplyr::lag)
conflicts_prefer(dplyr::select)

Define where activity data is read from:

act_file <- "data/act.rds"

meas_file <- "data/meas.rds"

Read activity data from rds file. Define point of interests names and define if it should be mapped to the start or the end of the activity:

act <- function(act_file) {
  read_rds(act_file) |>
    mutate(
      start_name = case_when(
        id == "3650448726" ~ "Albstadt",
        id == "3654245140" ~ "Winterthur",
        id == "3659045033" ~ "Fluelen",
        id == "3664650034" ~ "Andermatt",
        id == "3669729902" ~ "Andermatt",
        TRUE ~ NA_character_),
      end_name = case_when(
        id == "3650448726" ~ "Winterthur",
        id == "3654245140" ~ "Fluelen",
        id == "3659045033" ~ "Andermatt",
        id == "3664650034" ~ "Andermatt",
        id == "3669729902" ~ "Lugano",
        TRUE ~ NA_character_),
      poi_name = if_else(end_name == "Lugano", "Lugano", start_name),
      name = str_glue("{start_name} - {end_name}"),
      lat_poi = if_else(
        poi_name == "Lugano",
        map_dbl(end_latlng, 1),
        map_dbl(start_latlng, 1)),
      lng_poi = if_else(
        poi_name == "Lugano",
        map_dbl(end_latlng, 2),
        map_dbl(start_latlng, 2))) |>
    select(-distance)
}

df_act <- act(act_file)

Read meas data:

meas <- function(meas_file) {
  df_meas_raw <- read_rds(meas_file)

  df_distance_max <- df_meas_raw |>
    group_by(id) |>
    summarise(distance_max = max(distance)) |>
    mutate(
      distance_max = lag(distance_max, default = 0),
      distance_max = cumsum(distance_max))

  df_meas_raw |>
    left_join(df_distance_max, by = join_by(id)) |>
    group_by(id) |>
    mutate(distance_cum = distance + distance_max) |>
    ungroup()
}

df_meas <- meas(meas_file)

Turn measurements into sf object:

act_meas_points <- function(df_meas, df_act) {
  df_meas |>
    st_as_sf(coords = c("lng", "lat"), crs = 4326) |>
    left_join(df_act, by = join_by(id))
}

sf_act_meas_points <- act_meas_points(df_meas, df_act)

Combine into one LINESTRING:

act_meas_lines <- function(sf_act_meas_points) {
  sf_act_meas_points |>
    group_by(id, name, lng_poi, lat_poi, poi_name) |>
    summarise(
      mean_speed = mean(velocity_smooth),
      mean_altitude = mean(altitude),
      mean_distance = mean(distance_cum),
      do_union = FALSE, .groups = "drop") |>
    st_cast("LINESTRING")
}

sf_act_meas_lines <- act_meas_lines(sf_act_meas_points)

Read raster data:

alpen_raster <- function(sf_lines) {
  get_elev_raster(sf_lines, z = 6, clip = "bbox", expand = 0.1) |>
    rast() |>
    wrap()
}

raster_alpen <- alpen_raster(sf_act_meas_lines)

Visualisation

vis_ride <- function(sf_act_meas_lines, sf_act_meas_points, raster_alpen) {
  theme_set(theme_light(base_size = 12))

  raster_alpen_unpacked <- raster_alpen |>
    unwrap()

  gg_ride <- ggplot(sf_act_meas_lines) +
    geom_spatraster_contour(data = raster_alpen_unpacked, binwidth = 200) +
    geom_sf(aes(color = id)) +
    geom_label_repel(
      aes(x = lng_poi, y = lat_poi, label = poi_name),
      size = 2.5, fill = alpha(c("white"), 0.5)) +
    labs(
      x = "Longitude", y = "Latitude") +
    theme(
      legend.position = "none", panel.grid.major = element_blank(),
      axis.text.x = element_text(angle = 90))

  gg_altitude <- sf_act_meas_points |>
    filter(moving) |>
    ggplot(aes(x = distance_cum, y = altitude, color = id, group = id)) +
    geom_line() +
    geom_label(
      data = sf_act_meas_lines,
      mapping = aes(x = mean_distance, y = mean_altitude, label = name),
      fill = alpha(c("white"), 0.5)) +
    labs(x = "Distance [km]", y = "Height [m]") +
    theme(legend.position = "none") +
    expand_limits(y = 0) +
    scale_x_continuous(
      labels = label_number(scale = 0.001),
      breaks = breaks_width(50000)) +
    scale_y_continuous(position = "right")

  gg_final <- gg_ride + gg_altitude +
    plot_layout(widths = c(1, 3)) +
    plot_annotation(
      title = "Transalp 2020",
      subtitle = "Albstadt - Lugano") &
    theme(text = element_text(family = "Fira Code", size = 12))

  ggsave(
    "transalp.png", gg_final,
    width = 40, height = 25, units = "cm", scale = 0.8)
}

gg_ride <- vis_ride(sf_act_meas_lines, sf_act_meas_points, raster_alpen)

What a ride it has been! I’m always thinking back to this experience. It’s time to recreate such a ride in the near future.