Ratings and Simulations

Welcome to our all new AFL Men’s ratings and tips page! Here you will the latest ratings, tips for the upcoming rounds and any simulations that have been done. I’ll usually aim to update these early in the week to give you time to digest Any questions, let me know on Twitter!

Last updated: 2018-04-16.

# Load libraries
library(pacman)
pacman::p_load(fitzRoy, tidyverse, formattable, 
               ggthemes, elo, here, lubridate, 
               widgetframe, ggridges, DT)

# Load data that has been run using 'weekly_data_process.R'
dat_list <- read_rds(here::here("data", "raw-data", "AFLM.rds"))
sim_dat_list <- read_rds(here::here("data", "raw-data", "AFLM_sims.rds"))

Summary

Below are the updated AFL Men’s ratings and simulations. These are based off our ELO model (insert explainer) and simulations (insert explainer).

First, let’s get our data into a good format.

# Get the round data
elo_round <- dat_list$elo %>%
  filter(Game == last(Game) & !Team %in% c("Fitzroy", "University"))

sim_round <- sim_dat_list$sim_data_summary %>%
  filter(Round == last(dat_list$elo$Round.Number))

# Combine Simulation and ELO data
elo_table <- elo_round %>%
  left_join(sim_round, by = "Team") %>%
  ungroup() %>%
  mutate(ELO.change = ELO - ELO_pre) %>%
  mutate_at(c("Top.8", "Top.4", "Top.1"), formattable::percent, digits = 1) %>%
  mutate_at(c("ELO", "ELO.change"), as.integer) %>%
  mutate_at("Wins", round, 1) %>%
  select(Team, ELO, ELO.change, Wins, Top.8, Top.4, Top.1) %>%
  arrange(desc(Wins))

Now we can pass that table onto formattable and create a slightly nicer table. I’ve also worked out that the framewidget package allows us to generate html widgets (which means interactive tables!)

# Write to formattable with some formatting
dt_elo <- elo_table %>%
  formattable(list(
    ELO = normalize_bar("#20B2AA80"),
    ELO.change = formatter(
      "span",
      style = ~ style(color = ifelse(ELO.change >= 0, "green", "red"))
    ),
    Top.8 = color_tile("transparent", "lightblue"),
    Top.4 = color_tile("transparent", "lightblue"),
    Top.1 = color_tile("transparent", "lightblue")
  )) %>%
  as.datatable(options = list(dom = "t", pageLength = 18))

frameWidget(dt_elo, height = 700, width = "95%")

And below you can see the change in ratings for each team.

# Create a subtitle for plot
subt <- paste(
  "Showing the ELO rating of each AFL Men's team at the end of Round",
  dat_list$elo$Round.Number %>% last(), "",
  dat_list$elo$Date %>% last() %>% year(),
  "in green,\nwith the tail showing their previous rating"
)

# Do ggplot
elo_round %>%
  ggplot(aes(x = reorder(Team, ELO))) +
  geom_hline(yintercept = 1500, alpha = 0.7, linetype = 3) +
  geom_linerange(aes(ymin = ELO_pre, ymax = ELO), alpha = 0.3) +
  geom_point(aes(y = ELO_pre), alpha = 0.1) +
  geom_point(aes(y = ELO), colour = "#669999", size = 2) +
  coord_flip() +
  theme_minimal() +
  labs(
    x = "Team",
    y = "ELO Rating",
    title = "AFL Men's ELO Ratings",
    subtitle = subt,
    caption = "(data sourced from afltables.com)"
  )

# Simulations In order to get our Top 8, Top 4 and Top 1 probabilities, we simulate the season 50 000 times. This has been optimised considerably this year (code to come) which is nice. The following plot shows a ridgegraph of the number of wins of each team in those simulations.