This code calculates the ELO of teams that have made the top 8 in the AFL based on previous finals experience. The output of this model can be used to predict the outcomes of a finals series, and was initially used to predict the 2025 finals series, where it predicted the correct match ups and winners until the Grand Final, in which it predicted the Cats over the Lions. This code does not require overly complex models, and thus only two additional libraries are needed for this.
library(dplyr)
library(tidyverse)
I pulled the data manually from historic AFL tables on a match by match basis, including margins, winners and season played.
finals_data <- read.csv("AFL_Finals_ELO.csv")
There has been extensive research done into using ELO theory to rate teams and predict the outcome of sports. New research is being done in how the ELO rating system can be extended to predict margin of victory. My model is based on 4 key parts: 1. A bonus ELO rating for making the finals in a particular season 2. A decaying ELO for teams that miss out on finals 3. An increase/decrease of ELO based on games won/lost in the finals series 4. A margin bonus for bigger wins
teams <- unique(c(finals_data$Home, finals_data$Away))
elo <- setNames(rep(1500, length(teams)), trimws(teams))
# Setting metrics
margin_scale <- 0.1 #this changes how much each point won by adds to ELO
finals_bonus <- 100 #this is how many extra ELO points teams get for making the top 8
#For these, I've arbitrarily summed them to 50
K_win <- c(
"Elimination Final" = 20,
"Qualifying Final" = 20,
"Semi Final" = 25,
"Preliminary Final" = 35,
"Grand Final" = 50
)
K_loss <- c(
"Elimination Final" = 30,
"Qualifying Final" = 30,
"Semi Final" = 25,
"Preliminary Final" = 15,
"Grand Final" = 0
)
finals_data <- finals_data %>%
mutate(
Team = trimws(Home),
Opponent = trimws(Away),
Type = trimws(Type)
) %>%
arrange(Year)
elo_history <- data.frame()
Using these four parts, the ELO model provided the ranking of the top 8 teams for the 2025 finals series.
years <- sort(unique(finals_data$Year))
elo_history <- data.frame()
for (yr in years) {
# Identify finals teams this year
teams_this_year <- unique(c(
finals_data$Home[finals_data$Year == yr],
finals_data$Away[finals_data$Year == yr]
))
# Apply decay for teams that didn't make finals. Currently set at 10%
for (team in names(elo)) {
decay_rate <- ifelse(team %in% teams_this_year, 0.9, 0.8)
elo[team] <- 1500 + decay_rate * (elo[team] - 1500)
}
# Apply finals participation bonus
for (t in teams_this_year) {
if (is.na(elo[t])) elo[t] <- 1500
elo[t] <- elo[t] + finals_bonus
}
# Process each finals match
matches <- finals_data %>% filter(Year == yr)
for (i in 1:nrow(matches)) {
match <- matches[i, ]
if (any(is.na(match$Team), is.na(match$Opponent), is.na(match$Margin))) next
team1 <- match$Team
team2 <- match$Opponent
margin <- match$Margin
type <- match$Type
# Default to 1500 if missing
elo_team1 <- ifelse(is.na(elo[team1]), 1500, elo[team1])
elo_team2 <- ifelse(is.na(elo[team2]), 1500, elo[team2])
# Expected probability
E1 <- 1 / (1 + 10^((elo_team2 - elo_team1) / 400))
# Actual outcome
actual <- ifelse(margin > 0, 1, ifelse(margin < 0, 0, 0.5))
# Margin adjustment
margin_adj <- log(abs(margin) + 1) * margin_scale
# K-factors
K_w <- ifelse(is.na(K_win[type]), 20, K_win[type])
K_l <- ifelse(is.na(K_loss[type]), 20, K_loss[type])
if (actual == 1) {
change <- K_w * (actual - E1) * (1 + margin_adj)
} else if (actual == 0) {
change <- -K_l * (E1 - actual) * (1 + margin_adj)
} else {
change <- 0
}
# Update ratings
elo[team1] <- elo_team1 + change
elo[team2] <- elo_team2 - change
}
# Save Elo snapshot for this year
temp_df <- data.frame(
Year = yr,
Team = names(elo),
Elo = as.numeric(elo)
)
elo_history <- rbind(elo_history, temp_df)
}
finals2025_teams <- c("Adelaide", "Brisbane Lions", "Geelong", "Collingwood",
"Greater Western Sydney", "Fremantle", "Gold Coast", "Hawthorn")
elo_2025 <- sapply(finals2025_teams, function(team) ifelse(is.na(elo[team]), 1500, elo[team]))
elo_2025_df <- data.frame(
Team = finals2025_teams,
Finals_Elo = elo_2025
) %>%
arrange(desc(Finals_Elo))
print(elo_2025_df)
# ELO Plot
filtered_df <- elo_history %>%
filter(Team %in% finals2025_teams)
ggplot(filtered_df, aes(x = Year, y = Elo, color = Team)) +
geom_line(size = 1) +
theme_minimal() +
labs(
title = "ELO Ratings Over Time – 2025 Top 8 Teams",
x = "Year",
y = "ELO Rating",
color = "Team"
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
legend.position = "right"
)
All in all, it’s a cool way to see who is better prepared for a finals run, and who is inexperienced. Ultimately for the Crows, they were just too inexperienced in 2025, which is why there were subject to going out in straight sets despite earning the minor premiership.