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.

</>

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.

</>

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.

</>

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

</>

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

CP2

Leaderboard at CP2

</>

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

CP3

Leaderboard at CP3

</>

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

CP4

Leaderboard at CP4

</>

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

Finish

Leaderboard at Finish

</>

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

</>

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

</>

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

</>

# 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"))

</>

create_leaflet_fastest(legi = 1)

Leg 2: CP1 - CP2

</>

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

</>

create_leaflet_fastest(legi = 2)

Leg 3: CP2 - CP3

</>

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

</>

create_leaflet_fastest(legi = 3)

Leg 4: CP3 - CP4

</>

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

</>

create_leaflet_fastest(legi = 4)