{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.0.5"}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"markdown","source":"# Winning Strategies: What Works Better, in What Settings, and for Whom","metadata":{}},{"cell_type":"markdown","source":"In many sports, unsophisticated metrics/concepts are associated with better performance, such as superior speed, strength, dexterity, all of which are rooted in enhanced physical preparedness. In thoroughbred horse racing, the winning horses are known to be relatively faster and with an optimal stride length, causing more efficient energy spending (Wong et al., 2022). This is no surprise. However, there might be a specific variability in how athletes exploit horses’ physical potential in race settings. A jockey may, for instance, opt to save power at the beginning of a race and compensate for this by pushing a horse to its maximum anaerobic capacity in the end – albeit this was claimed to be a suboptimal strategy despite its considerable popularity (Mercier & Aftalion, 2020b). In other words, as the race unfolds, players are prone to pick different tactics relying on individual capabilities and many other factors. Some prior works have researched horses' pacing strategies and found that slowing down the least at the end of the race strongly correlates with becoming a winner (Mercier & Aftalion, 2020a; Spence et al., 2012).\n\nIn this notebook, we continue this line of inquiry and concentrate on the following issues. What is the classification of strategies jockeys typically use in a race? How are these strategies related to jockeys' positions at the end of a race? What can influence these relationships (e.g., the type of the course, horses' velocity limits, and jockeys' experience)? Appropriate answers to these questions suit effective decision-making. Mainly, they help stakeholders discover insights on how to optimise jockeys’/horses’ productivity and align analytic recommendations to a specific individual and environmental circumstances. Complex statistical tools and high-quality granular data can help untangle those effects of interest; here, we attempt to unpack the application of both.","metadata":{}},{"cell_type":"markdown","source":"![](https://i.ibb.co/LPnfR03/4444.jpg)\n[source of the photo](https://www.newyorker.com/magazine/2021/05/24/can-horse-racing-survive)","metadata":{}},{"cell_type":"markdown","source":"We start by unveiling a typology of jockeys’/horses’ trajectories. To achieve this, we conduct a hierarchical clustering (with Ward agglomeration algorithm) by leveraging two key variables from the tracking data [to normalise tracks of different lengths, all metrics are quantified at 20 equidistant timeframes, covering every 5% of a race from start to end]:\n\n1.\t**Difference between a jockey’s / horse’s speed and the mean speed of their competitors.** We chose this measure since speed is a popular indicator in horse racing studies, unambiguously describing players’ performance at a selected moment in a race.\n2.\t**Jockey's / horse's closeness to the inside of a track.** The metric is essential since being towards the track’s centre gives a jockey a distance-based advantage. To compute the metric, we create new coordinates in a two-dimensional space for players using their average movement vector and a rotation matrix, pick the X-values on those coordinates for each jockey, and then apply the min-max standardisation. At each moment, there is a jockey closest to the inside of a track, who gets 1 (or 100%), and a jockey closest to the outside of a track, who gets 0 (or 0%). Generally, the metric is devised to measure how scattered jockeys are in width.\n","metadata":{}},{"cell_type":"code","source":"# This R environment comes with many helpful analytics packages installed\n# It is defined by the kaggle/rstats Docker image: https://github.com/kaggle/docker-rstats\n# For example, here's a helpful package to load\noptions(warn=-1)\n\n# library(tidyverse) # metapackage of all tidyverse packages\nlibrary(ggplot2)\nlibrary(sf)\nlibrary(units)\nlibrary(lme4)\nlibrary(gganimate)\nlibrary(magrittr)\nlibrary(dplyr)\nlibrary(data.table)\nlibrary(stringr)\nlibrary(ggpubr)\ninstall.packages('circular')\nlibrary(circular)\nlibrary(dendextend)\nlibrary(repr)\nlibrary(ggpubr)\nlibrary(magick)\n\n# setwd('../input/')\n\n# Load main dataset\ndf_main <- rio::import('../input/big-data-derby-2022/nyra_2019_complete.csv')\n\n# ------------------------------------------------------------------------------\n# --------------- 1. Initial preprocessing\n# ------------------------------------------------------------------------------\n\n# Change column names\ncolnames(df_main) <- c('track_id','race_date','race_number','program_number',\n 'trakus_index','latitude','longitude','distance_id',\n 'course_type','track_condition','run_up_distance','race_type',\n 'purse','post_time','weight_carried','jockey','odds','position_at_finish')\n\n# Preprocessing\ndf_main <- df_main %>%\n mutate(race_date = as.Date(race_date),\n program_number = trimws(program_number),\n race_id = paste(as.character(track_id),\n as.character(race_date),\n as.character(race_number),\n sep = '_'),\n horse_race_id = paste(as.character(track_id),\n as.character(race_date),\n as.character(race_number),\n as.character(program_number),\n sep = '_')\n ) %>%\n # Remove 'Hurdle' races\n # see https://www.kaggle.com/competitions/big-data-derby-2022/discussion/344315\n filter(course_type != 'M')\n\n# Add dataset with horse id and names\ndf_horses <- read.csv('../input/big-data-derby-2022-global-horse-ids-and-places/horse_ids.csv')\ndf_horses_names <- read.csv('../input/big-data-derby-2022-global-horse-ids-and-places/horse_names.csv') %>% \n dplyr::select(-c(X))\ndf_horses <- df_horses %>%\n left_join(df_horses_names) %>%\n dplyr::select(-c(X)) %>%\n rename(race_number=race) %>%\n mutate(race_date = as.Date(race_date))\n\n# --- merge\ndf_main <- df_main %>%\n left_join(df_horses, by=c('track_id', 'race_date', 'race_number', 'program_number'))\n# Drop useless columns\ndf_main <- df_main %>%\n dplyr::select(-c(finishing_place))\n# saveRDS(df_main, 'df_main.rds')\n\n# --- to sf\ndf_main$x <- df_main$longitude\ndf_main$y <- df_main$latitude\nsf_main <- st_as_sf(x = df_main, coords = c('longitude', 'latitude')) %>%\n st_set_crs(\"EPSG:4326\")\nsf_main <- arrange(sf_main, trakus_index)\n# saveRDS(sf_main, 'sf_main.rds')\n\n# --- to data.table\ndt_main <- sf_main %>% as.data.table()\n\n\n# ------------------------------------------------------------------------------\n# --------------- 2. Correct frames\n# ------------------------------------------------------------------------------\n\n# 1. Remove frames before the error and after the finish line\n\nremoveFramesWithErrorsDt <- function(sf_horse_race){\n \n \n # Estimate distance\n sf_horse_race$distance <- sf::st_distance(sf_horse_race$geometry,\n lag(sf_horse_race$geometry),\n by_element = TRUE)\n \n sf_horse_race$distance <- as.numeric(sf_horse_race$distance)\n \n # Cumulative distance\n distance_cum <- cumsum(tidyr::replace_na(sf_horse_race$distance, 0))\n distance_cum <- distance_cum[2:length(distance_cum)]\n sf_horse_race$distance_cum <- c(0, distance_cum)\n \n # Error: No movement or Surge in distance\n sf_horse_race$error <- (sf_horse_race$distance == 0 |\n sf_horse_race$distance > 10)\n \n if (any(sf_horse_race$error, na.rm=T)){\n trakus_after_error <- max(sf_horse_race[sf_horse_race$error]$trakus_index, na.rm=T)\n sf_horse_race <- sf_horse_race[trakus_index > trakus_after_error]\n }\n \n return(sf_horse_race)\n \n}\n\ndt_main <- (dt_main[, removeFramesWithErrorsDt(.SD), by = .(horse_race_id)])\n\n\n# ------------------------------------------------------------------------------\n# --------------- 3. Filter out observations after the finish line\n# ------------------------------------------------------------------------------\n\n# Use 'distance_id' to calculate percentage of completed track\ndt_main$distance_track <- dt_main$distance_id*2.01168\ndt_main$race_distance_pct <- (dt_main$distance_cum / dt_main$distance_track)\n\n# Cut after the finish line\ndt_main <- dt_main[race_distance_pct <= 1]\n\n\n# ------------------------------------------------------------------------------\n# --------------- 4. Calculate movement angle (theta)\n# ------------------------------------------------------------------------------\n\ngetDistance <- function(coord, next_coord) {\n speed = (next_coord - coord)\n return(speed)\n}\n\ngetThetaDt <- function(df){\n \n df$dist_x <- getDistance(df$x, lead(df$x))\n df$dist_y <- getDistance(df$y, lead(df$y))\n df$theta <- as.numeric(circular::coord2rad(cbind(df$dist_x, df$dist_y)))\n \n return(df)\n \n}\n\ndt_main <- (dt_main[, getThetaDt(.SD), by = .(horse_race_id)])\ndt_main <- dt_main[!is.na(dt_main$theta),]\n\n\n# ------------------------------------------------------------------------------\n# --------------- 5. Get new rotated coordinates\n# ------------------------------------------------------------------------------\n\ngetRotationMatrix <- function(theta){\n \n R = matrix(c(cos(theta), sin(theta),\n -sin(theta), cos(theta)), nrow = 2)\n R = R %*% matrix(c(0, 1, 1, 0), nrow = 2, ncol = 2)\n \n return(R)\n \n}\n\n\nrotateCoordinatesFrameDt <- function(dt_frame){\n \n # Average theta\n mean_theta <- mean(dt_frame$theta)\n \n # Rotated matrix of coordinates\n matrix_original <- as.matrix(data.frame(x=dt_frame$x, y=dt_frame$y))\n \n rotation_matrix <- getRotationMatrix(mean_theta)\n \n matrix_rotated <- matrix_original %*% rotation_matrix\n \n # Add rotated coordinates\n dt_frame$x_rotated <- matrix_rotated[,1]\n dt_frame$y_rotated <- matrix_rotated[,2]\n \n return(dt_frame)\n \n}\n\n\nrotateCoordinatesRaceDt <- function(dt_race){\n \n dt_race <- dt_race[, rotateCoordinatesFrameDt(c(.BY, .SD)), by = trakus_index]\n \n return(dt_race)\n \n}\n\nvec_race_ids <- unique(dt_main$race_id)\nlist_main <- list()\nfor (i in 1:length(vec_race_ids)){\n \n dt_race <- dt_main %>% filter(race_id==vec_race_ids[i])\n dt_race <- rotateCoordinatesRaceDt(dt_race)\n list_main[[i]] <- dt_race\n # print(i)\n \n}\n\ndt_main <- data.table::rbindlist(list_main)\n\n\n# ------------------------------------------------------------------------------\n# --------------- 6. Calculate variables for individuals and environment\n# ------------------------------------------------------------------------------\n\ncalculateVariablesInd <- function(df_horse_race){\n \n # --- Calculate speed\n df_horse_race$speed <- df_horse_race$distance*4\n df_horse_race$speed <- as_units(as.numeric(df_horse_race$speed), 'm/s')\n return(df_horse_race)\n \n}\n\n\n# --- Calculate individual variables\ndt_main <- dt_main[, calculateVariablesInd(c(.BY, .SD)), by = horse_race_id]\n\n\n# --- Calculate sum and min, max of all jockeys\ndt_env <- dt_main[, .(jockey_n = .N,\n speed_sum_all = sum(speed, na.rm=T),\n x_rotated_sum=sum(x_rotated, na.rm=T),\n x_rotated_min_all=min(x_rotated, na.rm=T),\n x_rotated_max_all=max(x_rotated, na.rm=T)),\n by = c('race_id', 'trakus_index')]\n\ndt_main <- dt_env[dt_main, on = .(race_id, trakus_index)]\n\n\n# Calculate mean speed of the environment\ndt_main$speed_env <- (dt_main$speed_sum_all - dt_main$speed) / (dt_main$jockey_n - 1)\n\n# Inside Closenesss\ndt_main$inside_close <- ((dt_main$x_rotated-dt_main$x_rotated_min_all) /\n (dt_main$x_rotated_max_all-dt_main$x_rotated_min_all))\n# Speed difference\ndt_main$speed_diff <- as.numeric(dt_main$speed - dt_main$speed_env)\n\n# Split track on N parts\ndt_main$race_distance_index.100 <- as.integer(dt_main$race_distance_pct*100)\ndt_main$race_distance_index.20 <- as.integer(dt_main$race_distance_index.100/5) + 1\n\n\n# ------------------------------------------------------------------------------\n# --------------- 7. SAVE\n# ------------------------------------------------------------------------------\n\n# setwd('/kaggle/working')\n# df_main <- dt_main %>% data.frame()\n# saveRDS(df_main, 'df_main.rds')\n\n\n# setwd('/kaggle/working')\n# df_main <- readRDS('df_main.rds')\n\n# ------------------------------------------------------------------------------\n# --------------- 8. SPLIT INTO PERIODS\n# ------------------------------------------------------------------------------\n\n# Convert back to data.frame \ndf_main <- dt_main %>% data.frame()\n\n# --- Split into 20 periods (for clustering)\n\n# Group by race_distance\ndf_main.20 <- df_main %>%\n group_by(horse_race_id, race_distance_index.20) %>%\n summarise(speed_diff=mean(speed_diff, na.rm=T),\n inside_close=mean(inside_close, na.rm=T))\n\n# To wide\ndf_main.20.speed_diff <- df_main.20 %>%\n dplyr::select(speed_diff, race_distance_index.20, horse_race_id) %>%\n tidyr::pivot_wider(., names_from=race_distance_index.20, values_from=speed_diff,\n names_prefix = 'speed_diff_')\n\ndf_main.20.inside_close <- df_main.20 %>%\n dplyr::select(inside_close, race_distance_index.20, horse_race_id) %>%\n tidyr::pivot_wider(., names_from=race_distance_index.20, values_from=inside_close,\n names_prefix = 'inside_close_')\n\ndf_main.20 <- df_main.20.speed_diff %>% left_join(df_main.20.inside_close)\n\ndf_main.20[is.na(df_main.20)] <- 0\ndf_main.20 <- df_main.20 %>% ungroup()\n\n\n# --- Split into 100 periods (for plotting) \n# Group by race_distance\ndf_main.100 <- df_main %>%\n group_by(horse_race_id, race_distance_index.100) %>%\n summarise(speed_diff=mean(speed_diff, na.rm=T),\n inside_close=mean(inside_close, na.rm=T))\n\n# To wide\ndf_main.100.speed_diff <- df_main.100 %>%\n dplyr::select(speed_diff, race_distance_index.100, horse_race_id) %>%\n tidyr::pivot_wider(., names_from=race_distance_index.100, values_from=speed_diff,\n names_prefix = 'speed_diff_')\n\ndf_main.100.inside_close <- df_main.100 %>%\n dplyr::select(inside_close, race_distance_index.100, horse_race_id) %>%\n tidyr::pivot_wider(., names_from=race_distance_index.100, values_from=inside_close,\n names_prefix = 'inside_close_')\n\ndf_main.100 <- df_main.100.speed_diff %>% left_join(df_main.100.inside_close)\n\ndf_main.100[is.na(df_main.100)] <- 0\ndf_main.100 <- df_main.100 %>% ungroup()\n\n\n# ------------------------------------------------------------------------------\n# --------------- 9. CLUSTER SOLUTION\n# ------------------------------------------------------------------------------\n\n# Fit hieracical clustering model\nmodel.hc <- hclust(dist(df_main.20 %>% dplyr::select(-c(horse_race_id))),\n method ='ward.D')\n\n# Get the clusters\nvec_clusters <- cutree(model.hc, k = 4)\nvec_clusters <- paste0('clust_', as.character(vec_clusters))\nvec_clusters <- dplyr::recode(vec_clusters,\n 'clust_4' = 'clust_3', 'clust_2' = 'clust_4', 'clust_3' = 'clust_2')\n\n# Colors\nblue_color = '#377EB8'\ngreen_color = '#4DAF4A'\nred_color = '#E41A1C'\n\n# Colored branches\ndend.hc <- model.hc %>% as.dendrogram\ndend.hc <- dend.hc %>%\n dendextend::set(\"labels\", c(rep(NA, length(labels(dend.hc))))) %>%\n dendextend::set(\"branches_lwd\", 1) %>%\n dendextend::set(\"labels_col\", k=4) %>%\n dendextend::set(\"branches_k_color\",\n value = c(red_color, green_color, blue_color, 'darkgrey'), k = 4)\n\n# To ggplot\ngg.hc <- as.ggdend(dend.hc)\n","metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"execution":{"iopub.status.busy":"2023-01-20T19:47:36.777483Z","iopub.execute_input":"2023-01-20T19:47:36.780655Z","iopub.status.idle":"2023-01-20T20:13:46.706436Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# 1. Types of Strategies","metadata":{}},{"cell_type":"markdown","source":"In determining an optimal cluster solution, we relied on the dendrogram – a diagrammatic illustration of hierarchical clustering. It can be noticed that the four clusters of trajectories are the most discernible (they seem internally packed and somewhat isolated from other clusters); hence we proceed with this arrangement.","metadata":{}},{"cell_type":"code","source":"# ------------------------------------------------------------------------------\n# --------------- DENDROGRAM PLOT\n# ------------------------------------------------------------------------------\n\noptions(repr.plot.width=15, repr.plot.height = 6, warn=-1)\n\nggplot(gg.hc, theme = theme_void()) + ggtitle(\"Dendrogram of Jockeys' Strategies\") +\n theme(plot.title = element_text(size=28, hjust = 0.5)) +\n ylim(-1500, 5000) +\n # --- CLUSTER NAME AND N\n annotate(\"text\",\n x=1500,\n # y=2600,\n y=-700,\n label= \"Slow Start\\nwith Breakthrough End &\\nInside-Outside Move\",\n size = 6, color=red_color) +\n annotate(\"text\",\n x=1700,\n y=2550,\n # y=-700,\n label= \"n=2986\",\n size = 6, color=red_color) +\n # --- CLUSTER NAME AND N\n annotate(\"text\",\n x=4900,\n y=-500,\n # y=2600,\n label= \"Persistent Growth &\\nOutside-Middle Move\",\n size = 6, color=green_color) +\n annotate(\"text\",\n x=4000,\n y=2550,\n label= \"n=3287\",\n size = 6, color=green_color) +\n # --- CLUSTER NAME AND N\n annotate(\"text\",\n x=9000,\n # y=3000,\n y=-500,\n label= \"Good Start with Stability &\\nMiddle-Inside Move\",\n size = 6, color=blue_color) +\n annotate(\"text\",\n x=9000,\n y=3000,\n label= \"n=5474\",\n size = 6, color=blue_color) +\n # --- CLUSTER NAME AND N\n annotate(\"text\",\n x=13000,\n y=-500,\n label= \"Persistent Decline &\\nMiddle Move\",\n size = 6, color='darkgrey') +\n annotate(\"text\",\n x=12300,\n y=3000,\n label= \"n=3030\",\n size = 6, color='darkgrey')\n","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2023-01-20T20:15:11.694212Z","iopub.execute_input":"2023-01-20T20:15:11.726625Z","iopub.status.idle":"2023-01-20T20:15:13.687766Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n# # THE ANIMATION BELOW WAS CREATED USING THE UPLOADED .GIFS. THEY CAN BE OBTAINED IN RSTUDIO USING THIS CHUNK OF CODE\n# # KAGGLE NOTEBOOK DOESN'T ALLOW TO LOAD .GIFS DIRECTLY FROM THE ENVIRONMENT\n# # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n# \n# \n# # --- PREPARE FOR CLUSTER PLOTING\n# df_main.100$cluster <- vec_clusters\n# \n# # Dataset with speed difference in long format\n# df_main.100.speed_diff <- df_main.100 %>%\n# dplyr::select(horse_race_id, cluster, starts_with(\"speed_diff\")) %>%\n# tidyr::pivot_longer(cols = starts_with(\"speed_diff\"),\n# values_to = \"speed_diff\",\n# names_to = \"distance_pct\") %>%\n# mutate(distance_pct=as.numeric(str_replace_all(distance_pct, 'speed_diff_', '')))\n# SPEED_CUT <- 1.5\n# df_main.100.speed_diff[df_main.100.speed_diff$speed_diff > SPEED_CUT,]$speed_diff <- SPEED_CUT\n# df_main.100.speed_diff[df_main.100.speed_diff$speed_diff < -SPEED_CUT,]$speed_diff <- -SPEED_CUT\n# \n# # Dataset with inside closeness in long format\n# df_main.100.inside_close <- df_main.100 %>%\n# dplyr::select(horse_race_id, cluster, starts_with(\"inside_close\")) %>%\n# tidyr::pivot_longer(cols = starts_with(\"inside_close\"),\n# values_to = \"inside_close\",\n# names_to = \"distance_pct\") %>%\n# mutate(distance_pct=as.numeric(str_replace_all(distance_pct, 'inside_close_', '')))\n# \n# \n# createPlotSpeedDiff <- function(df, cluster_name){\n# \n# # Select cluster\n# df <- df %>% filter(cluster == cluster_name)\n# \n# # Sample\n# set.seed(1)\n# SAMPLE_SIZE <- 100\n# sample_ids <- sample(df$horse_race_id, SAMPLE_SIZE)\n# df <- df %>% filter(horse_race_id %in% sample_ids)\n# line_colors <- c(rep(adjustcolor('lightgray', 0.6), SAMPLE_SIZE))\n# \n# # Remove last 5% for plotting\n# df <- df %>% filter(distance_pct <= 95)\n# \n# # Create plot\n# plot <- ggplot(df, aes(x = distance_pct, y = speed_diff)) +\n# \n# geom_line(aes(color=horse_race_id), size = 0.5) +\n# \n# scale_color_manual(values = line_colors) +\n# stat_summary(fun.data = \"mean_cl_boot\", geom = \"smooth\", color='black', size=1) +\n# theme_classic() +\n# \n# geom_hline(yintercept = 0, linetype=\"dotted\", color = \"coral2\", size=1.5) +\n# \n# labs(x = \"Distance covered, pct\",\n# y = \"Speed Difference\") +\n# theme(\n# legend.position = \"none\",\n# plot.title = element_text(size=18, hjust = 0.5),\n# axis.title=element_text(size=12),\n# axis.text=element_text(size=12)) +\n# \n# ggtitle(\"Speed Difference\")\n# \n# return (plot)\n# \n# }\n# \n# \n# createPlotInsideCloseness <- function(df, cluster_name){\n# \n# # Select cluster\n# df <- df %>% filter(cluster == cluster_name)\n# \n# # Remove last 5% for plotting\n# df <- df %>% filter(distance_pct <= 95)\n# \n# # Sample\n# set.seed(1)\n# SAMPLE_SIZE <- 100\n# sample_ids <- sample(df$horse_race_id, SAMPLE_SIZE)\n# df <- df %>% filter(horse_race_id %in% sample_ids)\n# line_colors <- c(rep(adjustcolor('lightgray', 0.6), SAMPLE_SIZE))\n# \n# \n# # Create plot\n# plot <- ggplot(df, aes(x = distance_pct, y = inside_close)) +\n# \n# geom_line(aes(color=horse_race_id), size = 0.5) +\n# \n# scale_color_manual(values = line_colors) +\n# stat_summary(fun.data = \"mean_cl_boot\", geom = \"smooth\", color='black', size=1) +\n# theme_classic() +\n# \n# geom_hline(yintercept = 0.5, linetype=\"dotted\", color = \"coral2\", size=1.5) +\n# \n# labs(x = \"Distance covered, pct\",\n# y = \"Inside Closeness\") +\n# theme(\n# legend.position = \"none\",\n# plot.title = element_text(size=18, hjust = 0.5),\n# axis.title=element_text(size=12),\n# axis.text=element_text(size=12)) +\n# \n# ggtitle(\"Inside Closeness\")\n# \n# return (plot)\n# \n# }\n# \n# \n# # --- CREATE PLOTS WITH SPEED DIFFERENCE AND INSIDE CLOSENESS MEAN AND SAMPLE\n# \n# # Cluster 1\n# g.clust.1 <- ggarrange(createPlotSpeedDiff(df_main.100.speed_diff, 'clust_1'),\n# createPlotInsideCloseness(df_main.100.inside_close, 'clust_1'),\n# nrow=2)\n# ggsave(\"cluster_1.jpg\", width = 17, height = 12, units = \"cm\", g.clust.1, dpi=100)\n# \n# # Cluster 2\n# g.clust.2 <- ggarrange(createPlotSpeedDiff(df_main.100.speed_diff, 'clust_2'),\n# createPlotInsideCloseness(df_main.100.inside_close, 'clust_2'),\n# nrow=2)\n# ggsave(\"cluster_2.jpg\", width = 17, height = 12, units = \"cm\", g.clust.2, dpi=100)\n# \n# # Cluster 3\n# g.clust.3 <- ggarrange(createPlotSpeedDiff(df_main.100.speed_diff, 'clust_3'),\n# createPlotInsideCloseness(df_main.100.inside_close, 'clust_3'),\n# nrow=2)\n# ggsave(\"cluster_3.jpg\", width = 17, height = 12, units = \"cm\", g.clust.3, dpi=100)\n# \n# # Cluster 4\n# g.clust.4 <- ggarrange(createPlotSpeedDiff(df_main.100.speed_diff, 'clust_4'),\n# createPlotInsideCloseness(df_main.100.inside_close, 'clust_4'),\n# nrow=2)\n# ggsave(\"cluster_4.jpg\", width = 17, height = 12, units = \"cm\", g.clust.4, dpi=100)\n# \n# animateRace <- function(df_main, selected_race, selected_horse_race_id, ego_color){\n# \n# df_race <- df_main %>% filter(race_id == selected_race)\n# df_race$selected_jockey <- (df_race$horse_race_id == selected_horse_race_id)\n# df_race$speed <- as.numeric(df_race$speed)\n# df_race$x_lead <- lead(df_race$x)\n# df_race$y_lead <- lead(df_race$y)\n# df_race$x_lead <- rowMeans(df_race[,c('x', 'x_lead')])\n# df_race$y_lead <- rowMeans(df_race[,c('y', 'y_lead')])\n# \n# nFrames <- max(df_race$trakus_index)\n# \n# anim <- ggplot(df_race, aes(x, y)) +\n# \n# geom_point(aes(fill = selected_jockey,\n# alpha = selected_jockey), size =18, pch=21) +\n# geom_text(aes(label=jockey), hjust=0.5, vjust=-2.7) +\n# geom_segment(aes(yend = y_lead, xend = x_lead, alpha = selected_jockey),\n# size = 1, color='grey',\n# arrow = arrow(length = unit(0.03, \"npc\"))) +\n# scale_alpha_discrete(range = c(0.5, 0.9)) +\n# scale_fill_manual(values = c(\"white\", ego_color)) +\n# labs(x = 'longitude', y = 'latitude') +\n# theme_minimal() +\n# theme(axis.ticks.x=element_blank(),\n# axis.text.x=element_blank(),\n# axis.ticks.y=element_blank(),\n# axis.text.y=element_blank(),\n# plot.title = element_text(hjust = 0.5, size=18),\n# legend.position=\"none\") +\n# ggtitle(paste0('Example: ',\n# str_replace_all(selected_race, '_', ', '),\n# '. Trakus Index: {frame}')) +\n# #setting animation parameters\n# view_follow() +\n# transition_time(trakus_index) +\n# ease_aes('linear')\n# \n# gif <- gganimate::animate(anim, width = 720, height = 440, fps = 10, nframe = nFrames)\n# \n# return(gif)\n# \n# }\n# \n# \n# # Add cluster to df_main\n# df_main <- df_main %>%\n# left_join(df_main.100 %>% dplyr::select(horse_race_id, cluster))\n# \n# # Stop tracking after 1st player finish the race\n# df_temp <- df_main %>% group_by(race_id) %>%\n# summarise(jockey_n_max=max(jockey_n)) %>%\n# dplyr::select(c(race_id, jockey_n_max))\n# df_main <- df_main %>% left_join(df_temp) %>% filter(jockey_n == jockey_n_max)\n# \n# \n# # --- SELECT EXAMPLES FOR EACH CLUSTER\n# selected_horse_race_id.1 <- \"SAR_2019-07-11_2_2\"\n# selected_horse_race_id.2 <- \"SAR_2019-09-01_4_8\"\n# selected_horse_race_id.3 <- \"SAR_2019-08-17_8_7\"\n# selected_horse_race_id.4 <- \"SAR_2019-07-14_9_8\"\n# \n# # --- CREATE GIFS FOR EACH EXAMPLE \n# selected_race.1 <- str_sub(selected_horse_race_id.1, end=-3)\n# gif.1 <- animateRace(df_main, selected_race.1, selected_horse_race_id.1,\n# ego_color = '#377EB8')\n# selected_race.2 <- str_sub(selected_horse_race_id.2, end=-3)\n# gif.2 <- animateRace(df_main, selected_race.2, selected_horse_race_id.2,\n# ego_color = '#4DAF4A')\n# selected_race.3 <- str_sub(selected_horse_race_id.3, end=-3)\n# gif.3 <- animateRace(df_main, selected_race.3, selected_horse_race_id.3,\n# ego_color = '#E41A1C')\n# selected_race.4 <- str_sub(selected_horse_race_id.4, end=-3)\n# gif.4 <- animateRace(df_main, selected_race.4, selected_horse_race_id.4,\n# ego_color = 'darkgrey')\n# \n# \n# blue_color = '#377EB8'\n# green_color = '#4DAF4A'\n# red_color = '#E41A1C'\n# \n# \n# combineAnimationPlot <- function(picture_path, gif, file_combined_name, title, title_color){\n# \n# mgif.left <- image_read(picture_path)\n# mgif.right <- image_read(gif)\n# \n# combined <- image_append(c(mgif.left[1], mgif.right[1]))\n# white <- image_blank(image_info(combined)$width, 80, \"white\")\n# white <- image_convert(white, \"jpeg\")\n# combined <- image_append(c(white, combined), stack = T)\n# combined <- combined %>% image_annotate(title, size = 40, gravity = 'north',\n# color = title_color) # <<< TODO: CHANGE\n# \n# mgif.combined <- image_append(combined)\n# \n# print(length(mgif.right))\n# \n# for(i in 2:length(mgif.right)){\n# \n# combined <- image_append(c(mgif.left[1], mgif.right[i]))\n# white <- image_blank(image_info(combined)$width, 80, \"white\")\n# white <- image_convert(white, \"jpeg\")\n# combined <- image_append(c(white, combined), stack = T)\n# combined <- combined %>% image_annotate(title, size = 40, gravity = 'north',\n# color = title_color)\n# mgif.combined <- c(mgif.combined, combined)\n# \n# }\n# \n# # mgif.combined\n# image_write(mgif.combined, path = file_combined_name, format = \"gif\")\n# \n# \n# end_time <- Sys.time()\n# print(end_time - start_time)\n# \n# }\n# \n# \n# # --- OBTAIN COMBINED PLOTS + GIFS FOR EACH CLUSTERS\n# gc()\n# combineAnimationPlot('cluster_1.jpg', gif.1, 'cluster_1.gif',\n# '1. Good Start with Stability & Middle-Inside Move', '#377EB8')\n# gc()\n# combineAnimationPlot('cluster_2.jpg', gif.2, 'cluster_2.gif',\n# '2. Persistent Growth & Outside-Middle Move', '#4DAF4A')\n# gc()\n# combineAnimationPlot('cluster_3.jpg', gif.3, 'cluster_3.gif',\n# '3. Slow Start with Breakthrough End & Inside-Outside Move', '#E41A1C')\n# gc()\n# combineAnimationPlot('cluster_4.jpg', gif.4, 'cluster_4.gif',\n# '4. Persistent Decline & Middle Move', 'darkgrey')\n# gc()","metadata":{"execution":{"iopub.status.busy":"2022-11-10T20:24:12.366335Z","iopub.execute_input":"2022-11-10T20:24:12.368284Z","iopub.status.idle":"2022-11-10T20:24:12.389542Z"},"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"To facilitate the interpretation of the resulting clusters, let us visually inspect the distribution of the initial variables for each cluster and show them side-by-side with the relevant animated examples of jockeys’ actual movements (presented on the right). In the left part of the panes, grey lines depict all trajectories falling in a respective cluster; black lines reflect clusters' averages; red dotted lines show 0 for the speed difference and the middle of a track for the inside closeness.\n\nThe first cluster – *Good Start with Stability & Middle-Inside Move* – denotes strategies with the fastest movement at the start compared to other strategies and a quick decline in velocity till plateau values, marginally fluctuating around the mean. On average, a jockey/horse from this cluster (after roughly the first 5% of the race) gets relocated from the middle of a course to its inner border.","metadata":{}},{"cell_type":"markdown","source":"![1](https://s.imgfi.com/images/strategy_1.gif)","metadata":{}},{"cell_type":"markdown","source":"The second cluster – *Persistent Growth & Outside-Middle Move* – includes jockeys/horses who moderately but steadily speed up as the race unfolds (the black line gets lifted above the average). Also, those jockeys/horses are primarily placed closer to the outer part of a track and slightly shift towards its centre at the end.","metadata":{}},{"cell_type":"markdown","source":"![2](https://s.imgfi.com/images/strategy_2.gif)","metadata":{}},{"cell_type":"markdown","source":"The third cluster – *Slow Start with Breakthrough End & Inside-Outside Move* – characterises jockeys lagging behind others in speed but unleashing the burst of speed towards the finish. Most of the race, they are situated closer to the inside edge of a track but switch to the outside rail when their speed starts to rocket.","metadata":{}},{"cell_type":"markdown","source":"![3](https://s.imgfi.com/images/strategy_3.gif)","metadata":{}},{"cell_type":"markdown","source":"The fourth cluster – *Persistent Decline & Middle Move* – encompasses stagnating velocity trajectories in the first half of a race (compared to the competitors’ average); this is followed by a severe slowing down in the second half. As for the location, it seems to fluctuate around the middle of the course.","metadata":{}},{"cell_type":"markdown","source":"![4](https://s.imgfi.com/images/strategy_4.gif)","metadata":{}},{"cell_type":"markdown","source":"# 2. Effectiveness of Strategies\n\n## 2.1. Multilevel Model Description\n\nNext, we would like to infer which trajectory pattern (amongst the ones listed above) offers the best position at the finish line and how this varies based on different attributes. For this purpose, a multilevel modelling analysis with a cross-classified membership is employed – this allows us to account for the observations being nested within jockeys and horses simultaneously, thus capturing the heterogeneity stemming from multiple groupings in the data.\n\nA more formal description of the general model is presented below for transparency.\n\nFirst level\n\n$$\nPlace\\_at\\_ Finish_{ijh} = \n\\beta_{0jh} + \\beta_{cjh}*Cluster\\_Membership_{ijh} + \\\\ \n\\beta_{njh}*Controls_{ijh} + \\epsilon_{ijh}\n$$\n\nSecond level\n\n$$\n\\beta_{0jh} = \\gamma_{000} + u_{0j0} + s_{00h} \\\\\n\\beta_{cjh} = \\gamma_{c00} + u_{cj0}, \\ for\\ c ∈ \\ {1,2,3}\n$$\n\nwhere an observation $i$ is nested within a jockey $j$ and horse $h$, s is the number of cluster memberships minus one (the reference group), n is the number of control variables;\n\nall betas are regression parameter estimates with gammas being their jockey- and horse-level intercepts;\n\n$u_{0j0}$, $s_{00h}$ are random intercepts by jockeys and horses respectively;\n\n$u_{cj0}$ is a random slope by jockeys for the effect of trajectories on the final place in the race.\n\n$\\epsilon$ is a normally distributed error term.\n","metadata":{}},{"cell_type":"code","source":"# ------------------------------------------------------------------------------\n# --------------- MULTILEVEL: PREPROCESSING\n# ------------------------------------------------------------------------------\n\ndf_stats <- df_main %>% distinct(horse_race_id, .keep_all = T) %>%\n dplyr::select(horse_race_id, jockey, race_id, horse_id, distance_id, jockey_n,\n position_at_finish, purse, course_type, track_condition, program_number)\n\ndf_main.20 <- df_main.20 %>% left_join(df_stats)\n\ndf_main.20$horse_id <- paste0(as.character('h_'), df_main.20$horse_id)\n\ndf_main.20$cluster <- vec_clusters\ndf_main.20$cluster <- relevel(as.factor(df_main.20$cluster), ref = 'clust_4')\n\n# Avg.horse speed\ndf_stats.horse <- df_main %>%\n group_by(horse_id) %>% summarise(mean_horse_speed=mean(speed, na.rm=T))\ndf_stats.horse$horse_id <- paste0(as.character('h_'), df_stats.horse$horse_id)\n\n# Jockey experience\ndf_stats.jockey <- df_main.20 %>%\n group_by(jockey) %>%\n summarise(jockey_games=n())\n\n\n# normalise dependent var\nnormalize = function(x, na.rm = TRUE) {\n return((x- min(x)) /(max(x)-min(x)))\n}\n\n\ndf_main.20 <- df_main.20 %>% group_by(race_id) %>%\n dplyr::mutate(position_at_finish_minmax = normalize(-position_at_finish))\n\n\n# Add horse_speed\ndf_main.20 <- df_main.20 %>% left_join(df_stats.horse, by='horse_id')\n\n# Add jockey_games\ndf_main.20 <- df_main.20 %>% left_join(df_stats.jockey, by='jockey')\n\n# Create variables for interactions\ndf_main.20$track_condition_bin <- ifelse(\n df_main.20$track_condition %in% c('FM', 'FT ','GD'), 1, 0)\n\ndf_main.20$distance_cat <- cut(df_main.20$distance_id,\n breaks=c(0,600, 800, 1600),\n labels=c('short', 'medium', 'long'))\ndf_main.20$distance_cat <- relevel(df_main.20$distance_cat, ref='short')\n\n# Binarise course type\ndf_main.20$course_type <- as.numeric(df_main.20$course_type == 'D')\n\n# Scale variables\ndf_main.20$distance_id <- as.numeric(scale(df_main.20$distance_id))\ndf_main.20$jockey_games <- as.numeric(scale(df_main.20$jockey_games))\ndf_main.20$mean_horse_speed <- as.numeric(scale(df_main.20$mean_horse_speed))\ndf_main.20$purse <- as.numeric(scale(df_main.20$purse))\n\n# Program number\ndf_main.20$program_number <- relevel(as.factor(df_main.20$program_number), ref='1')\n\n\n# --------------------------- GENERAL MODEL\n\n# random effects\nmod0 = suppressMessages(lmer(position_at_finish_minmax ~ cluster +\n distance_id + mean_horse_speed + jockey_games + mean_horse_speed +\n course_type + jockey_n + track_condition_bin + program_number +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n# summary(mod0)\n\nlibrary(kableExtra)\nlibrary(xtable)\ncoefs = as.data.frame(summary(mod0)$coefficients)\nnames(coefs) = c('Estimate', 'Std.Error', 't')\ncoefs %<>% dplyr::mutate(Significance = ifelse(abs(t) >= 1.64 & abs(t) < 1.96, '.',\n ifelse(abs(t) >= 1.96 & abs(t) < 2.58, '*',\n ifelse(abs(t) >= 1.96 & abs(t) < 2.58, '**',\n ifelse(abs(t) >= 2.58, '***', ''))))) %>%\n select(Estimate, Std.Error, Significance)\nrownames(coefs) = NULL\nrownames = c('Intercept', \n '1. Good Start with Stability & Middle-Inside Move',\n '2. Persistent Growth & Outside-Middle Move',\n '3. Slow Start with Breakthrough End & Inside-Outside Move',\n 'distance',\n 'mean_horse_speed',\n 'number_of_races_for_jockey',\n 'course_type_dirt',\n 'number_of_jockeys',\n 'track_condition_dry',\n 'program_number10',\n 'program_number11',\n 'program_number12',\n 'program_number13',\n 'program_number14',\n 'program_number15',\n 'program_number16',\n 'program_number1A',\n 'program_number1X',\n 'program_number2',\n 'program_number2B',\n 'program_number3',\n 'program_number3X',\n 'program_number4',\n 'program_number5',\n 'program_number6',\n 'program_number7',\n 'program_number8',\n 'program_number9')\ncoefs$Variable = rownames\ncoefs %<>% select(Variable, everything())\ncoefs[, c('Estimate', 'Std.Error')] = round(coefs[, c('Estimate', 'Std.Error')], 3)\n\nblue_color = '#377EB8'\ngreen_color = '#4DAF4A'\nred_color = '#E41A1C'\n\n# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n# --- PRODUCE HTML CODE FOR THE TABLE BELOW\n# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n# coefs %>%\n# kbl(caption = \"Fixed Effects for the Multilevel Model\") %>%\n# kable_minimal() %>%\n# # row_spec(2:4, bold = T, color = \"white\", background = \"#D7261E\") %>%\n# row_spec(2, bold = T, color = \"white\", background = blue_color) %>%\n# row_spec(3, bold = T, color = \"white\", background = green_color) %>%\n# row_spec(4, bold = T, color = \"white\", background = red_color)","metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"execution":{"iopub.status.busy":"2023-01-20T20:17:58.605643Z","iopub.execute_input":"2023-01-20T20:17:58.607548Z","iopub.status.idle":"2023-01-20T20:17:58.970585Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## 2.2. Data\n\n**Dependent variable** – the final position of a jockey/horse in a race. The maximum value for this indicator varies depending on the number of players in a concrete race. For consistency, we normalise this with a min-max standardisation by a race. We then flip the sign of this measure to obtain a more coherent interpretation of findings with positive coefficients. For example, if a race comprises seven players, the winner gets 7/7 = 1, the second place gets 6/7 = 0.857, …, and the last rider gets 0/7 = 0.\n\n**Independent variables** – types of strategies obtained from the preceding hierarchical clustering. The fourth cluster – with a visible negative trend in performance across the race – is treated as a reference group when comparing the effects of clusters. Such a reference group is reasonable since we would like to compare a set of strategies' impacts to a situation that seems ineffective or failing.\n\n**Control covariates** – a bunch of characteristics pertaining to tracks and jockeys such as a jockey's program number, track conditions, course type, the average number of races a jockey had in a season, number of jockeys in a race, the average speed of a horse in a season, length of a track. Some of these variables are subsequently used to gauge their moderating impacts on strategies’ effectiveness.\n\n## 2.3. Findings\n\nThe main (fixed) effects of our general multilevel model are laid out in the following table.\n\n\n\n \n \n \n \n \n \n \n \n\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n
Fixed Effects for the Multilevel Model
Variable Estimate Std.Error Significance
Intercept 0.070 0.014 ***
1. Good Start with Stability & Middle-Inside Move 0.333 0.011 ***
2. Persistent Growth & Outside-Middle Move 0.389 0.009 ***
3. Slow Start with Breakthrough End & Inside-Outside Move 0.438 0.012 ***
distance 0.013 0.003 ***
mean_horse_speed 0.057 0.003 ***
number_of_races_for_jockey 0.021 0.004 ***
course_type_dirt 0.090 0.007 ***
number_of_jockeys 0.006 0.001 ***
track_condition_dry -0.016 0.006 *
program_number10 0.004 0.014
program_number11 -0.006 0.017
program_number12 -0.010 0.021
program_number13 0.043 0.032
program_number14 0.082 0.042 *
program_number15 0.088 0.057
program_number16 0.182 0.084 *
program_number1A 0.018 0.022
program_number1X 0.022 0.269
program_number2 0.007 0.009
program_number2B 0.121 0.080
program_number3 0.009 0.009
program_number3X -0.091 0.266
program_number4 0.010 0.009
program_number5 0.021 0.009 *
program_number6 0.005 0.009
program_number7 0.007 0.010
program_number8 0.012 0.011
program_number9 -0.002 0.012
","metadata":{}},{"cell_type":"markdown","source":"It is noticeable that all three clusters have statistically significant positive coefficients; therefore, we can posit that they are markedly better than the fourth cluster – the low-performing one. This is especially true for cluster 3 – *Slow Start with Breakthrough End & Inside-Outside Move* – which demonstrates the largest effect size for the difference and, on average, seems to embody the most effective trajectory [all other things being equal].\n\nThe finding is noteworthy because previous studies revealed that the best performance is achieved when the start is moderately fast (Mercier & Aftalion, 2020b). Nevertheless, as our modelling signifies, a sluggish start does not automatically lead to a worse position distribution in the end; with proper manoeuvring, a rider can often occupy a decent place, albeit perhaps at the expense of efficiency.\n\nHowever, is the strategy from cluster 3 always better? Under what circumstances are other strategies more or at least similarly preferable?","metadata":{}},{"cell_type":"markdown","source":"## 2.4. Interaction of Strategies' Effectiveness with Other Variables\n\nLet us delve into interaction effects enabling us the answer these questions. The error bars below portray how the previously observed differences (relative to a cluster with a diminishing speed and erratic movements around the track’s middle) look if we focus on a particular slice of our data (e.g., races held on turf) rather than the whole sample. ","metadata":{}},{"cell_type":"code","source":"# --------------------------- INTERACTIONS\n\n# int1 - track_condition\nmod0_int1 = suppressMessages(lmer(position_at_finish_minmax ~ cluster*track_condition_bin +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n\n# int2 - course_type\nmod0_int2 = suppressMessages(lmer(position_at_finish_minmax ~ cluster*course_type +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n\n# int3 - distance_id\nmod0_int3 = suppressMessages(lmer(position_at_finish_minmax ~ cluster*distance_id +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n\n# int4 - horse_speed\nmod0_int4 = suppressMessages(lmer(position_at_finish_minmax ~ cluster*mean_horse_speed +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n# summary(mod0_int4)\n\n# int5 - jockey_games\nmod0_int5 = suppressMessages(lmer(position_at_finish_minmax ~ cluster*jockey_games +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n\n# ---------------------- CREATING PLOT FOR INTERACTIONS\n\nmodels_interactions <- list(mod0_int1, mod0_int2, mod0_int3, mod0_int4, mod0_int5)\n\ndf_coeffs_interactions <- list()\nfor (i in 1:(length(models_interactions))){\n\n df_coeffs <- as.data.frame(summary(models_interactions[[i]])$coef)\n df_coeffs <- df_coeffs %>% rename(est=Estimate, std=`Std. Error`)\n df_coeffs$variable <- rownames(df_coeffs)\n df_coeffs <- df_coeffs[(nrow(df_coeffs)-2):nrow(df_coeffs),]\n df_coeffs_interactions[[i]] <- df_coeffs\n}\ndf_coeffs_interactions <- data.table::rbindlist(df_coeffs_interactions)\ndf_coeffs_interactions$cluster <- sapply(strsplit(df_coeffs_interactions$variable, \":\"), \"[\", 1)\ndf_coeffs_interactions$variable <- sapply(strsplit(df_coeffs_interactions$variable, \":\"), \"[\", 2)\ndf_coeffs_interactions$lower <- df_coeffs_interactions$est - df_coeffs_interactions$std*1.64\ndf_coeffs_interactions$upper <- df_coeffs_interactions$est + df_coeffs_interactions$std*1.64\ndf_coeffs_interactions$significant <- sign(df_coeffs_interactions$lower) == sign(df_coeffs_interactions$upper)\nerrorbar_linetype <- ifelse(df_coeffs_interactions$significant, \"solid\", \"dashed\")\n\ndf_coeffs_interactions$variable <- factor(\n as.factor(df_coeffs_interactions$variable),\n levels = c(\"track_condition_bin\", \"course_type\",\n \"mean_horse_speed\", \"jockey_games\", \"distance_id\"))\n\n# Rename variables\ndf_coeffs_interactions$variable <- df_coeffs_interactions$variable %>%\n dplyr::recode('track_condition_bin'='Track Condition: Dry',\n 'course_type'='Course Type: Dirt',\n 'distance_id'='Race Distance',\n 'mean_horse_speed'='Avgerage Horse Speed',\n 'jockey_games'=\"Number of Jockey's Races\")\n\n# ---------------------- PLOTNIG INTERACTIONS\noptions(repr.plot.width=10, repr.plot.height = 8)\ndf_coeffs_interactions$cluster <- factor(df_coeffs_interactions$cluster, levels=c('clusterclust_3','clusterclust_2','clusterclust_1'))\n\nggplot(data = df_coeffs_interactions, aes(y = variable, x = est, color = cluster)) +\n\n geom_errorbarh(aes(xmin = lower, xmax = upper, height = 0.3),\n position = position_dodge(width = 0.5),\n linetype=errorbar_linetype, size=0.75) +\n geom_point(aes(colour=cluster), size=2.5,\n position = position_dodge(width = 0.5)) +\n scale_color_manual(values = c(\"clusterclust_1\" = blue_color,\n \"clusterclust_2\" = green_color,\n \"clusterclust_3\" = red_color),\n labels = c(\"1. Good Start with Stability & Middle-Inside Move\",\n \"2. Persistent Growth & Outside-Middle Move\",\n \"3. Slow Start with Breakthrough End & Inside-Outside Move\"),\n name = \"\") +\n theme_minimal() +\n theme(axis.text.y = element_text(color = \"black\", size = 14),\n axis.text.x = element_text(color = \"black\", size = 14),\n axis.title.x = element_text(size = 14, face = \"bold\"),\n axis.title.y = element_text(size = 14, face = \"bold\")) +\n geom_vline(xintercept = 0, linetype = \"dashed\", color = \"darkgrey\", size = 1) +\n labs(y = \"\", x = 'Effect') +\n theme(plot.title = element_text(size = 20,\n face = \"bold\", hjust=0.5),\n legend.position='bottom',\n legend.direction =\"vertical\",\n legend.text=element_text(size=16)) +\n ggtitle(\"Influence of Variables on Strategies' Effectiveness\")","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-11-10T20:53:24.426050Z","iopub.execute_input":"2022-11-10T20:53:24.427673Z","iopub.status.idle":"2022-11-10T20:54:50.301398Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"A series of findings can be detected:\n\n* Races with longer distances make strategies from cluster 3 – *Slow Start with Breakthrough End & Inside-Outside Move* – even more beneficial than strategies from the least successful cluster 4. The winning capacities of cluster 2 – *Persistent Growth & Outside-Middle Move* – and cluster 1 – *Good Start with Stability & Middle-Inside Move* – do not depend on a track’s distance: it can be used with a fairly stable degree of success on tracks of multiple lengths[the respective confidence intervals cross 0].\n\n* More races in a season uplift the effectiveness of all three clusters to the same magnitude compared to a situation with few races [the respective confidence intervals overlap]. Potentially, this may signify that experienced jockeys are more proficient in enjoying the advantages of the three better-performing tactics.\n\n* Faster horses (greater average speed in a season) make the three clusters stand out in productivity even more relative to the most futile trajectory. However, cluster 1 – *Good Start with Stability & Middle-Inside Move* – will bring a jockey more voluminous benefits if a horse is speedy. In other words, horses with a higher anaerobic capacity seem to experience the positive influences of this tactic more fully.\n\n* The type of track and its conditions can be a source of variance in the effectiveness of strategies. Notably, a dirt coverage sizeably boosts the gains of cluster 2 – *Persistent Growth & Outside-Middle Move* – to greater levels than this course type does to other strategies. Cluster 2 also receives expanded profits on a dry track, whereas the rest of the strategies preserve their initial advantages – equal to the average ones presented in the general model without interactions [their respective confidence intervals cross 0].","metadata":{}},{"cell_type":"markdown","source":"## 2.5. Individual Influence of Jockeys\n\nThe relationships observed in the general model can also be shaped by another layer of heterogeneity, coming from jockeys with their unique performance history, racing career, and individual preferences. The latter was stated to influence jockeys' pacing strategies: there may be roles more suitable for 'chases' or 'front-runners' (Spence et al., 2012). To determine the possible variation, we can investigate random slopes for our parameters of interest – the impacts of trajectory types on a place at the finish. The plot below visualises these discrepancies rooted in jockeys themselves. For convenience, we illustrate this for a subset of experienced jockeys with 50 or more races and sort them by the percentage of times they took the top 3 places throughout the season. ","metadata":{}},{"cell_type":"code","source":"# --------------------------- RANDOM SLOPES\n\n# random effects\nmod0_rslope <- suppressMessages(lmer(position_at_finish_minmax ~ cluster +\n distance_id + course_type + track_condition_bin + purse +\n jockey_n + jockey_games + program_number + mean_horse_speed +\n (1 + cluster|jockey) + (1|horse_id), data = df_main.20))\n# summary(mod0_rslope)\n\n\n# Extract random slopes\nranef_mod0 = as.data.frame(ranef(mod0_rslope, condVar = T))\n\n\n\n# Filter rare jockeys\nN_THRESHOLD <- 50\nfreq_jockeys <- data.frame(table(df_main.20$jockey))\nfreq_jockeys <- (freq_jockeys %>% filter(Freq>=N_THRESHOLD))$Var\nranef_mod0 <- ranef_mod0 %>% filter(grp %in% freq_jockeys)\n\n\n# fixed\nfixed = cbind.data.frame(fixed = c(as.numeric(fixef(mod0_rslope)[2]),\n as.numeric(fixef(mod0_rslope)[3]),\n as.numeric(fixef(mod0_rslope)[4])),\n term = c('clusterclust_1', 'clusterclust_2', 'clusterclust_3'))\n\n# table with effects + FIXED\nranef_mod0 <- ranef_mod0 %>%\n dplyr::select(id = grp,\n Estimate = condval,\n Std.Error = condsd,\n term) %>%\n filter(!term == '(Intercept)') %>%\n left_join(fixed, by = 'term') %>%\n mutate(upper = fixed + Estimate + 1.64*Std.Error,\n lower = fixed + Estimate - 1.64*Std.Error,\n Estimate = fixed + Estimate)\n\n\n# Add pct of top-3 places\njockeys_top3 <- df_main %>%\n distinct(horse_race_id, .keep_all=T) %>%\n group_by(jockey) %>%\n summarise(top3_pct=mean(position_at_finish<=3))\n\nranef_mod0 <- ranef_mod0 %>% left_join(jockeys_top3, by=c(\"id\"=\"jockey\"))\n\n\n# --------------------------- PLOTING RANDOM SLOPES\nranef_mod0$term <- factor(ranef_mod0$term, levels=c('clusterclust_3','clusterclust_2','clusterclust_1'))\noptions(repr.plot.width=10, repr.plot.height = 10)\n\nggplot(data = ranef_mod0,\n aes(x = Estimate,\n y = reorder(id, top3_pct),\n colour = term\n )) +\n geom_errorbarh(aes(xmin = lower,\n xmax = upper,\n height = 0.3),\n size=0.25,\n position = position_dodge(width = 0.5)\n ) +\n\n geom_point(size=1,\n position = position_dodge(width = 0.5)) +\n\n scale_color_manual(values = c(\"clusterclust_1\" = blue_color,\n \"clusterclust_2\" = green_color,\n \"clusterclust_3\" = red_color),\n labels = c(\"1. Good Start with Stability & Middle-Inside Move\",\n \"2. Persistent Growth & Outside-Middle Move\",\n \"3. Slow Start with Breakthrough End & Inside-Outside Move\"),\n name = \"\") +\n\n theme_minimal() +\n theme(axis.text.y = element_text(color = \"black\", size = 11),\n axis.text.x = element_text(size = 16, face = \"bold\")) +\n labs(y = \"\", x = 'Random Effect') +\n\n theme(axis.text.y = element_text(color = \"black\", size = 14),\n axis.text.x = element_text(color = \"black\", size = 14),\n axis.title.x = element_text(size = 14, face = \"bold\"),\n axis.title.y = element_text(size = 14, face = \"bold\")) +\n\n theme(plot.title = element_text(size = 20,\n face = \"bold\", hjust=0.5),\n legend.position='bottom',\n legend.direction =\"vertical\",\n legend.text=element_text(size=16)) +\n ggtitle(\"Jockeys' Influence on Strategies Effectiveness\")","metadata":{"_kg_hide-input":true,"execution":{"iopub.status.busy":"2022-11-10T20:48:42.837460Z","iopub.execute_input":"2022-11-10T20:48:42.839091Z","iopub.status.idle":"2022-11-10T20:49:01.515617Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"We can spot two essential takeaways from this picture:\n\n* There is a visible variance in the effectiveness (compared to the unsuccessful cluster) of all three strategies for each specific jockey. The more significant variance belongs to cluster 1 – *Good Start with Stability & Middle-Inside Move* – and cluster 3 – *Slow Start with Breakthrough End & Inside-Outside Move*, meaning that some players are way more skilful in exploiting these trajectories than others. Cluster 2 – *Persistent Growth & Outside-to-Middle Move* – shows minor variability, suggesting that riders are very close regarding the place-based profits they receive from this strategy.\n\n* A comparative story between top players and less successful ones is prominent. For the top jockeys, a strategy represented by cluster 3 – *Slow Start with Breakthrough End & Inside-Outside Move* – seems the most awarding [the respective confidence intervals are tight and placed in the far right]. In turn, the bottom players’ (in this subset of experienced jockeys) benefits from this strategy are indistinguishable from the ones provided by cluster 2 – *Persistent Growth & Outside-Middle Move* or, in some cases, cluster 1 – *Good Start with Stability & Middle-Inside Move*. In general, we can argue that being insufficiently fast in the beginning with an intention to offset this in the end (cluster 3) is a risky tactic involving overtaking on the outside (this is notoriously hard – a horse has further to go!). It makes sense that only truly qualified players can excel at this. Partly this can also imply that top players are psychologically more comfortable with a “chasing” racing style since this tactic assumes jockeys pass others only by the end of the race.","metadata":{}},{"cell_type":"markdown","source":"# 3. Discussion & Conclusion\n\nTo summarise, in this investigation, we detected a set of meaningful trajectories that are most prevalent among jockeys: \n* Cluster 1 – *Good Start with Stability & Middle-Inside Move*\n* Cluster 2 – *Persistent Growth & Outside-Middle Move*\n* Cluster 3 – *Slow Start with Breakthrough End & Inside-Outside Move*\n* Cluster 4 – *Persistent Decline & Middle Move*\n\nWe then revealed how effective those strategies are and in what instances. Specifically, it was highlighted that a trajectory from cluster 3 with a leap by the end of the race seems the most award-winning, regardless of its seemingly uninspiring start. However, the other two clusters can still be effective, sometimes even more effective than the former. To demonstrate, when it comes to dirt course surfaces (compared to the turf ones) or dry weather (as opposed to the wet one), cluster 2 – *Persistent Growth & Outside-Middle Move* – takes a lead. Also, if a horse is speedy, a strategy from cluster 1 – *Good Start with Stability & Middle-Inside Move* – is the best way to go. Another example – when jockeys were less successful in competitive settings, cluster 2 and cluster 3 (and for some jockeys, cluster 1) can be profitable in roughly equivalent proportions.\n\nWe also want to emphasise the advantages of our general methodological approach for analysing such data types. First, the clustering technique allowed us to parsimoniously capture the multidimensional core patterns in the tracking data and, at the same time, remove undesired noisiness peculiar to the intensive time series data structures. Second, clustering categories are easily transferrable to inferential statistical approaches, where they can be studied with greater scrutiny. Particularly, we utilised multilevel/mixed-effects modelling since it was essential to account for multiple sources of diversity in the data and ensure unbiased and consistent findings. This method is not unusual for horse racing analytics (e.g., Spence et al., 2012).\n\nOur analysis is not without limitations. For instance, we confined our clustering solution to four classes, although more detailed configurations might be worth exploring. Besides, we assumed trajectory patterns of all riders in a race are independent, but this may entail a very rough approximation. The reason is that players' strategies can evolve dynamically throughout a race and adjust them based on other rivals' tactics. Thus, it seems valuable to look at how various movement trajectories of jockeys reciprocally alter each other at multiple moments in a race.\n\nThere is a potential for future work. With additional data (e.g., electrocardiogram records, power usage), more variables can be incorporated into creating typologies; hence other crucial angles of tactics could be discovered. Moreover, other more granular and accurate outcome measures could be brought to the fore, for instance, the exact time of crossing the finishing line – this may help increase the precision of estimates. Last but not least, various jockeys’/horses’ attributes can be exploited for expanding knowledge on the underlying reasons for variation in the estimates; in our notebook, we mainly exhibited the existence of this variation and its overall shape.","metadata":{}},{"cell_type":"markdown","source":"# References\n1. Mercier, Q., & Aftalion, A. (2020a). Pacing strategy in horse racing [Preprint]. Physiology. https://doi.org/10.1101/2020.06.11.145797\n2. Mercier, Q., & Aftalion, A. (2020b). Optimal speed in Thoroughbred horse racing. PLOS ONE, 15(12), e0235024. https://doi.org/10.1371/journal.pone.0235024\n3. Spence, A., Thurman, A., Maher, M., & Wilson, A. (2012). Speed, pacing strategy and aerodynamic drafting in Thoroughbred horse racing. Biology Letters, pp. 8, 678–681. https://doi.org/10.1098/rsbl.2011.1120\n4. Wong, A. S., Morrice-West, A. V., Whitton, R. C., & Hitchens, P. L. (2022). Changes in Thoroughbred speed and stride characteristics over successive race starts and their association with musculoskeletal injury—equine Veterinary Journal.\n\n","metadata":{}}]}