Australian Open Datathon R Tutorial

Overview

The Task

This notebook will outline how the Betfair Data Scientists went about modelling the Australian Open for Betfair's Australian Open Datathon. The task is simple: we ask you to predict the winner of every possible Australian Open matchup using data which we provide.

The metric used to determine the winner will be log loss, based on the actual matchups that happen in the Open. For more information on log loss, click here.

How an outline of our methodology and thought process, read this article.

---

Exploring the Data

First we need to get an idea of what the data looks like. Let's read the men's data in and get an idea of what it looks like. Note that you will need to install all the packages listed below unless you already have them.

Note that for this tutorial I will be using dplyr, if you are not familiar with the syntax I encourage you to read up on the basics.

# Import libraries
library(dplyr)
library(readr)
library(tidyr)
library(RcppRoll)
library(tidyselect)
library(lubridate)
library(stringr)
library(zoo)
library(purrr)
library(h2o)
library(DT)
mens = readr::read_csv('data/ATP_matches.csv', na = ".") # NAs are indicated by .
mens %>%
  datatable(rownames = FALSE, extensions = 'Scroller', 
            options = list(dom = "t", 
            scrollY = 450,
            scroller = TRUE,
            scrollX = 600,
            fixedColumns = TRUE)) %>%
  formatRound(columns=pluck(., "x", "data") %>% colnames(), digits=3)

Winner	Loser	Tournament	Tournament_Date	Court_Surface	Round_Description	Winner_Rank	Loser_Rank	Retirement_Ind	Winner_Sets_Won	...	Loser_DoubleFaults	Loser_FirstServes_Won	Loser_FirstServes_In	Loser_SecondServes_Won	Loser_SecondServes_In	Loser_BreakPoints_Won	Loser_BreakPoints	Loser_ReturnPoints_Won	Loser_ReturnPoints_Faced	Loser_TotalPoints_Won
Edouard Roger-Vasselin	Eric Prodon	Chennai	2-Jan-12	Hard	First Round	106	97	0	2	...	3	21	33	13	26	1	3	15	49	49
Dudi Sela	Fabio Fognini	Chennai	2-Jan-12	Hard	First Round	83	48	0	2	...	4	17	32	5	26	0	1	8	33	30
Go Soeda	Frederico Gil	Chennai	2-Jan-12	Hard	First Round	120	102	0	2	...	2	45	70	18	35	2	4	36	103	99
Yuki Bhambri	Karol Beck	Chennai	2-Jan-12	Hard	First Round	345	101	0	2	...	1	15	33	13	29	2	3	15	46	43
Yuichi Sugita	Olivier Rochus	Chennai	2-Jan-12	Hard	First Round	235	67	0	2	...	0	19	32	13	22	1	7	30	78	62
Benoit Paire	Pere Riba	Chennai	2-Jan-12	Hard	First Round	95	89	0	2	...	5	13	20	12	32	0	1	9	44	34
Victor Hanescu	Sam Querrey	Chennai	2-Jan-12	Hard	First Round	90	93	0	2	...	8	29	41	7	24	1	3	17	57	53
Yen-Hsun Lu	Thiemo de Bakker	Chennai	2-Jan-12	Hard	First Round	82	223	0	2	...	0	20	32	10	24	1	1	19	57	49
Andreas Beck	Vasek Pospisil	Chennai	2-Jan-12	Hard	First Round	98	119	0	2	...	3	39	57	16	38	1	5	24	74	79
Ivan Dodig	Vishnu Vardhan	Chennai	2-Jan-12	Hard	First Round	36	313	0	2	...	5	41	59	13	27	2	8	34	101	88
David Goffin	Xavier Malisse	Chennai	2-Jan-12	Hard	First Round	174	49	0	2	...	1	31	43	19	34	1	4	27	85	77
David Goffin	Andreas Beck	Chennai	2-Jan-12	Hard	Second Round	174	98	0	2	...	0	43	71	14	27	2	8	27	82	84
Dudi Sela	Benoit Paire	Chennai	2-Jan-12	Hard	Second Round	83	95	0	2	...	5	40	58	21	46	1	7	26	87	87
Stan Wawrinka	Edouard Roger-Vasselin	Chennai	2-Jan-12	Hard	Second Round	17	106	0	2	...	0	43	70	16	34	4	6	28	82	87
Go Soeda	Ivan Dodig	Chennai	2-Jan-12	Hard	Second Round	120	36	0	2	...	2	31	41	11	28	1	4	23	73	65
Milos Raonic	Victor Hanescu	Chennai	2-Jan-12	Hard	Second Round	31	90	0	2	...	1	25	38	5	14	0	4	15	56	45
Yuichi Sugita	Yen-Hsun Lu	Chennai	2-Jan-12	Hard	Second Round	235	82	0	2	...	4	34	45	12	34	2	9	38	93	84
Janko Tipsarevic	Yuki Bhambri	Chennai	2-Jan-12	Hard	Second Round	9	345	0	2	...	2	12	22	9	17	0	1	8	41	29
Janko Tipsarevic	David Goffin	Chennai	2-Jan-12	Hard	Quarter-finals	9	174	0	2	...	5	34	51	19	40	1	2	18	67	71
Milos Raonic	Dudi Sela	Chennai	2-Jan-12	Hard	Quarter-finals	31	83	0	2	...	2	23	31	19	28	0	3	16	69	58
Go Soeda	Stan Wawrinka	Chennai	2-Jan-12	Hard	Quarter-finals	120	17	0	2	...	4	18	34	13	31	3	7	31	74	62
Nicolas Almagro	Yuichi Sugita	Chennai	2-Jan-12	Hard	Quarter-finals	10	235	0	2	...	1	36	65	30	40	3	12	45	123	111
Janko Tipsarevic	Go Soeda	Chennai	2-Jan-12	Hard	Semi-finals	9	120	0	2	...	1	21	33	10	28	1	1	10	44	41
Milos Raonic	Nicolas Almagro	Chennai	2-Jan-12	Hard	Semi-finals	31	10	0	2	...	0	31	45	8	15	0	3	12	54	51
Milos Raonic	Janko Tipsarevic	Chennai	2-Jan-12	Hard	Finals	31	9	0	2	...	2	59	83	34	55	0	4	25	113	118
Igor Andreev	Adrian Mannarino	Brisbane	2-Jan-12	Hard	First Round	115	87	0	2	...	3	24	35	13	25	1	3	21	70	58
Alexandr Dolgopolov	Alejandro Falla	Brisbane	2-Jan-12	Hard	First Round	15	74	0	2	...	3	16	33	12	25	3	7	33	75	61
Tatsuma Ito	Benjamin Mitchell	Brisbane	2-Jan-12	Hard	First Round	122	227	0	2	...	6	30	44	7	24	0	2	13	52	50
Kei Nishikori	Cedrik-Marcel Stebe	Brisbane	2-Jan-12	Hard	First Round	25	81	0	2	...	2	27	49	23	41	3	6	28	75	78
Denis Istomin	Florian Mayer	Brisbane	2-Jan-12	Hard	First Round	73	23	1	1	...	1	28	38	11	17	0	2	15	56	54
...	...	...	...	...	...	...	...	...	...		...	...	...	...	...	...	...	...	...	...
Malek Jaziri	Fernando Verdasco	Paris	29-Oct-18	Indoor Hard	Second Round	55	27	0	2	...	6	46	60	16	35	3	13	39	104	101
Alexander Zverev	Frances Tiafoe	Paris	29-Oct-18	Indoor Hard	Second Round	5	44	0	2	...	4	26	40	16	36	2	10	27	72	69
Dominic Thiem	Gilles Simon	Paris	29-Oct-18	Indoor Hard	Second Round	8	31	0	2	...	1	13	26	12	25	2	2	23	59	48
Novak Djokovic	Joao Sousa	Paris	29-Oct-18	Indoor Hard	Second Round	2	48	0	2	...	2	25	35	6	22	1	10	27	74	58
Karen Khachanov	Matthew Ebden	Paris	29-Oct-18	Indoor Hard	Second Round	18	39	1	2	...	6	8	18	5	20	1	2	10	30	23
John Isner	Mikhail Kukushkin	Paris	29-Oct-18	Indoor Hard	Second Round	9	54	0	2	...	1	54	80	24	39	0	1	13	90	91
Kevin Anderson	Nikoloz Basilashvili	Paris	29-Oct-18	Indoor Hard	Second Round	6	22	0	2	...	7	43	54	30	49	0	3	26	106	99
Marin Cilic	Philipp Kohlschreiber	Paris	29-Oct-18	Indoor Hard	Second Round	7	43	0	2	...	1	19	34	12	20	1	1	17	55	48
Jack Sock	Richard Gasquet	Paris	29-Oct-18	Indoor Hard	Second Round	23	28	0	2	...	4	18	33	16	29	0	4	19	59	53
Grigor Dimitrov	Roberto Bautista Agut	Paris	29-Oct-18	Indoor Hard	Second Round	10	25	0	2	...	0	34	48	11	20	2	4	27	76	72
Damir Dzumhur	Stefanos Tsitsipas	Paris	29-Oct-18	Indoor Hard	Second Round	52	16	0	2	...	3	14	26	15	30	2	2	17	52	46
Dominic Thiem	Borna Coric	Paris	29-Oct-18	Indoor Hard	Third Round	8	13	0	2	...	1	39	57	16	38	2	2	27	88	82
Novak Djokovic	Damir Dzumhur	Paris	29-Oct-18	Indoor Hard	Third Round	2	52	1	2	...	4	15	28	7	18	0	0	8	28	30
Alexander Zverev	Diego Schwartzman	Paris	29-Oct-18	Indoor Hard	Third Round	5	19	0	2	...	2	22	37	12	24	0	4	18	58	52
Roger Federer	Fabio Fognini	Paris	29-Oct-18	Indoor Hard	Third Round	3	14	0	2	...	6	22	32	15	37	1	5	16	54	53
Marin Cilic	Grigor Dimitrov	Paris	29-Oct-18	Indoor Hard	Third Round	7	10	0	2	...	1	37	55	14	32	1	5	22	71	73
Karen Khachanov	John Isner	Paris	29-Oct-18	Indoor Hard	Third Round	18	9	0	2	...	4	67	80	19	38	0	0	17	100	103
Kei Nishikori	Kevin Anderson	Paris	29-Oct-18	Indoor Hard	Third Round	11	6	0	2	...	1	26	33	11	19	0	0	11	51	48
Jack Sock	Malek Jaziri	Paris	29-Oct-18	Indoor Hard	Third Round	23	55	0	2	...	6	13	21	10	24	0	0	9	41	32
Karen Khachanov	Alexander Zverev	Paris	29-Oct-18	Indoor Hard	Quarter-finals	18	5	0	2	...	7	26	47	4	21	1	3	10	36	40
Dominic Thiem	Jack Sock	Paris	29-Oct-18	Indoor Hard	Quarter-finals	8	23	0	2	...	5	44	59	19	37	2	10	34	97	97
Roger Federer	Kei Nishikori	Paris	29-Oct-18	Indoor Hard	Quarter-finals	3	11	0	2	...	0	21	37	16	26	0	1	12	56	49
Novak Djokovic	Marin Cilic	Paris	29-Oct-18	Indoor Hard	Quarter-finals	2	7	0	2	...	0	38	55	11	28	2	5	29	85	78
Karen Khachanov	Dominic Thiem	Paris	29-Oct-18	Indoor Hard	Semi-finals	18	8	0	2	...	0	19	29	8	26	1	3	15	47	42
Novak Djokovic	Roger Federer	Paris	29-Oct-18	Indoor Hard	Semi-finals	2	3	0	2	...	2	69	93	25	46	1	2	29	113	123
Karen Khachanov	Novak Djokovic	Paris	29-Oct-18	Indoor Hard	Finals	18	2	0	2	...	1	30	43	14	28	1	5	20	66	64
Jaume Antoni Munar Clar	Frances Tiafoe	Milan	5-Nov-18	Indoor Hard	NA	76	40	0	3	...	3	21	29	6	17	0	2	5	46	32
Frances Tiafoe	Hubert Hurkacz	Milan	5-Nov-18	Indoor Hard	NA	40	85	0	3	...	4	35	48	10	19	1	7	22	78	67
Hubert Hurkacz	Jaume Antoni Munar Clar	Milan	5-Nov-18	Indoor Hard	NA	85	76	0	3	...	1	43	63	15	35	3	9	29	80	87
Andrey Rublev	Liam Caruana	Milan	5-Nov-18	Indoor Hard	NA	68	NA	0	3	...	1	28	39	4	14	1	3	18	57	50

As we can see, we have a Winner column, a Loser column, as well as other columns detailing the match details, and other columns which have the stats for that match. As we have a Winner column, if we use the current data structure to train a model we will leak the result. The model will simply learn that the actual winner comes from the Winner column, rather than learning from other features that we can create, such as First Serve %.

To avoid this problem, let's reshape the data from wide to long, then shuffle the data. For this, we will define a function, split_winner_loser_columns, which splits the raw data frame into two data frames, appends them together, and then shuffles the data.

Let's also remove all Grass and Clay matches from our data, as we will be modelling the Australian Open which is a hardcourt surface.

Additionally, we will add a few columns, such as Match_Id and Total_Games. These will be useful later.

split_winner_loser_columns <- function(df) {
  # This function splits the raw data into two data frames and appends them together then shuffles them
  # This output is a data frame with only one player's stats on each row (i.e. in long format)

  # Grab a df with only the Winner's stats
  winner = df %>% 
    select(-contains("Loser")) %>% # Select only the Winner columns + extra game info columns as a df
    rename_at( # Rename all columns containing "Winner" to "Player" 
      vars(contains("Winner")),
      ~str_replace(., "Winner", "Player")
    ) %>%
    mutate(Winner = 1) # Create a target column

  # Repeat the process with the loser's stats
  loser = df %>%
    select(-contains("Winner")) %>%
    rename_at(
      vars(contains("Loser")),
      ~str_replace(., "Loser", "Player")
    ) %>%
    mutate(Winner = 0)

  set.seed(183) # Set seed to replicate results - 183 is the most games played in a tennis match (Isner-Mahut)

  # Create a df that appends both the Winner and loser df together
  combined_df = winner %>% 
    rbind(loser) %>% # Append the loser df to the Winner df
    slice(sample(1:n())) %>% # Randomise row order
    arrange(Match_Id) %>% # Arrange by Match_Id
    return()
}

# Read in men and womens data; randomise the data to avoid result leakage
mens = readr::read_csv('data/ATP_matches.csv', na = ".") %>%
  filter(Court_Surface == "Hard" | Court_Surface == "Indoor Hard") %>% # Filter to only use hardcourt games
  mutate(Match_Id = row_number(), # Add a match ID column to be used as a key
         Tournament_Date = dmy(Tournament_Date), # Change Tournament to datetime
         Total_Games = Winner_Games_Won + Loser_Games_Won) %>% # Add a total games played column
  split_winner_loser_columns() # Change the data frame from wide to long
mens %>%
  datatable(rownames = FALSE, extensions = 'Scroller', 
            options = list(dom = "t", 
            scrollY = 450,
            scroller = TRUE,
            scrollX = 600,
            fixedColumns = TRUE)) %>%
  formatRound(columns=pluck(., "x", "data") %>% colnames(), digits=3)

Player	Tournament	Tournament_Date	Court_Surface	Round_Description	Player_Rank	Retirement_Ind	Player_Sets_Won	Player_Games_Won	Player_Aces	...	Player_SecondServes_Won	Player_SecondServes_In	Player_BreakPoints_Won	Player_BreakPoints	Player_ReturnPoints_Won	Player_ReturnPoints_Faced	Player_TotalPoints_Won	Match_Id	Total_Games	Winner
Eric Prodon	Chennai	2012-01-02	Hard	First Round	97	0	0	7	2	...	13	26	1	3	15	49	49	1	19	0
Edouard Roger-Vasselin	Chennai	2012-01-02	Hard	First Round	106	0	2	12	5	...	12	19	4	7	25	59	59	1	19	1
Dudi Sela	Chennai	2012-01-02	Hard	First Round	83	0	2	12	2	...	11	16	6	14	36	58	61	2	13	1
Fabio Fognini	Chennai	2012-01-02	Hard	First Round	48	0	0	1	1	...	5	26	0	1	8	33	30	2	13	0
Frederico Gil	Chennai	2012-01-02	Hard	First Round	102	0	1	14	5	...	18	35	2	4	36	103	99	3	33	0
Go Soeda	Chennai	2012-01-02	Hard	First Round	120	0	2	19	6	...	19	39	5	11	42	105	109	3	33	1

---

Feature Creation

Now that we have a fairly good understanding of what the data looks like, let's add some features. To do this we will define a function. Ideally we want to add features which will provide predictive power to our model.

Thinking about the dynamics of tennis, we know that players often will matches by "breaking" the opponent's serve (i.e. winning a game when the opponent is serving). This is especially important in mens tennis. Let's create a feature called F_Player_BreakPoints_Per_Game, which is the number of breakpoints a player gets per game that they play (even though they can only get breakpoints every second game, we will use total games). Let's also create a feature called F_Player_Return_Win_Ratio which is the proportion of points won when returning.

Similarly, "holding" serve is important (i.e. winning a game when you are serving). Let's create a feature called F_Player_Serve_Win_Ratio which is the proportion of points won when serving.

Finally, you only win a set of tennis by winning more sets than your opponent. To win a set, you need to win games. Let's create a feature called F_Player_Game_Win_Percentage which is the propotion of games that a player wins.

add_ratio_features <- function(df) {
  # This function adds ratio features to a long df
  df %>%
    mutate(
      # Point Win ratio when serving
      F_Player_Serve_Win_Ratio = (Player_FirstServes_Won + Player_SecondServes_Won - Player_DoubleFaults) / 
        (Player_FirstServes_In + Player_SecondServes_In + Player_DoubleFaults), 
      # Point win ratio when returning
      F_Player_Return_Win_Ratio = Player_ReturnPoints_Won / Player_ReturnPoints_Faced, 
      # Breakpoints per receiving game
      F_Player_BreakPoints_Per_Game = Player_BreakPoints / Total_Games, 
      F_Player_Game_Win_Percentage = Player_Games_Won / Total_Games
    ) %>%
    mutate_at(
      vars(colnames(.), -contains("Rank"), -Tournament_Date), # Replace all NAs with0 apart from Rank, Date
      ~ifelse(is.na(.), 0, .)
    ) %>%
    return()
}
mens = mens %>%
  add_ratio_features() # Add features

Now that we have added our features, we need to create rolling averages for them. We cannot simply use current match statistics, as they will leak the result to the model. Instead, we need to use past match statistics to predict future matches. Here we will use a rolling mean with a window of 15. If the player hasn't played 15 games, we will instead use a cumulative mean. We will also lag the result so as to not leak the result.

This next chunk of code simply takes all the columns starting with F_ and calculates these means.

mens = mens %>% 
  group_by(Player) %>% # Group by player
  mutate_at( # Create a rolling mean with window 15 for each player. 
    vars(starts_with("F_")), # If the player hasn't played 15 games, use a cumulative mean
    ~coalesce(rollmean(., k = 15, align = "right", fill = NA_real_), cummean(.)) %>% lag()
  ) %>%
  ungroup()

---

Creating a Training Feature Matrix

In predictive modelling language - features are data metrics we use to predict an outcome or target variable. We have several choices to make before we get to the prediction phase. What are the features? How do we structure the outcome variable? What does each row mean? Do we use all data or just a subset? We narrowed it down to two options

We can train the model on every tennis match in the data set, or We can only train the model on Australian Open matches. Doing Option 1 would mean we have a lot more data to build a strong model, but it might be challenging to work around the constraints described in the tournament structure.

Doing Option 2 fits better from that angle but leaves us with very few matches to train our model on.

We have decided to go with an option that combines strengths from both approaches, by training the model on matches from the Aus Open and the US Open because both grand slams are played on the same surface - hard court.

However, we also need to train our model in the same way that will be used to predict the 2019 Australian Open. When predicting the 2nd round, we won't have data from the 1st round. So we will need to build our training feature matrix with this in mind. We should extract features for a player from past games at the start of the tournament and apply them to every matchup that that player plays.

To do this, we will create a function, extract_latest_features_for_tournament, which maps over our feature data frame for the dates in the first round of a tournament and grabs features.

First, we need the Australian Open and US Open results - let's grab these and then apply our function.

# Get Australian Open and US Open Results
aus_us_open_results = 
  mens %>%
  filter((Tournament == "Australian Open, Melbourne" | Tournament == "U.S. Open, New York")
         & Round_Description != "Qualifying" & Tournament_Date != "2012-01-16") %>% # Filter out qualifiers
  select(Match_Id, Player, Tournament, Tournament_Date, Round_Description, Winner)
# Create a function which extracts features for each tournament
extract_latest_features_for_tournament = function(df, dte) {

  df %>% # Filter for the 1st round
    filter(Tournament_Date == dte, Round_Description == "First Round", Tournament_Date != "2012-01-16") %>% 
    group_by(Player) %>% # Group by player
    select_at(
      vars(Match_Id, starts_with("F_"), Player_Rank) # Grab the players' features
    ) %>%
    rename(F_Player_Rank = Player_Rank) %>%
    ungroup() %>%
    mutate(Feature_Date = dte) %>%
    select(Player, Feature_Date, everything())
}
# Create a feature matrix in long format
feature_matrix_long = 
  aus_us_open_results %>%
  distinct(Tournament_Date) %>% # Pull all Tournament Dates
  pull() %>%
  map_dfr(
    ~extract_latest_features_for_tournament(mens, .) # Get the features
  ) %>%
  filter(Feature_Date != "2012-01-16") %>% # Filter out the first Aus Open
  mutate_at( # Replace NAs with the mean
    vars(starts_with("F_")),
    ~ifelse(is.na(.), mean(., na.rm = TRUE), .)
  )

Now that we have a feature matrix in long format, we need to convert it to wide format so that the features are on the same row. To do this we will define a function gather_df, which converts the data frame from long to wide. Let's also join the results to the matrix and convert the Winner column to a factor. Finally, we will take the difference of player1 and player2's features, so as to reduce the dimensionality of the model.

gather_df <- function(df) {
  # This function puts the df back into its original format of each row containing stats for both players
  df %>%
    arrange(Match_Id) %>%
    filter(row_number() %% 2 != 0) %>% # Filter for every 2nd row, starting at the 1st index. e.g. 1, 3, 5
    rename_at( # Rename columns to player_1
      vars(contains("Player")),
      ~str_replace(., "Player", "player_1")
    ) %>%
    inner_join(df %>%
                 filter(row_number() %% 2 == 0) %>%
                 rename_at(
                   vars(contains("Player")), # Rename columns to player_2
                   ~str_replace(., "Player", "player_2")
                 ) %>%
                 select(Match_Id, contains("Player")),
               by=c('Match_Id')
    ) %>%
    select(Match_Id, player_1, player_2, Winner, everything()) %>%
    return()
}
# Joining results to features
feature_matrix_wide = aus_us_open_results %>%
  inner_join(feature_matrix_long %>% 
               select(-Match_Id), 
             by = c("Player", "Tournament_Date" = "Feature_Date")) %>%
  gather_df() %>%
  mutate(
    F_Serve_Win_Ratio_Diff = F_player_1_Serve_Win_Ratio - F_player_2_Serve_Win_Ratio,
    F_Return_Win_Ratio_Diff = F_player_1_Return_Win_Ratio - F_player_2_Return_Win_Ratio,
    F_Game_Win_Percentage_Diff = F_player_1_Game_Win_Percentage - F_player_2_Game_Win_Percentage,
    F_BreakPoints_Per_Game_Diff = F_player_1_BreakPoints_Per_Game - F_player_2_BreakPoints_Per_Game,
    F_Rank_Diff = (F_player_1_Rank - F_player_2_Rank),
    Winner = as.factor(Winner)
  ) %>%
  select(Match_Id, player_1, player_2, Tournament, Tournament_Date, Round_Description, Winner, contains("Diff"))
train = feature_matrix_wide
train %>%
  datatable(rownames = FALSE, extensions = 'Scroller', 
            options = list(dom = "t", 
            scrollY = 450,
            scroller = TRUE,
            scrollX = 600,
            fixedColumns = TRUE)) %>%
  formatRound(columns=pluck(., "x", "data") %>% colnames(), digits=3)

Match_Id	player_1	player_2	Tournament	Tournament_Date	Round_Description	Winner	F_Serve_Win_Ratio_Diff	F_Return_Win_Ratio_Diff	F_Game_Win_Percentage_Diff	F_BreakPoints_Per_Game_Diff	F_Rank_Diff
1139	Adrian Ungur	Daniel Brands	U.S. Open, New York	2012-08-27	First Round	0	0.03279412	-0.014757229	0.002877458	0.073938088	-13
1140	Albert Montanes	Richard Gasquet	U.S. Open, New York	2012-08-27	First Round	0	-0.08000322	-0.077451342	-0.131108056	-0.180846832	97
1141	Martin Klizan	Alejandro Falla	U.S. Open, New York	2012-08-27	First Round	1	0.07711693	-0.044715517	0.068179841	-0.087361962	1
1142	Alex Bogomolov Jr.	Andy Murray	U.S. Open, New York	2012-08-27	First Round	0	-0.03964074	-0.031700826	-0.059010072	-0.094721700	69
1143	Tommy Robredo	Andreas Seppi	U.S. Open, New York	2012-08-27	First Round	1	-0.02681392	0.006442134	-0.067779660	-0.009930089	151
1144	Ryan Harrison	Benjamin Becker	U.S. Open, New York	2012-08-27	First Round	1	0.04251983	0.018604623	0.026486753	-0.003548973	-24

---

Creating the Feature Matrix for the 2019 Australian Open

Now that we have our training set, train, we need to create a feature matrix to create predictions on. To do this, we need to generate features again. We could simply append a player list to our raw data frame, create a mock date and then use the extract_latest_features_for_tournament function that we used before. Instead, we're going to create a lookup table for each unique player in the 2019 Australian Open. We will need to get their last 15 games and then find the mean for each feature so that our features are the same.

Let's first explore what the dummy submission file looks like, then use it to get the unique players.

read_csv('data/men_dummy_submission_file.csv') %>% glimpse()

As we can see, the dummy submission file contains every potential match up for the Open. This will be updated a few days before the Open starts with the actual players playing. Let's now create the lookup feature table.

# Get a vector of unique players in this years' open using the dummy submission file
unique_players = read_csv('data/men_dummy_submission_file.csv') %>% pull(player_1) %>% unique()
# Get the last 15 games played for each unique player and find their features
lookup_feature_table = read_csv('data/ATP_matches.csv', na = ".") %>%
  filter(Court_Surface == "Hard" | Court_Surface == "Indoor Hard") %>%
  mutate(Match_Id = row_number(), # Add a match ID column to be used as a key
         Tournament_Date = dmy(Tournament_Date), # Change Tournament to datetime
         Total_Games = Winner_Games_Won + Loser_Games_Won) %>% # Add a total games played column
  # clean_missing_data() %>% # Clean missing data
  split_winner_loser_columns() %>% # Change the data frame from wide to long
  add_ratio_features() %>%
  filter(Player %in% unique_players) %>%
  group_by(Player) %>%
  top_n(15, Match_Id) %>%
  summarise(
    F_Player_Serve_Win_Ratio = mean(F_Player_Serve_Win_Ratio),
    F_Player_Return_Win_Ratio = mean(F_Player_Return_Win_Ratio),
    F_Player_BreakPoints_Per_Game = mean(F_Player_BreakPoints_Per_Game),
    F_Player_Game_Win_Percentage = mean(F_Player_Game_Win_Percentage),
    F_Player_Rank = last(Player_Rank)
  )

Now let's create features for every single combination. To do this we'll join our lookup_feature_table to the player_1 and player_2 columns in the dummy_submission_file.

# Create feature matrix for the Australian Open for all player 1s
features_player_1 = read_csv('data/men_dummy_submission_file.csv') %>%
  select(player_1) %>%
  inner_join(lookup_feature_table, by=c("player_1" = "Player")) %>%
  rename(F_player_1_Serve_Win_Ratio = F_Player_Serve_Win_Ratio,
         F_player_1_Return_Win_Ratio = F_Player_Return_Win_Ratio,
         F_player_1_BreakPoints_Per_Game = F_Player_BreakPoints_Per_Game,
         F_player_1_Game_Win_Percentage = F_Player_Game_Win_Percentage,
         F_player_1_Rank = F_Player_Rank)
# Create feature matrix for the Australian Open for all player 2s
features_player_2 = read_csv('data/men_dummy_submission_file.csv') %>%
  select(player_2) %>%
  inner_join(lookup_feature_table, by=c("player_2" = "Player")) %>%
  rename(F_player_2_Serve_Win_Ratio = F_Player_Serve_Win_Ratio,
         F_player_2_Return_Win_Ratio = F_Player_Return_Win_Ratio,
         F_player_2_BreakPoints_Per_Game = F_Player_BreakPoints_Per_Game,
         F_player_2_Game_Win_Percentage = F_Player_Game_Win_Percentage,
         F_player_2_Rank = F_Player_Rank)
# Join the two dfs together and subtract features to create Difference features
aus_open_2019_features = features_player_1 %>% 
  bind_cols(features_player_2) %>%
  select(player_1, player_2, everything()) %>%
  mutate(
    F_Serve_Win_Ratio_Diff = F_player_1_Serve_Win_Ratio - F_player_2_Serve_Win_Ratio,
    F_Return_Win_Ratio_Diff = F_player_1_Return_Win_Ratio - F_player_2_Return_Win_Ratio,
    F_Game_Win_Percentage_Diff = F_player_1_Game_Win_Percentage - F_player_2_Game_Win_Percentage,
    F_BreakPoints_Per_Game_Diff = F_player_1_BreakPoints_Per_Game - F_player_2_BreakPoints_Per_Game,
    F_Rank_Diff = (F_player_1_Rank - F_player_2_Rank)
  ) %>%
  select(player_1, player_2, contains("Diff"))
aus_open_2019_features  %>%
  datatable(rownames = FALSE, extensions = 'Scroller', 
            options = list(dom = "t",
                          scrollY = 450,
                          scroller = TRUE,
                          scrollX = 600,
                          fixedColumns = TRUE)) %>%
  formatRound(columns=pluck(., "x", "data") %>% colnames(), digits=3)

player_1	player_2	F_Serve_Win_Ratio_Diff	F_Return_Win_Ratio_Diff	F_Game_Win_Percentage_Diff	F_BreakPoints_Per_Game_Diff	F_Rank_Diff
Novak Djokovic	Rafael Nadal	0.06347805	0.02503802	0.07002382	0.08951024	1
Novak Djokovic	Roger Federer	0.06583364	0.03628491	0.07661295	0.15455628	-1
Novak Djokovic	Juan Martin del Potro	0.01067079	0.03436023	0.06382353	0.11259979	-2
Novak Djokovic	Alexander Zverev	0.11117863	0.03125651	0.11055585	0.08661036	-3
Novak Djokovic	Kevin Anderson	0.02132375	0.10449337	0.11184503	0.23684083	-4
Novak Djokovic	Marin Cilic	0.08410746	0.02434916	0.07653035	0.08355134	-5

---

Generating 2019 Australian Open Predictions

Now that we have our features, we can finally train our model and generate predictions for the 2019 Australian Open. Due to its simplicity, we will use h2o's Auto Machine Learning function h2o.automl. This will train a heap of different models and optimise the hyperparameters, as well as creating stacked ensembles automatically for us. We will use optimising by log loss.

First, we must create h2o frames for our training and feature data frames. Then we will run h2o.automl. Note that we can set the max_runtime_secs parameter. As this is a notebook, I have set it for 30 seconds - but I suggest you give it 10 minutes to create the best model. We can then create our predictions and assign them back to our aus_open_2019_features data frame. Finally, we will group_by player and find the best player, on average.

## Setup H2O
h2o.init(ip = "localhost",
         port = 54321,
         enable_assertions = TRUE,
         nthreads = 2,
         max_mem_size = "24g"

)
## Sending file to h2o
train_h2o = feature_matrix_wide %>%
  select(contains("Diff"), Winner) %>%
  as.h2o(destination_frame = "train_h2o")
aus_open_2019_features_h2o = aus_open_2019_features %>%
  select(contains("Diff")) %>%
  as.h2o(destination_frame = "aus_open_2019_features_h2o")
## Running Auto ML 
mens_model = h2o.automl(y = "Winner",
                        training_frame = train_h2o,
                        max_runtime_secs = 30,
                        max_models = 100,
                        stopping_metric = "logloss",
                        sort_metric = "logloss",
                        balance_classes = TRUE,
                        seed = 183) # Set seed to replicate results - 183 is the most games played in a tennis match (Isner-Mahut)
## Predictions on test frame
predictions = h2o.predict(mens_model@leader, aus_open_2019_features_h2o) %>%
  as.data.frame()
aus_open_2019_features$prob_player_1 = predictions$p1
aus_open_2019_features$prob_player_2 = predictions$p0
h2o.shutdown(prompt = FALSE)

Now let's find the best player by taking the mean of the prediction probability by player.

aus_open_2019_features %>% 
  select(player_1, starts_with("F_"), prob_player_1) %>%
  group_by(player_1) %>%
  summarise_all(mean) %>%
  arrange(desc(prob_player_1)) %>%
  datatable(rownames = FALSE, extensions = 'Scroller', 
            options = list(dom = "t",
                          scrollY = 450,
                          scroller = TRUE,
                          scrollX = 600,
                          fixedColumns = TRUE)) %>%
  formatRound(columns=pluck(., "x", "data") %>% colnames(), digits=3)

player_1	F_Serve_Win_Ratio_Diff	F_Return_Win_Ratio_Diff	F_Game_Win_Percentage_Diff	F_BreakPoints_Per_Game_Diff	F_Rank_Diff	prob_player_1
Novak Djokovic	0.1109364627	0.076150615	0.1483970690	0.17144300	NA	0.8616486
Karen Khachanov	0.0960639298	0.061436164	0.1059967623	0.04544955	NA	0.8339594
Juan Martin del Potro	0.1003931993	0.042025222	0.0847985439	0.05943767	NA	0.8218308
Rafael Nadal	0.0480432305	0.051531252	0.0790179917	0.08181694	NA	0.8032543
Gilles Simon	0.0646937767	0.084843307	0.0901401318	0.08675350	NA	0.7985995
Roger Federer	0.0452014997	0.040992497	0.0725719954	0.01817046	NA	0.7962289
Kei Nishikori	0.0777155934	0.018720226	0.0800648870	0.02740276	NA	0.7843631
Marin Cilic	0.0285413602	0.053017465	0.0736687072	0.08883055	NA	0.7804876
Tomas Berdych	0.0471654691	0.047289449	0.0737401748	0.10584114	NA	0.7739211
Daniil Medvedev	0.0275430665	0.031121856	0.0721948279	0.01803757	NA	0.7543269
Stefanos Tsitsipas	0.0470382377	0.023825850	0.0577628626	0.02105227	NA	0.7511674
Dominic Thiem	0.0258904189	0.032481624	0.0483707080	0.05857158	NA	0.7451547
Alexander Zverev	0.0006199716	0.044811275	0.0380134371	0.08423392	NA	0.7374897
Kyle Edmund	0.0558006240	0.011963627	0.0478850676	0.05142186	NA	0.7304873
Pablo Carreno Busta	0.0321878318	0.029862068	0.0413674481	-0.00229784	NA	0.7302043
Borna Coric	0.0762084129	-0.010097922	0.0413621283	-0.01924267	NA	0.7268124
Kevin Anderson	0.0907358428	-0.027171681	0.0381421997	-0.06362578	NA	0.7260799
David Goffin	-0.0034821911	0.037247336	0.0162572061	0.05603565	NA	0.7155908
Fernando Verdasco	0.0229261365	0.032884054	0.0521212576	0.04668854	NA	0.7120831
Roberto Bautista Agut	0.0047641170	0.049939608	0.0218975349	0.07331023	NA	0.7009891
Milos Raonic	0.0849726089	-0.028732182	0.0385944327	-0.08009382	NA	0.6986865
Fabio Fognini	-0.0394792678	0.047935185	0.0226546894	0.06213496	NA	0.6982031
Hyeon Chung	0.0042489153	0.047722133	0.0158096386	0.04823304	NA	0.6958943
Jack Sock	-0.0099659903	0.026454984	0.0186547428	0.02307214	NA	0.6757770
Diego Schwartzman	-0.0317130675	0.032098381	0.0006215006	0.05621187	NA	0.6631067
John Millman	0.0016290285	0.042676556	0.0119857356	0.06228135	NA	0.6603912
Nikoloz Basilashvili	-0.0099968609	0.005561102	0.0473876170	0.03661962	NA	0.6602628
John Isner	0.1346946527	-0.070556940	0.0161348609	-0.11425009	NA	0.6598097
Gael Monfils	-0.0074254934	0.024286746	0.0295568649	0.04007519	NA	0.6449506
Richard Gasquet	0.0296009556	-0.011382437	0.0013138324	-0.03972967	NA	0.6442043
...	...	...	...	...	...	...
Laslo Djere	-0.042300822	-0.0150684095	-0.064667709	-0.0349151578	NA	0.3606923
David Ferrer	-0.036179509	0.0532782117	0.012751020	0.0914824480	NA	0.3488057
Bradley Klahn	-0.001248083	-0.0444982448	-0.025987040	-0.1181295700	NA	0.3487806
Marcel Granollers	-0.031011830	-0.0094056152	-0.049853664	0.0136841358	NA	0.3460035
Ricardas Berankis	-0.022557215	-0.0103782963	-0.047937290	-0.0468488990	NA	0.3454980
Radu Albot	-0.040829057	0.0076150564	-0.034891704	0.0443672533	NA	0.3420615
Jordan Thompson	-0.068554906	0.0261969117	-0.044349181	0.0206636045	NA	0.3358572
Thomas Fabbiano	-0.060583307	0.0275756029	-0.025883493	0.0709707306	NA	0.3319778
Roberto Carballes Baena	-0.054016396	-0.0091521177	-0.019093050	0.0347187874	NA	0.3312105
Paolo Lorenzi	-0.038613500	-0.0212206827	-0.052602703	0.0199474025	NA	0.3299791
Guido Andreozzi	-0.038614385	-0.0133763922	0.029549861	0.0636745661	NA	0.3288762
Peter Polansky	0.007461636	-0.0163389196	-0.024034159	-0.0442144260	NA	0.3216756
Ernests Gulbis	-0.062827089	-0.0134699552	-0.027633425	-0.0518663252	NA	0.3123511
Thiago Monteiro	0.001235931	-0.0288349103	-0.043831840	-0.0654744344	NA	0.3122069
Casper Ruud	0.016838968	-0.0178511679	0.015234507	0.0219131874	NA	0.3119321
Marco Trungelliti	-0.022148774	-0.0005658242	0.048542554	0.1243537739	NA	0.3092636
Jiri Vesely	-0.050204009	-0.0351868278	-0.042887646	-0.0160467165	NA	0.3089287
Guillermo Garcia-Lopez	-0.090076100	-0.0108663630	-0.048712763	-0.0124446402	NA	0.3080898
Michael Mmoh	-0.063802934	-0.0079053251	-0.011112236	-0.0332042032	NA	0.2822330
Jason Kubler	-0.124758873	-0.0202756806	-0.013998570	0.1020895301	NA	0.2814246
Ruben Bemelmans	-0.029036164	-0.0138846550	-0.032256254	-0.0363563402	NA	0.2772185
Bjorn Fratangelo	-0.014149222	0.0033574304	-0.019931504	-0.0360199607	NA	0.2652527
Pablo Andujar	-0.042869833	-0.0488261697	-0.070057834	-0.0164918910	NA	0.2647100
Christian Garin	-0.046150875	0.0235799476	-0.006209664	0.0736304057	NA	0.2631607
Ivo Karlovic	0.071597162	-0.1093833837	0.001410787	-0.1237762218	NA	0.2500242
Juan Ignacio Londero	-0.026454456	-0.0715665271	-0.016749898	-0.0363353678	NA	0.2351747
Ramkumar Ramanathan	-0.005371622	-0.0606138479	-0.041631884	-0.0005573405	NA	0.2272977
Reilly Opelka	0.025704824	-0.0607219257	-0.015474944	-0.0720809006	NA	0.2262993
Carlos Berlocq	-0.063580460	0.0074576369	-0.054277974	-0.0165235079	NA	0.2112275
Pedro Sousa	-0.197333352	-0.0734557562	-0.161962722	-0.1023311674	NA	0.1502313

---

Disclaimer

Note that whilst models and automated strategies are fun and rewarding to create, we can't promise that your model or betting strategy will be profitable, and we make no representations in relation to the code shared or information on this page. If you're using this code or implementing your own strategies, you do so entirely at your own risk and you are responsible for any winnings/losses incurred. Under no circumstances will Betfair be liable for any loss or damage you suffer.