This summer 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.
A short time ago I’ve discovered the awesome R package drake. The use of this package transformed the way I do my analysis and it helps me to make my post more reproducible. The following blog post describes the underlying workflow, after which I’ve developed the underlying package transalp for this post.
Data
At first you have to install the package from github. Then you have to load it.
remotes::install_github("duju211/transalp")
library(transalp)
Load the other necessary libraries:
The package includes the underlying data:
df_act_meas_raw <- transalp::df_act_meas
# A tibble: 90,917 x 10
id act_date moving velocity_smooth grade_smooth distance
<chr> <date> <lgl> <dbl> <dbl> <dbl>
1 3669729902 2020-06-25 FALSE 0 0 0
2 3669729902 2020-06-25 FALSE 0 0 0.9
3 3669729902 2020-06-25 TRUE 0 -44.6 4.6
4 3669729902 2020-06-25 TRUE 0 1.4 8.4
5 3669729902 2020-06-25 TRUE 0 2.8 12.1
6 3669729902 2020-06-25 TRUE 0 2.8 15.6
7 3669729902 2020-06-25 TRUE 0 1.4 19.1
8 3669729902 2020-06-25 TRUE 3.6 1.4 22.5
9 3669729902 2020-06-25 TRUE 3.5 0 26
10 3669729902 2020-06-25 TRUE 3.5 1.6 29.5
# ... with 90,907 more rows, and 4 more variables: altitude <dbl>,
# time <int>, lat <dbl>, lng <dbl>Preprocessing
Look at the first function:
#' Function to preprocess measurements of the included activities.
#'
#' @param df_act_meas
#'
#' @return Preprocessed activities
#' @export
#'
#' @examples
#' pre_process_meas(df_act_meas)
pre_process_meas <- function(df_act_meas) {
df_act_meas %>%
dplyr::mutate(
act_date_chr = as.character(act_date),
altitude_norm = altitude / max(altitude)) %>%
dplyr::group_by(id) %>%
dplyr::mutate(distance_norm = distance / max(distance)) %>%
dplyr::ungroup()
}
The function does some basic preprocessing on the included activities:
- Turn activity date into character (for easier plotting)
- Normalize altitude and distance
df_act_meas <- pre_process_meas(df_act_meas_raw)
Nest the data frame by id and act_date_chr. Create a new sf column with the geospatial information of the activities:
#' Turn every activity into an sf object. Nest the data frame by 'id' and
#' 'act_date_chr' to do this.
#'
#' @param df_act_meas
#'
#' @return sf object
#' @export
#'
#' @examples
convert_to_sf <- function(df_act_meas) {
df_act_meas %>%
tidyr::nest(act_data = -c(id, act_date_chr)) %>%
dplyr::mutate(
line = purrr::map(
act_data,
~ sf::st_linestring(as.matrix(.x[, c("lng", "lat", "altitude")]))),
geom = purrr::map(line, sf::st_sfc, crs = 4326)) %>%
sf::st_as_sf()
}
sf_act_meas <- convert_to_sf(df_act_meas)
Simple feature collection with 5 features and 4 fields
Geometry type: LINESTRING
Dimension: XYZ
Bounding box: xmin: 8.317612 ymin: 46.0061 xmax: 9.035269 ymax: 48.21307
z_range: zmin: 206.8 zmax: 2477.6
CRS: NA
# A tibble: 5 x 5
id act_date_chr act_data line geom
<chr> <chr> <list> <LINESTRING> <list>
1 36697~ 2020-06-25 <tibble [~ Z (8.596761 46.63501 1451.6, ~ <LINE~
2 36646~ 2020-06-24 <tibble [~ Z (8.602206 46.63612 1510.2, ~ <LINE~
3 36590~ 2020-06-23 <tibble [~ Z (8.625703 46.90152 447, 8.6~ <LINE~
4 36542~ 2020-06-22 <tibble [~ Z (8.741265 47.49397 432, 8.7~ <LINE~
5 36504~ 2020-06-21 <tibble [~ Z (9.021049 48.21307 750.2, 9~ <LINE~Extract the start point of every tour except for the last one. Extract the end point for this tour.
#' Extract points of interest.
#'
#' @param sf_act_meas
#'
#' @return Data frame with points of interest
#' @export
#'
#' @examples
extract_poi <- function(sf_act_meas) {
sf_act_meas %>%
tibble::as_tibble() %>%
dplyr::transmute(
id, first_row = purrr::map(act_data, ~ .x[1,]),
last_row = purrr::map(act_data, ~ .x[nrow(.x), ]),
decisive_row = dplyr::if_else(id == "3669729902", last_row, first_row)) %>%
tidyr::unnest(decisive_row) %>%
dplyr::select(where(purrr::negate(purrr::is_list))) %>%
dplyr::mutate(
poi_name = dplyr::case_when(
act_date == "2020-06-21" ~ "Albstadt",
act_date == "2020-06-22" ~ "Winterthur",
act_date == "2020-06-23" ~ "Flüelen",
act_date == "2020-06-24" ~ "Andermatt",
act_date == "2020-06-25" ~ "Lugano",
TRUE ~ NA_character_)) %>%
dplyr::rename(lon = lng)
}
df_poi <- extract_poi(sf_act_meas)
Visualisation
Altitude
Visualise the altitude data:
#' Visualise the altitude by using a ridge plot.
#'
#' @param df_act_meas
#'
#' @return ggplot of altitude data
#' @export
#'
#' @examples
vis_altitude_ridge <- function(df_act_meas) {
df_act_meas %>%
tibble::as_tibble() %>%
tidyr::unnest_legacy(act_data) %>%
dplyr::mutate(distance = distance / 1000) %>%
ggplot2::ggplot(ggplot2::aes(
x = distance, y = act_date_chr, height = altitude,
group = act_date_chr, color = act_date_chr)) +
ggridges::geom_ridgeline(scale = 0.0025, alpha = 0.2) +
ggplot2::labs(
x = "Distance [km]", y = ggplot2::element_blank()) +
ggplot2::theme_light() +
ggplot2::theme(
legend.position = "none") +
ggplot2::scale_y_discrete(position = "right") +
ggplot2::scale_x_continuous(breaks = scales::breaks_width(10))
}
The function mainly applies the ggridges::geom_ridgeline function to the data. A form of visualisation that I’ve already used a lot. Its style is reminiscent of the famous Joy Division album cover.
gg_altitude_ridges <- vis_altitude_ridge(sf_act_meas)
Spatial Data
Determine the map data for all the activities. Use the ggmap::get_stamenmap function to download the data. The bounding box is calculated from the sf_act_meas object.
#' Get the ground map for the visualisation of the spatial data.
#'
#' @param sf_act_meas
#' @param tol_bbox
#' @param map_zoom
#'
#' @return
#' @export
#'
#' @examples
get_alpen_map <- function(sf_act_meas, tol_bbox = 0.015, map_zoom = 10) {
bbox <- sf::st_bbox(sf_act_meas)
stamen_map <- ggmap::get_stamenmap(
bbox = c(
left = bbox$xmin[[1]] - tol_bbox,
right = bbox$xmax[[1]] + tol_bbox,
bottom = bbox$ymin[[1]] - tol_bbox,
top = bbox$ymax[[1]] + tol_bbox),
maptype = "terrain-background", zoom = map_zoom, color = "bw")
}
gg_alpen <- get_alpen_map(sf_act_meas, tol_bbox = 0.1, map_zoom = 9)
Plot the activity and the point of interest data onto the map. Use the ggrepel package to plot the labels of the points of interest. This avoids too much overplotting.
#' Plot the spatial data (route + point of interest) onto the map
#'
#' @param sf_act_meas
#' @param gg_alpen
#'
#' @return ggplot of spatial data
#' @export
#'
#' @examples
vis_ride <- function(sf_act_meas, gg_alpen, df_poi) {
ggmap::ggmap(gg_alpen) +
ggplot2::geom_sf(
data = sf_act_meas, inherit.aes = FALSE,
mapping = aes(color = act_date_chr), size = 1.2) +
ggrepel::geom_label_repel(
data = df_poi, mapping = aes(label = poi_name), alpha = 0.6,
family = "Fira Code Retina", size = 2.5) +
ggplot2::theme_light() +
ggplot2::labs(
x = "Longitude", y = "Latitude") +
ggplot2::theme(legend.position = "none")
}
gg_rides <- vis_ride(sf_act_meas, gg_alpen_map, df_poi)
Combine Visualisations
Combine everything into one big plot using the patchwork package:
# extrafont::font_import()
extrafont::loadfonts(device = "win")
final_plot <- (gg_rides + gg_altitude_ridges) +
plot_annotation(
title = "Transalp 2020",
subtitle = "Albstadt - Lugano") &
theme(text = element_text(family = "Fira Code Retina"))
final_plot
The extrafont package helps with using some fancy fonts. The font_import function has to be called once. Comment the function call in the above code chunk because of this.