We are now in week 5 and for Assignment 5B, we are tying back into the project we did for week 1. We are still using the same chess tournament text file from last week but taking a different approach. We are now implementing the ELO rating system for chess players and must calculate each player’s expected score. We’ll then list the five players that overperformed in comparison to their expected score and list another five players that underperformed in comparison to their expected score.
I’ll utilize the cleaned dataset from project 1 and make sure that all player ratings and opponent IDs are accessible. I will then create a function in R to calculate the Elo expectation for the relevant players, using a cited formula of my choosing. I’ll calculate the expected outcome for every player and each game played, and get the sum of those values to find their total expected score. The next step would be to subtract the expected score from the actual total points to see the performance difference. Lastly I’ll want to pick the bottom 5 players that were underperformers and the top 5 overperformers.
One major challenge is working with the players that had unplayed “bye” games. The unplayed games can impact the elo rating, so it’s required that unplayed games be excluded to not negatively impact the results. Additionally, I’ll need to use the pre-ratings for both player and opponent to maintain the consistency of the predictive model
ELO Formula Source: https://en.wikipedia.org/wiki/Elo_rating_system (Mathematical details)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(stringr)calc_expected <- function(player_rtg, opp_rtg) {
return(1 / (1+10^((opp_rtg - player_rtg) / 400)))
}player_data <- read_csv("tournament_results.csv") %>%
mutate(PairID = row_number()) %>%
select(PairID, PlayerName, PreRating, TotalPoints)## Rows: 64 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): PlayerName, State
## dbl (3): TotalPoints, PreRating, AvgOpponentRating
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.raw_txt <- readLines("tournamentinfo.txt")## Warning in readLines("tournamentinfo.txt"): incomplete final line found on
## 'tournamentinfo.txt'matchups <- data.frame(line = raw_txt) %>%
filter(str_detect(line, "^\\s+\\d+ ")) %>%
mutate(
PairID = as.numeric(str_extract(line, "\\d+")),
OpponentID = str_extract_all(line, "[WLD]\\s+\\d+")
) %>%
unnest(OpponentID) %>%
mutate(
OpponentID = as.numeric(str_extract(OpponentID, "\\d+"))
)final_analysis <- matchups %>%
left_join(player_data, by = c("PairID" = "PairID")) %>%
left_join(player_data %>% select(PairID, PreRating),
by = c("OpponentID" = "PairID"),
suffix = c("_player", "_opp")) %>%
mutate(Expected = calc_expected(PreRating_player, PreRating_opp)) %>%
group_by(PlayerName, TotalPoints) %>%
summarise(Sum_Expected = sum(Expected, na.rm = TRUE), .groups = 'drop') %>%
mutate(Difference = round(TotalPoints - Sum_Expected, 2))overperformers <- final_analysis %>%
arrange(desc(Difference)) %>%
head(5)underperformers <- final_analysis %>%
arrange(Difference) %>%
head(5)overperformers## # A tibble: 5 × 4
## PlayerName TotalPoints Sum_Expected Difference
## <chr> <dbl> <dbl> <dbl>
## 1 ADITYA BAJAJ 6 1.95 4.05
## 2 ZACHARY JAMES HOUGHTON 4.5 1.37 3.13
## 3 ANVIT RAO 5 1.94 3.06
## 4 JACOB ALEXANDER LAVALLEY 3 0.0432 2.96
## 5 AMIYATOSH PWNANANDAM 3.5 0.773 2.73underperformers## # A tibble: 5 × 4
## PlayerName TotalPoints Sum_Expected Difference
## <chr> <dbl> <dbl> <dbl>
## 1 LOREN SCHWIEBERT 3.5 6.28 -2.78
## 2 GEORGE AVERY JONES 3.5 6.02 -2.52
## 3 JARED GE 3 5.01 -2.01
## 4 RISHI SHETTY 3.5 5.09 -1.59
## 5 JOSHUA DAVID LEE 3.5 4.96 -1.46After analyzing there’s a gap between the predicted and actual outcomes. Aditya Bajaj was the top overperformer and finished with 4.05 points above his Elo expectation. Meanwhile Loren Schwiebert was the top underperformer and finished below his expectation. The model correctly identified players that exceeded or fell short of their pre-tournament projections.