tournament <- readLines(
"https://raw.githubusercontent.com/mj-nurse/mnurse-data_607/refs/heads/main/project-01-chess-tournament/tournamentinfo.txt"
)## Warning in
## readLines("https://raw.githubusercontent.com/mj-nurse/mnurse-data_607/refs/heads/main/project-01-chess-tournament/tournamentinfo.txt"):
## incomplete final line found on
## 'https://raw.githubusercontent.com/mj-nurse/mnurse-data_607/refs/heads/main/project-01-chess-tournament/tournamentinfo.txt'head(tournament, 10)## [1] "-----------------------------------------------------------------------------------------"
## [2] " Pair | Player Name |Total|Round|Round|Round|Round|Round|Round|Round| "
## [3] " Num | USCF ID / Rtg (Pre->Post) | Pts | 1 | 2 | 3 | 4 | 5 | 6 | 7 | "
## [4] "-----------------------------------------------------------------------------------------"
## [5] " 1 | GARY HUA |6.0 |W 39|W 21|W 18|W 14|W 7|D 12|D 4|"
## [6] " ON | 15445895 / R: 1794 ->1817 |N:2 |W |B |W |B |W |B |W |"
## [7] "-----------------------------------------------------------------------------------------"
## [8] " 2 | DAKSHESH DARURI |6.0 |W 63|W 58|L 4|W 17|W 16|W 20|W 7|"
## [9] " MI | 14598900 / R: 1553 ->1663 |N:2 |B |W |B |W |B |W |B |"
## [10] "-----------------------------------------------------------------------------------------"# Number of players in the tournament
n_players <- 64
# Create an empty data frame for the player information
players <- data.frame(
Player_Num = integer(n_players),
Player_Name = character(n_players),
Player_State = character(n_players),
Total_Points = numeric(n_players),
Pre_Rating = integer(n_players)
)
# Create an empty matrix for the 7 rounds
opponents <- matrix(
NA_integer_,
nrow = n_players,
ncol = 7
)
colnames(opponents) <- paste0("Round_", 1:7)
# Go through each player
for (i in 1:n_players) {
# Each player has two lines followed by a separator
player_line <- tournament[5 + (i - 1) * 3]
detail_line <- tournament[6 + (i - 1) * 3]
# Split the lines at each |
player_parts <- strsplit(player_line, "|", fixed = TRUE)[[1]]
detail_parts <- strsplit(detail_line, "|", fixed = TRUE)[[1]]
# Extract basic player information
players$Player_Num[i] <- as.integer(trimws(player_parts[1]))
players$Player_Name[i] <- trimws(player_parts[2])
players$Total_Points[i] <- as.numeric(trimws(player_parts[3]))
players$Player_State[i] <- trimws(detail_parts[1])
# Extract the pre-tournament rating
rating <- strsplit(detail_parts[2], "R:", fixed = TRUE)[[1]][2]
rating <- strsplit(rating, "->", fixed = TRUE)[[1]][1]
rating <- strsplit(trimws(rating), "P", fixed = TRUE)[[1]][1]
players$Pre_Rating[i] <- as.integer(trimws(rating))
# Extract opponent numbers from each round
for (round in 1:7) {
round_text <- trimws(player_parts[3 + round])
if (nchar(round_text) > 1) {
opponent_number <- trimws(
substr(round_text, 2, nchar(round_text))
)
opponents[i, round] <- as.integer(opponent_number)
} else {
opponents[i, round] <- NA
}
}
}
# Show the first few results
head(players)## Player_Num Player_Name Player_State Total_Points Pre_Rating
## 1 1 GARY HUA ON 6.0 1794
## 2 2 DAKSHESH DARURI MI 6.0 1553
## 3 3 ADITYA BAJAJ MI 6.0 1384
## 4 4 PATRICK H SCHILLING MI 5.5 1716
## 5 5 HANSHI ZUO MI 5.5 1655
## 6 6 HANSEN SONG OH 5.0 1686head(opponents)## Round_1 Round_2 Round_3 Round_4 Round_5 Round_6 Round_7
## [1,] 39 21 18 14 7 12 4
## [2,] 63 58 4 17 16 20 7
## [3,] 8 61 25 21 11 13 12
## [4,] 23 28 2 26 5 19 1
## [5,] 45 37 12 13 4 14 17
## [6,] 34 29 11 35 10 27 21expected_score <- function(player_rating, opponent_rating) {
1 / (1 + 10 ^ ((opponent_rating - player_rating) / 400))
}
players$Pair_Num <- 1:nrow(players)
players$Expected_Score <- NA_real_
for (i in 1:n_players) {
opponent_numbers <- opponents[i, ]
opponent_numbers <- opponent_numbers[!is.na(opponent_numbers)]
expected_points <- c()
for (j in opponent_numbers) {
opponent_row <- match(j, players$Pair_Num)
player_rating <- players$Pre_Rating[i]
opponent_rating <- players$Pre_Rating[opponent_row]
game_expected <- expected_score(
player_rating,
opponent_rating
)
expected_points <- c(expected_points, game_expected)
}
players$Expected_Score[i] <- round(
sum(expected_points),
2
)
}
head(players[, c(
"Player_Name",
"Pre_Rating",
"Total_Points",
"Expected_Score"
)])## Player_Name Pre_Rating Total_Points Expected_Score
## 1 GARY HUA 1794 6.0 5.16
## 2 DAKSHESH DARURI 1553 6.0 3.78
## 3 ADITYA BAJAJ 1384 6.0 1.95
## 4 PATRICK H SCHILLING 1716 5.5 4.74
## 5 HANSHI ZUO 1655 5.5 4.38
## 6 HANSEN SONG 1686 5.0 4.94players$Performance_Difference <- round(
players$Total_Points - players$Expected_Score,
2
)
top_overperformers <- players %>%
arrange(desc(Performance_Difference)) %>%
select(
Player_Name,
Pre_Rating,
Total_Points,
Expected_Score,
Performance_Difference
) %>%
head(5)
top_overperformers## Player_Name Pre_Rating Total_Points Expected_Score
## 1 ADITYA BAJAJ 1384 6.0 1.95
## 2 ZACHARY JAMES HOUGHTON 1220 4.5 1.37
## 3 ANVIT RAO 1365 5.0 1.94
## 4 JACOB ALEXANDER LAVALLEY 377 3.0 0.04
## 5 AMIYATOSH PWNANANDAM 980 3.5 0.77
## Performance_Difference
## 1 4.05
## 2 3.13
## 3 3.06
## 4 2.96
## 5 2.73top_underperformers <- players %>%
arrange(Performance_Difference) %>%
select(
Player_Name,
Pre_Rating,
Total_Points,
Expected_Score,
Performance_Difference
) %>%
head(5)
top_underperformers## Player_Name Pre_Rating Total_Points Expected_Score
## 1 LOREN SCHWIEBERT 1745 3.5 6.28
## 2 GEORGE AVERY JONES 1522 3.5 6.02
## 3 JARED GE 1332 3.0 5.01
## 4 RISHI SHETTY 1494 3.5 5.09
## 5 JOSHUA DAVID LEE 1438 3.5 4.96
## Performance_Difference
## 1 -2.78
## 2 -2.52
## 3 -2.01
## 4 -1.59
## 5 -1.46Aditya Bajaj was the largest overperformer, scoring 6.0 points compared with an expected score of 1.95, so a difference of 4.05 points. Loren Schwiebert was the largest underperformer, scoring 3.5 points compared with an expected score of 6.28, so a difference of -2.78 points. Overall, the results show how actual tournament performance can differ significantly from what would be expected based only on pre-tournament Elo ratings.
Source: Elo rating system, https://en.wikipedia.org/wiki/Elo_rating_system