For this assignment, I am using the tournament data prepared in Project 1. The data includes each player’s pre-tournament rating, actual tournament score, and the player numbers of their opponents.
elo_data <- read.csv(
"C:/Users/munta/Documents/DATA607_Assignment5B/elo_data.csv"
)
head(elo_data)## Player_Number Player_Name Total_Points Pre_Rating Opponent_1
## 1 1 GARY HUA 6.0 1794 39
## 2 2 DAKSHESH DARURI 6.0 1553 63
## 3 3 ADITYA BAJAJ 6.0 1384 8
## 4 4 PATRICK H SCHILLING 5.5 1716 23
## 5 5 HANSHI ZUO 5.5 1655 45
## 6 6 HANSEN SONG 5.0 1686 34
## Opponent_2 Opponent_3 Opponent_4 Opponent_5 Opponent_6 Opponent_7
## 1 21 18 14 7 12 4
## 2 58 4 17 16 20 7
## 3 61 25 21 11 13 12
## 4 28 2 26 5 19 1
## 5 37 12 13 4 14 17
## 6 29 11 35 10 27 21The opponent columns currently contain player numbers rather than ratings. I used those player numbers to look up each opponent’s pre-tournament rating.
for (i in 1:7) {
opponent_col <- paste0("Opponent_", i)
rating_col <- paste0("Opponent_Rating_", i)
elo_data[[rating_col]] <- elo_data$Pre_Rating[
match(elo_data[[opponent_col]], elo_data$Player_Number)
]
}
head(elo_data)## Player_Number Player_Name Total_Points Pre_Rating Opponent_1
## 1 1 GARY HUA 6.0 1794 39
## 2 2 DAKSHESH DARURI 6.0 1553 63
## 3 3 ADITYA BAJAJ 6.0 1384 8
## 4 4 PATRICK H SCHILLING 5.5 1716 23
## 5 5 HANSHI ZUO 5.5 1655 45
## 6 6 HANSEN SONG 5.0 1686 34
## Opponent_2 Opponent_3 Opponent_4 Opponent_5 Opponent_6 Opponent_7
## 1 21 18 14 7 12 4
## 2 58 4 17 16 20 7
## 3 61 25 21 11 13 12
## 4 28 2 26 5 19 1
## 5 37 12 13 4 14 17
## 6 29 11 35 10 27 21
## Opponent_Rating_1 Opponent_Rating_2 Opponent_Rating_3 Opponent_Rating_4
## 1 1436 1563 1600 1610
## 2 1175 917 1716 1629
## 3 1641 955 1745 1563
## 4 1363 1507 1553 1579
## 5 1242 980 1663 1666
## 6 1399 1602 1712 1438
## Opponent_Rating_5 Opponent_Rating_6 Opponent_Rating_7
## 1 1649 1663 1716
## 2 1604 1595 1649
## 3 1712 1666 1663
## 4 1655 1564 1794
## 5 1716 1610 1629
## 6 1365 1552 1563for (i in 1:7) {
rating_col <- paste0("Opponent_Rating_", i)
expected_col <- paste0("Expected_", i)
elo_data[[expected_col]] <- 1 / (
1 + 10^((elo_data[[rating_col]] - elo_data$Pre_Rating) / 400)
)
}
head(elo_data)## Player_Number Player_Name Total_Points Pre_Rating Opponent_1
## 1 1 GARY HUA 6.0 1794 39
## 2 2 DAKSHESH DARURI 6.0 1553 63
## 3 3 ADITYA BAJAJ 6.0 1384 8
## 4 4 PATRICK H SCHILLING 5.5 1716 23
## 5 5 HANSHI ZUO 5.5 1655 45
## 6 6 HANSEN SONG 5.0 1686 34
## Opponent_2 Opponent_3 Opponent_4 Opponent_5 Opponent_6 Opponent_7
## 1 21 18 14 7 12 4
## 2 58 4 17 16 20 7
## 3 61 25 21 11 13 12
## 4 28 2 26 5 19 1
## 5 37 12 13 4 14 17
## 6 29 11 35 10 27 21
## Opponent_Rating_1 Opponent_Rating_2 Opponent_Rating_3 Opponent_Rating_4
## 1 1436 1563 1600 1610
## 2 1175 917 1716 1629
## 3 1641 955 1745 1563
## 4 1363 1507 1553 1579
## 5 1242 980 1663 1666
## 6 1399 1602 1712 1438
## Opponent_Rating_5 Opponent_Rating_6 Opponent_Rating_7 Expected_1 Expected_2
## 1 1649 1663 1716 0.8870357 0.7907981
## 2 1604 1595 1649 0.8980683 0.9749402
## 3 1712 1666 1663 0.1855164 0.9219774
## 4 1655 1564 1794 0.8841194 0.7690759
## 5 1716 1610 1629 0.9150891 0.9798780
## 6 1365 1552 1563 0.8391753 0.6185841
## Expected_3 Expected_4 Expected_5 Expected_6 Expected_7
## 1 0.7533861 0.7425356 0.6973451 0.6800707 0.6104024
## 2 0.2812432 0.3923389 0.4271277 0.4398499 0.3652567
## 3 0.1112454 0.2630052 0.1314590 0.1647472 0.1671373
## 4 0.7187568 0.6875382 0.5868950 0.7057814 0.3895976
## 5 0.4884891 0.4841750 0.4131050 0.5644005 0.5373473
## 6 0.4626527 0.8065275 0.8638715 0.6838163 0.6699690expected_cols <- paste0("Expected_", 1:7)
elo_data$Expected_Score <- rowSums(
elo_data[expected_cols],
na.rm = TRUE
)
elo_data$Performance_Difference <-
elo_data$Total_Points - elo_data$Expected_Score
performance <- elo_data[, c(
"Player_Name",
"Total_Points",
"Expected_Score",
"Performance_Difference"
)]
head(performance)## Player_Name Total_Points Expected_Score Performance_Difference
## 1 GARY HUA 6.0 5.161574 0.83842636
## 2 DAKSHESH DARURI 6.0 3.778825 2.22117517
## 3 ADITYA BAJAJ 6.0 1.945088 4.05491209
## 4 PATRICK H SCHILLING 5.5 4.741764 0.75823568
## 5 HANSHI ZUO 5.5 4.382484 1.11751602
## 6 HANSEN SONG 5.0 4.944596 0.05540355I was able to rank the players by the difference between their actual tournament score and their expected score. Positive differences showed overperformance, wheras negative differences indicated underperformance.
top_overperformers <- performance[
order(performance$Performance_Difference, decreasing = TRUE),
][1:5, ]
top_underperformers <- performance[
order(performance$Performance_Difference),
][1:5, ]
top_overperformers## Player_Name Total_Points Expected_Score Performance_Difference
## 3 ADITYA BAJAJ 6.0 1.94508791 4.054912
## 15 ZACHARY JAMES HOUGHTON 4.5 1.37330887 3.126691
## 10 ANVIT RAO 5.0 1.94485405 3.055146
## 46 JACOB ALEXANDER LAVALLEY 3.0 0.04324981 2.956750
## 37 AMIYATOSH PWNANANDAM 3.5 0.77345290 2.726547top_underperformers## Player_Name Total_Points Expected_Score Performance_Difference
## 25 LOREN SCHWIEBERT 3.5 6.275650 -2.775650
## 30 GEORGE AVERY JONES 3.5 6.018220 -2.518220
## 42 JARED GE 3.0 5.010416 -2.010416
## 31 RISHI SHETTY 3.5 5.092465 -1.592465
## 35 JOSHUA DAVID LEE 3.5 4.957890 -1.457890After revisting the Scores and ascertaining the ELO expectations, Aditya Bajaj had the biggest overperformance in the tournament. His expected score was about 1.95 points, whereas his actual score was 6.0, providing him a difference of around 4.05 points. Zachary James Houghton and Anvit Rao were the next biggest performances, suprassing their expectation by 3.13 - 3.06 points. The other part of the data points to Loren Schwiebert showing the biggest underperformance. His expected score was about 6.28 points as compared to the authentic score, 3.5.
Reference: ELO Formula Source: singingbanana. (2019, February 15). The Elo Rating System for Chess and Beyond [Video]. YouTube.
^The expected score for each matchup was computed through the above ELO formula.