Tour des Vosges

In this post, I want to visualise my bike ride to the Tour de France this summer. The Tour visited Alsace and the Vosges this summer, which is near my home town. I’ve tracked my trip with a GPS device and uploaded it to Strava.

Data

Load libraries and general settings. Already define the start and end date of my trip, to make it easier to find the relevant Strava activities later.

library(tidyverse)
## -- Attaching packages ------------------------------------------------- tidyverse 1.3.0 --
## v ggplot2 3.3.1     v purrr   0.3.4
## v tibble  3.0.1     v dplyr   1.0.0
## v tidyr   1.1.0     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.5.0
## -- Conflicts ---------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(patchwork)
library(showtext)
## Loading required package: sysfonts
## Loading required package: showtextdb
library(ggrepel)
library(scales)
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
library(ggmap)
## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.
## Please cite ggmap if you use it! See citation("ggmap") for details.
library(drake)
## 
## Attaching package: 'drake'
## The following objects are masked from 'package:tidyr':
## 
##     expand, gather
library(here)
## here() starts at D:/Documents/RWorkspace/blog_duju
library(pins)
library(sf)
## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(fs)

theme_set(theme_light())
source(here::here("content", "post", "2019-12-21-vosges-rides_functions.R"))

font_add_google(name = "Amatic SC", family = "amatic-sc")
showtext_auto()

Create a drake plan first. By doing so, you can get an overview of the planned steps to get to the final plot. Also the code is only rerun, if something in the code changes. If this happens, not all of the code needs to be run again, but only the dependent sections.

I will shorty describe all important steps in the course of this post.

vosges_plan <- drake_plan(
  start_date = as_date("2019-07-09"),
  end_date = as_date("2019-07-14"),
  line_size = 1, shape_size = 2, shapes = c(seq(15,20), 4),
  font_size = 60, label_text_size = 10,
  out_width = 29.7, out_height = 21,
  df_meas = load_meas(),
  df_meas_vosges = find_rides(df_meas, start_date, end_date),
  df_meas_vosges_pro = preprocess_rides(df_meas_vosges),
  df_locations = define_important_locations(),
  df_platten = define_platten_df(df_meas_vosges_pro),
  sf_locations = turn_poi_into_sf(df_locations),
  sf_meas_vosges = turn_meas_into_sf(df_meas_vosges_pro),
  sf_platten = turn_platten_into_sf(df_platten),
  bbox = bounding_box(sf_meas_vosges),
  map_toner = get_bbox_stamen_map(
    bbox, tol_bbox = 0.015, map_type = "toner-hybrid"),
  gg_map_toner = ggmap(map_toner),
  gg_geom = plot_rides_geom(
    map_toner, sf_meas_vosges, sf_locations, sf_platten,
    shape_size = shape_size, line_size = line_size, shapes = shapes),
  df_locations_times = select(unnest(df_locations, time), -c(lon, lat)),
  df_meas_vosges_pro_locations = left_join(
    df_meas_vosges_pro, df_locations_times, by = "time"),
  gg_altitude = plot_altitude(
    df_meas_vosges_pro_locations,
    line_size = line_size, shape_size = shape_size, shapes = shapes),
  gg_vosges = combine_plots(
    gg_geom, gg_altitude, sf_locations, font_size, label_text_size, start_date,
    end_date) &
    theme(
      legend.position = "none",
      text = element_text(family = "amatic-sc", size = font_size)),
  gg_vosges_out = ggsave(
    file_out("static/post/tour_des_vosges.png"), gg_vosges))

I’ve already scraped all my Strava activities. You can see how I did it in this post. In this post I also already uploaded (with the help of the pins package) the scraped and preprocessed activities to my Github account. All I have to do now, is to load the data with the pin_get function.

load_meas <- function() {
  board_register_gcloud(bucket = "strava_data_public")
  df_meas <- pin_get("strava_meas", board = "gcloud")
}

Find rides from the vosges trip. To do so, search the timestamp of the activities and check, if they fall into the timespan of my trip.

find_rides <- function(df_meas, start_date, end_date, time_col = time) {
  df_meas_vosges <- df_meas %>%
    mutate(
      ride_date = as_date({{ time_col }}),
      ride_id = as.character(format(ride_date, "%d.%m"))) %>%
    arrange({{ time_col }}) %>%
    filter(
      ride_date >= start_date, ride_date <= end_date)
}
## # A tibble: 43,089 x 15
##        id altitude velocity_smooth cadence grade_smooth heartrate distance
##     <dbl>    <dbl>           <dbl>   <int>        <dbl>     <int>    <dbl>
##  1 2.52e9     805.             0        NA          0          NA      0  
##  2 2.52e9     805.             0        NA          0          NA      2.2
##  3 2.52e9     805.             2.7      NA          0          NA      5.3
##  4 2.52e9     805.             3.1      NA          1.3        NA      9.4
##  5 2.52e9     805.             3.4      NA          1.2        NA     13.6
##  6 2.52e9     805.             3.5      NA          1.3        NA     17.6
##  7 2.52e9     805.             3.8      NA          1.3        NA     21.4
##  8 2.52e9     805.             4        NA          0          NA     25.3
##  9 2.52e9     805.             4        NA          0          NA     29.5
## 10 2.52e9     805.             4        NA          0          NA     33.4
## # ... with 43,079 more rows, and 8 more variables: moving <lgl>, time <dttm>,
## #   lat <dbl>, lng <dbl>, watts <int>, type <chr>, ride_date <date>,
## #   ride_id <chr>

Do some basic preprocessing. The main work is to deal with a flat tire incident. At one day of the trip, I’ve had a flat tire and stopped the activity because of this. I nonetheless want to summarise the day as one activity. Search for the reset in the distance column and unite the activity after the flat tire incident to the activity before the incident.

preprocess_rides <- function(
  df_meas_vosges, id_col = ride_id, distance_col = distance) {
  df_meas_vosges_pro <- df_meas_vosges %>%
    group_by({{ id_col }}) %>%
    mutate(
      distance = {{ distance_col }} / 1000,
      lag_distance = lag(distance, default = 0),
      delta_distance = distance - lag_distance,
      reset = delta_distance < 0,
      reset_cum = cumany(reset),
      delta_distance_cor = if_else(reset, 0, delta_distance),
      distance_cor = cumsum(delta_distance_cor)) %>%
    ungroup() %>% 
    mutate(ride_id = fct_inorder(ride_id))
}

After preprocessing, extract the mentioned incident, to include it in the plot later.

define_platten_df <- function(
  df_meas_vosges_pro, reset_col = reset, time_col = time) {
  timestamp_platten <- df_meas_vosges_pro %>%
    filter(lead({{ reset_col }})) %>%
    pull({{ time_col }})
  
  df_flat_tire <- df_meas_vosges_pro %>%
    mutate(time = {{ time_col }}) %>%
    filter(
      time == timestamp_platten
      | time == time[time == min(time[time - timestamp_platten > 0])])
}

Define some important locations and define, when the locations got visited. The ‘Auberge de la Sapiniere’ was the hotel of my trip and the starting point of two of my rides.

define_important_locations <- function() {
  df_locations <- tibble(
    name = c(
      "Col de la Schlucht", "Planche des Belles Filles",
      "Auberge de la Sapiniere", "Ballon d'Alsace", "Grand Ballon",
      "Ballon De Servance", "Trois Epis"),
    lon = c(
      48.0637789, 47.7730212, 47.8819595, 47.820553, 47.904875, 47.822541,
      48.0994418),
    lat = c(
      7.0209629, 6.7771244, 7.1244349, 6.8370523, 7.1020437, 6.7867278,
      7.2323222),
    time = map(list(
      c("2019-07-12 09:47:27"),
      c("2019-07-13 16:04:55"),
      c("2019-07-11 07:30:47", "2019-07-10 07:09:14"),
      c("2019-07-11 16:58:48", "2019-07-13 12:25:43"),
      c("2019-07-10 08:01:04"),
      c("2019-07-13 14:40:00"),
      c("2019-07-10 10:25:32")), ymd_hms))
}
## # A tibble: 7 x 4
##   name                        lon   lat time      
##   <chr>                     <dbl> <dbl> <list>    
## 1 Col de la Schlucht         48.1  7.02 <dttm [1]>
## 2 Planche des Belles Filles  47.8  6.78 <dttm [1]>
## 3 Auberge de la Sapiniere    47.9  7.12 <dttm [2]>
## 4 Ballon d'Alsace            47.8  6.84 <dttm [2]>
## 5 Grand Ballon               47.9  7.10 <dttm [1]>
## 6 Ballon De Servance         47.8  6.79 <dttm [1]>
## 7 Trois Epis                 48.1  7.23 <dttm [1]>

Turn the data frames of the spatial data into sf objects. This will simplify the plotting of the data.

turn_poi_into_sf <- function(
  df_locations, name_col = name, lat_col = lat, lon_col = lon) {
  sf_locations <- df_locations %>%
    mutate(lat = {{ lat_col }}, lon = {{ lon_col }}) %>% 
    nest(poi = -{{ name_col }}) %>%
    mutate(
      point = map(poi, ~ st_point(c(.x$lat, .x$lon), dim = "XY")),
      point_geom = st_sfc(point, crs = 4326)) %>%
    st_as_sf()
}
turn_meas_into_sf <- function(
  df_meas_vosges_pro, id_col = ride_id, reset_cum_col = reset_cum,
  lng_col = lng, lat_col = lat, altitude_col = altitude) {
  sf_meas_vosges <- df_meas_vosges_pro %>%
    mutate(lng = {{ lng_col }}, lat = {{ lat_col }}) %>% 
    nest(ride = -c({{ id_col }}, {{ reset_cum_col }})) %>%
    mutate(
      ride_id = fct_rev({{ id_col }}),
      line = map(
        ride, ~ st_linestring(as.matrix(.x[, c("lng", "lat", "altitude")]))),
      geom = st_sfc(line, crs = 4326)) %>%
    st_as_sf()
}
turn_platten_into_sf <- function(
  df_flat_tire, id_col = ride_id, reset_col = reset, lng_col = lng, lat_col = lat,
  altitude_col = altitude) {
  sf_flat_tire <- df_flat_tire %>%
    mutate(lat = {{ lat_col }}, lng = {{ lng_col }}) %>%
    nest(ride = -c({{ id_col }}, {{ reset_col }})) %>%
    mutate(
      line = map(
        ride, ~ st_linestring(as.matrix(
          .x[, c("lng", "lat", "altitude")])))) %>%
    st_sf(crs = 4326) %>%
    st_as_sf()
}

Calculate bounding box with a specific sf function:

bounding_box <- function(sf_meas_vosges) {
  bounding_box <- st_bbox(sf_meas_vosges)
}

Visualisation

Download a stamen map from the website. Use the bounding box to get the map. There are several different map styles available. I’ve chosen the toner-hybrid style.

get_bbox_stamen_map <- function(bbox, tol_bbox, map_type) {
  map_toner <- get_stamenmap(c(
    left = bbox$xmin[[1]] - 2 * tol_bbox,
    right = bbox$xmax[[1]] + tol_bbox,
    bottom = bbox$ymin[[1]] - 2 * tol_bbox,
    top = bbox$ymax[[1]]) + tol_bbox,
    zoom = 11, maptype = map_type, color = "bw")
}

Plot the spatial data:

plot_rides_geom <- function(map_toner, sf_meas_vosges, sf_locations, sf_platten, 
  shape_size, line_size, shapes) {
  gg_geom <- ggmap(map_toner) +
    geom_sf(
      data = sf_meas_vosges, inherit.aes = FALSE, size = line_size,
      aes(color = ride_id)) +
    geom_sf(
      data = sf_locations, inherit.aes = FALSE, aes(shape = name),
      size = shape_size) +
    scale_shape_manual(values = shapes) +
    geom_sf(
      data = sf_platten, inherit.aes = FALSE, size = line_size,
      linetype = "dashed", aes(color = ride_id)) +
    theme(
      axis.text.x = element_text(angle = 90, hjust = 1.2, vjust = -1),
      axis.title = element_blank(), legend.position = "none")
}

Plot the altitude profiles:

plot_altitude <- function(
  df_meas_vosges_pro, line_size, shape_size, shapes) {
  
  gg_altitude <- df_meas_vosges_pro %>%
    ggplot(aes(x = distance_cor, y = altitude, color = ride_id)) +
    geom_path(size = line_size, aes(linetype = reset)) +
    geom_point(aes(shape = name), color = "black", size = shape_size) +
    scale_shape_manual(values = shapes) +
    facet_wrap(~ ride_id, scales = "free_x", ncol = 1,
      strip.position = "right") +
    scale_x_continuous(breaks = breaks_width(10)) +
    labs(y = "Altitude [m]", x = "Distance [km]")
}
## Warning: Removed 43080 rows containing missing values (geom_point).

Combine the plots with the help of the patchwork package, which is available at CRAN since a short amount of time. Use the google font, which was downloaded at the beginning of the script. Since the use of this font causes some layout problems, I’ve experimented with the size settings for the shapes, fonts and lines.

combine_plots <- function(
  gg_geom, gg_altitude, sf_locations, font_size, label_text_size,
  start_date, end_date) {
  
  gg_combine <- gg_geom +
    geom_text_repel(
      data = sf_locations, aes(label = name, geometry = point_geom),
      inherit.aes = FALSE, stat = "sf_coordinates", size = label_text_size,
      family = "amatic-sc") +
    gg_altitude +
    plot_annotation(
      title = "Tour des Vosges",
      subtitle = str_glue(
        "Date: {format(start_date, '%d.%m.%Y')} - ",
        "{format(end_date, '%d.%m.%Y')}")) +
    plot_layout(guides = 'collect')
}

To see the new font, it is necessary to save the finished ggplot to a file first.

Show final result by including the saved ggplot png file: