Analysing Transcontinental race 2022. Part 2: Leaderboards and route choices

In the Part 1 I demonstrated how to obtain the data from the tracking service, and in this part I will analyse route choices between control points.

Koodi

library(dplyr)
library(sf)
library(ggplot2)
library(tidyr)
library(reactable)
library(lubridate)
library(leaflet)
library(leaflet.extras)

In order to create the leaderboards, we first need the locations of the control points. These are sourced manually from the tracking service, and are formed into a spatial data below.

Koodi

cps <- structure(list(cp = c("Start", "CP1", "CP2", "CP3", "CP4", 
"Finish"), loc = c(" Muur-Kapelmuur, Geraardsbergen, Belgium", 
" Krupka, Czech Republic", " Passo di Gavia, Italy", "Durmitor National Park, Montenegro", 
" Drumul Strategic Transalpina, Romania", " Burgas, Bulgaria"
), geom = structure(list(structure(c(3.88277, 50.77159), class = c("XY", 
"POINT", "sfg")), structure(c(13.856462, 50.706776), class = c("XY", 
"POINT", "sfg")), structure(c(10.491406, 46.412645), class = c("XY", 
"POINT", "sfg")), structure(c(18.84155, 43.153476), class = c("XY", 
"POINT", "sfg")), structure(c(23.636142, 45.434891), class = c("XY", 
"POINT", "sfg")), structure(c(27.53645, 42.56094), class = c("XY", 
"POINT", "sfg"))), n_empty = 0L, crs = structure(list(input = "+proj=longlat +datum=WGS84", 
    wkt = "GEOGCRS[\"unknown\",\n    DATUM[\"World Geodetic System 1984\",\n        ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n            LENGTHUNIT[\"metre\",1]],\n        ID[\"EPSG\",6326]],\n    PRIMEM[\"Greenwich\",0,\n        ANGLEUNIT[\"degree\",0.0174532925199433],\n        ID[\"EPSG\",8901]],\n    CS[ellipsoidal,2],\n        AXIS[\"longitude\",east,\n            ORDER[1],\n            ANGLEUNIT[\"degree\",0.0174532925199433,\n                ID[\"EPSG\",9122]]],\n        AXIS[\"latitude\",north,\n            ORDER[2],\n            ANGLEUNIT[\"degree\",0.0174532925199433,\n                ID[\"EPSG\",9122]]]]"), class = "crs"), class = c("sfc_POINT", 
"sfc"), precision = 0, bbox = structure(c(xmin = 3.88277, ymin = 42.56094, 
xmax = 27.53645, ymax = 50.77159), class = "bbox"))), row.names = c(NA, 
6L), sf_column = "geom", agr = structure(c(cp = NA_integer_, 
loc = NA_integer_), class = "factor", levels = c("constant", 
"aggregate", "identity")), class = c("sf", "tbl_df", "tbl", "data.frame"
))

Creating leaderboards from replay data

In order to find out the positions at each control point, I will create a 5 km buffer around each point, and claim the rider first crossing the buffer the leader. Because of this method, the times and time differences may differ from the one observed in place.

Koodi

start_time <- as.POSIXct("2022-07-24 22:00:00", tz = "CEST")


cps_buff <- sf::st_buffer(cps, dist = 5000)

cpoints <- unique(cps$cp)
cpoints <- cpoints[cpoints != "Start"]
lst <- list()
for (i in seq(cpoints)){
lst[[i]] <- dat_all_points %>% 
  st_intersection(cps_buff %>% filter(cp == cpoints[i])) %>% 
  st_drop_geometry() %>% 
  group_by(riderName) %>% 
  filter(time == min(time))  
}
leaderdata <- do.call("bind_rows", lst) %>%
  filter(!grepl("Car", riderName)) %>% 
  select(time,riderName,teamNumber,cp) %>% 
  group_by(cp) %>% 
  arrange(time) %>% 
  mutate(position = 1:n()) %>% 
  select(cp,position,riderName,time,teamNumber) %>% 
  # compute the time difference from start
  mutate(behind = difftime(time, min(time), units = "secs"),
         behind = seconds_to_period(behind),
        behind = sprintf('%01dd %02d:%02d', behind@day, behind@hour, minute(behind)),
         race_time = difftime(time, start_time, units = "secs"),
         race_time = seconds_to_period(race_time),
                 race_time = sprintf('%02dd %02d:%02d', race_time@day, race_time@hour, minute(race_time)))

Leaderboard at each control points

CP1

Leaderboard at CP1

Koodi

rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
                         filter(cp == "CP1"))

CP2

Leaderboard at CP2

Koodi

rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
                         filter(cp == "CP2"))

CP3

Leaderboard at CP3

Koodi

rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
                         filter(cp == "CP3"))

CP4

Leaderboard at CP4

Koodi

rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
                         filter(cp == "CP4"))

Finish

Leaderboard at Finish

Koodi

rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
                         filter(cp == "Finish"))

Koodi

leaderdata_leg <- do.call("bind_rows", lst) %>%
  filter(!grepl("Car", riderName)) %>% 
  filter(data_quality == "good") %>% 
  select(time,riderName,teamNumber,cp) %>% 
  # filter(grepl("Kainu", riderName)) %>% 
  arrange(cp) %>% 
  group_by(riderName) %>%
  mutate(split_time = difftime(time, lag(time), units = "secs"),
         split_time = seconds_to_period(split_time)) %>% 
  filter(!is.na(split_time)) %>% 
  mutate(leg = case_when(
    cp == "CP2" ~ "2. CP1 to CP2",
    cp == "CP3" ~ "3. CP2 to CP3",
    cp == "CP4" ~ "4. CP3 to CP4",
    cp == "Finish" ~ "5. CP4 to Finish"
  )) %>% 
  ungroup() %>%
  filter(!is.na(leg), split_time > 0) %>%
  # filter(split_time == min(split_time))
  # arrange(split_time)
  group_by(leg) %>% 
  # filter(leg == "CP1 to CP2") %>% 
  # summarise(split_time = min(split_time))
  arrange(split_time) %>% 
  mutate(position = 1:n(),
         behind = split_time - split_time[1]
         ) %>% 
  select(leg,position,riderName,teamNumber,split_time,behind) %>%
  mutate(
      split_time = sprintf('%01dd %02d:%02d', split_time@day, split_time@hour, minute(split_time)),
      behind = sprintf('%01dd %02d:%02d', behind@day, behind@hour, minute(behind))
  ) %>% 
  ungroup() %>% 
  arrange(leg,position)

# reactable::reactable(leaderdata_leg %>% filter(grepl("^2.", leg)),
#           filterable = TRUE)

Route choices between legs

Route choices are split into legs by control points, and analyzed by each leg. Route choices are analyzed based on speed, distance and elevation gain.

Fastest routes by leg

Koodi

ld <- leaderdata %>% 
  ungroup() %>% 
  distinct(riderName,teamNumber,cp,time) %>% 
  pivot_wider(names_from = cp, values_from = time)
  
# dat_all_points_fin <- dat_all_points %>% 
#   filter(grepl("Finland", country))

dat_all_points %>%
  filter(data_quality == "good",
         scratched == 0) %>%
  left_join(ld) %>% 
  mutate(leg = case_when(
    time < CP1 ~ "1. Start to CP1",
    time >= CP1 & time < CP2 ~ "2. CP1 to CP2",
    time >= CP2 & time < CP3 ~ "3. CP2 to CP3",
    time >= CP3 & time < CP4 ~ "4. CP3 to CP4",
    time >= CP4  ~ "5. CP4 to Finish"
  )) -> dat_all_points_leg

dat_all_routes2 <- dat_all_points_leg %>% 
  filter(!is.na(leg)) %>%
group_by(riderName,leg) %>% 
  summarize(m = mean(row_number()),
            leg = leg[1],
            country = country[1],
            groupHeaderLabel = groupHeaderLabel[1],
            movingTimePercentage = movingTimePercentage[1],
            totalDistance = max(totalDistance),
            finishTime = min(finishTime),
            do_union=FALSE) %>%
  st_cast("MULTILINESTRING") %>% 
  ungroup()

leaderdata_leg_total <- bind_rows(
leaderdata_leg,
# add start to CP1
leaderdata %>% 
  ungroup() %>% 
  filter(cp == "CP1") %>% 
  select(position, riderName,teamNumber,race_time,behind) %>% 
  rename(split_time = race_time) %>% 
  mutate(leg = "1. Start to CP1")
)

dat_all_routes_leg <- left_join(dat_all_routes2, 
                                leaderdata_leg_total) %>% 
  mutate(lab = paste0(stringr::str_pad(position, width = 2, pad = 0), ". ", stringr::word(riderName)))



legs <- sort(unique(dat_all_routes_leg$leg))
# lst <- list()
# for(i in seq(legs)){
# p <- ggplot(dat_all_routes_leg %>% 
#          filter(leg == legs[i],
#                 position %in% 1:9
#                 ), 
#          aes(color = lab)) + 
#   geom_sf(alpha = .8) +
#   scale_color_viridis_d() +
#   labs(title = legs[i], color = NULL) +
#   theme(panel.grid.major = element_blank(),
#         panel.grid.minor = element_blank(),
#         axis.text.x = element_blank(),
#         axis.text.y = element_blank())
# # if (i != 1) p <- p + theme(legend.position = "none")
# lst[[i]] <- p
# }
# patchwork::wrap_plots(lst, ncol = 1)

ddat <- dat_all_linestring %>% 
  filter(grepl("Mäkipää|Marin", riderName))
ddat2 <- dat_all_points %>% 
  filter(grepl("Mäkipää|Marin", riderName))


create_leaflet_fastest <- function(legi = 1){
ddat <- dat_all_routes_leg %>% 
         filter(leg == legs[legi],
                position %in% 1:10
                )

pal <- leaflet::colorFactor(palette = "Set1", domain = ddat$riderName)
labels <- sprintf(
  "%s<br/>%s behind",
  ddat$riderName, ddat$behind
) %>% lapply(htmltools::HTML)

leaflet(ddat) %>% 
  addProviderTiles(provider = providers$OpenTopoMap, options = providerTileOptions(opacity = .4)) %>%
  addPolylines(color = ~pal(riderName),
              # label = labels,
              # labelOptions = labelOptions(noHide = FALSE,
              #                           style = list("font-family" = "Lato",
              #                           "font-size" = "1.0em",
              #                           "line-height" = "1",
              #                           "font-weight" = "700",
              #                           "background-color" = "rgba(0,0,0,0)",
              #                           "border-color" = "rgba(0,0,0,0)"))
  ) %>% 
  addLegend(pal = pal, 
            values = ~riderName, opacity = 0.7, title = "riderName",
            position = "bottomright")  %>% 
  addCircleMarkers(data = ddat2,color = ~pal(riderName)) %>% 
  addFullscreenControl()
}

Leg 1: Start - CP1

Koodi

# reactable(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
#             filter(cp == "CP1"),
#           filterable = TRUE)
# 
rmarkdown::paged_table(leaderdata %>% select(cp,position,riderName,teamNumber,race_time, behind) %>% 
             filter(cp == "CP1"))

Koodi

create_leaflet_fastest(legi = 1)

Leg 2: CP1 - CP2

Koodi

rmarkdown::paged_table(leaderdata_leg %>% filter(grepl("^2.", leg)))

Koodi

create_leaflet_fastest(legi = 2)

Leg 3: CP2 - CP3

Koodi

rmarkdown::paged_table(leaderdata_leg %>% filter(grepl("^3.", leg)))

Koodi

create_leaflet_fastest(legi = 3)

Leg 4: CP3 - CP4

Koodi

rmarkdown::paged_table(leaderdata_leg %>% filter(grepl("^4.", leg)))

Koodi

create_leaflet_fastest(legi = 4)