AFL teams Elo ratings and footy-tipping

# devtools::install_github("jimmyday12/fitzRoy")
# devtools::install_github("ellisp/frs-r-package/pkg")
library(tidyverse)
library(scales)
library(fitzRoy)   # for reading AFL scores
library(frs)       # for Elo functions
library(Cairo)
library(ggrepel)
library(lubridate)

# some parameters for graphics:
update_geom_defaults("text_repel", list(colour = "brown"))
the_caption <- "Source: afltables via fitZroy; analysis by freerangestats.info"

# download AFL results:
results <- get_match_results()

# set up a data frame in the right shape to sort through the games one at a time
r <- results %>%
  rename_all(tolower) %>%
  rename_all(function(x){gsub("\\.", "_", x)}) %>%
  # limit to 2018 season and earlier:
  filter(date < as.Date("2019-01-01")) %>%
  select(home_team, away_team, date, game, margin) %>%
  gather(location, team, -date, -game, -margin) %>%
  mutate(location = gsub("_team", "", location),
         margin = ifelse(location == "home", margin, -margin)) %>%
  mutate(winner = margin > 0) %>%
  arrange(date) %>%
  mutate(starting_elo = 1500,
         new_elo = 1500) %>%
  group_by(game) %>%
  # sequence so the winner is the first listed each time for each game:
  arrange(game, desc(winner))

#' Calculate Elo ratings for a data frame of AFL results
#' 
#' @param r a data frame with columns including date, team, game, starting_elo, new_elo
afl_elos <- function(r){
  r <- r %>%
    group_by(game) %>%
    arrange(date, game, desc(winner))
  
  all_games <- unique(r$game)
  
  # This loop will give some tidyverse advocates conniptions but it works for me; and
  # it seems inherently iterative so perhaps a loop is the logical way to do it:
  for(g in all_games){
    this_game <- r[r$game == g, ] 
    er <- elo_rating(a = this_game[1, "starting_elo"], 
                     b = this_game[2, "starting_elo"],
                     winner = "a",
                     ml = round(this_game[1, "margin"] / 6))
    
    r[r$game == g, "new_elo"]  <- unlist(c(er$a, er$b))
    r <- r %>%
      group_by(team) %>%
      mutate(starting_elo = lag(new_elo, default = 1500)) %>%
      ungroup()
  }
  r <- r %>%
    mutate(season = lubridate::year(date)) %>%
    group_by(game) %>%
    arrange(game, desc(starting_elo)) %>%
    mutate(predicted_winner = c(TRUE, FALSE),
           successful_prediction = predicted_winner == winner) %>%
    ungroup()
    
  return(r)
}

# Elo ratings if we started back in 1897 (takes a couple of minutes):
elos_all <- afl_elos(r)

# Plot of Elo ratings over all of history
elos_all %>%
  mutate(team = fct_reorder(team, -new_elo, .fun = last)) %>%
  ggplot(aes(x = date, y = new_elo, colour = team, group = paste(season, team))) +
  geom_line(size = 0.2) +
  theme(legend.position = "right") +
  labs(x = "", y = "Elo rating", colour = "",
       caption = the_caption) +
  ggtitle("Elo ratings of AFL / VFL teams, 1897 to present",
          "Elo rating calculated by modified FIBS method. Gaps in lines are the inter-season breaks.")

# Elo ratings if we did them only for last year:
elos_2018 <- r %>%
  filter(date > as.Date("2018-01-01")) %>%
  afl_elos()

# Elo ratings if we did them only from 2007 onwards
elos_2007 <- r %>%
  filter(date > as.Date("2007-01-01")) %>%
  afl_elos()

# Plot of Elo ratings if done just from 2018
elos_2018 %>%
  mutate(team = fct_reorder(team, -new_elo, .fun = last)) %>%
  ggplot(aes(x = date, y = new_elo, colour = team)) +
  geom_line() +
  theme(legend.position = "right") +
  labs(x = "", y = "Elo rating", colour = "",
       caption = the_caption) +
  ggtitle("Elo ratings of AFL / VFL teams, 2018 season",
          "Elo rating calculated by modified FIBS method, ignoring pre-2018 performance.")
  

# Plot of Elo ratings if done from 2007
elos_2007 %>%
  mutate(team = fct_reorder(team, -new_elo, .fun = last)) %>%
  ggplot(aes(x = date, y = new_elo, colour = team, group = paste(team, season))) +
  geom_line() +
  theme(legend.position = "right") +
  labs(x = "", y = "Elo rating", colour = "",
       caption = the_caption) +
  ggtitle("Elo ratings of AFL / VFL teams, 2007 to present",
          "Elo rating calculated by modified FIBS method, ignoring pre-2007 performance.")

#----------------is it best just to use recent Elo, or all history---------
# Elo ratings if we did them only for 2017
elos_2017_final <-  r %>%
  filter(year(date) == 2017) %>%
  afl_elos() %>%
  group_by(team) %>%
  arrange(desc(date)) %>%
  slice(1) %>%
  select(team, elo_2017 = new_elo) %>%
  ungroup()

# based on all history up to 2017 (already calculated this so can just filter to get it)
elos_2017_and_earlier <-  elos_all %>%
  filter(year(date) == 2017) %>%
  group_by(team) %>%
  arrange(desc(date)) %>%
  slice(1) %>%
  select(team, elo_up_to_2017 = new_elo) %>%
  ungroup() 

elos_2018_final <- elos_2018 %>%
  group_by(team) %>%
  arrange(desc(date)) %>%
  slice(1) %>%
  select(team, elo_2018 = new_elo) %>%
  ungroup() 

elos_two_types <- elos_2017_final %>%
  left_join(elos_2017_and_earlier, by = "team") %>%
  inner_join(elos_2018_final, by = "team")

elos_two_types %>%
  gather(variable, value, -team, -elo_2018) %>%
  ggplot(aes(x = value, y = elo_2018, label = team)) +
  geom_smooth(method = "gam") +
  geom_point() +
  facet_wrap(~variable, scales = "free_x") +
  geom_text_repel() +
  labs(x = "Elo rating before the 2018 season",
       y = "Elo rating at end of 2018",
       caption = the_caption) +
  ggtitle("Elo ratings at end of 2018 compared to two alternative starting points",
          "Horizontal axis for panel on left shows rating based on just 2017; on right is based on 1897 to 2017")

mod <- lm(elo_2018 ~ elo_up_to_2017 + elo_2017, data = elos_two_types)
summary(mod)
anova(mod)

# this suggests that Elo ratings have too long a memory; it is better 
# to shrink them towards 1500 in between each season



#---------------success over time-----------------

elos_2017_onwards <- r %>%
  filter(year(date) >= 2017) %>%
  afl_elos() %>%
  group_by(season) %>%
  summarise(successful_predictions = mean(predicted_winner == winner)) %>%
  mutate(method = "2017")

CairoSVG("../img/0147-success-rates.svg", 8, 4)
elos_all %>%
  group_by(season) %>%
  summarise(successful_predictions = mean(successful_prediction)) %>%
  mutate(method = "1897") %>%
  rbind(elos_2017_onwards) %>%
  ggplot(aes(x = season, y = successful_predictions, colour = method)) +
  geom_line() +
  labs(x = "Season", colour = "Prediction based on performance since:") +
  scale_y_continuous("Prediction success", label = percent_format(accuracy = 1)) +
  ggtitle("Success rate of predicted AFL outcomes from Elo rating based on full history")

#---------------current ratings--------------------------
# This provides round 1 tips for 2019
# The differ from the popular choice on two:
# Hawthorn predicted by me to beat Adelaide Crows, although tips are 88:12 other direction
# North Melbourne predicted by me to beat Fremantle, although tips are 62:38 in other direction
elos_2018 %>%
  group_by(team) %>%
  arrange(desc(date)) %>%
  slice(1) %>%
  ungroup() %>%
  arrange(desc(new_elo)) %>%
  select(team, new_elo) %>%
  knitr::kable() %>%
  clipr::write_clip()

thankr::shoulders() %>% 
  mutate(maintainer = str_squish(gsub("<.+>", "", maintainer))) %>%
  knitr::kable() %>% 
  clipr::write_clip()