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