library(dplyr)
library(stringr)url <- "https://raw.githubusercontent.com/LBoodram26/Data607_-Week-5/refs/heads/main/tournamentinfo.txt"
tournament <- readLines(url)
head(tournament, 20)## [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] "-----------------------------------------------------------------------------------------"
## [11] " 3 | ADITYA BAJAJ |6.0 |L 8|W 61|W 25|W 21|W 11|W 13|W 12|"
## [12] " MI | 14959604 / R: 1384 ->1640 |N:2 |W |B |W |B |W |B |W |"
## [13] "-----------------------------------------------------------------------------------------"
## [14] " 4 | PATRICK H SCHILLING |5.5 |W 23|D 28|W 2|W 26|D 5|W 19|D 1|"
## [15] " MI | 12616049 / R: 1716 ->1744 |N:2 |W |B |W |B |W |B |B |"
## [16] "-----------------------------------------------------------------------------------------"
## [17] " 5 | HANSHI ZUO |5.5 |W 45|W 37|D 12|D 13|D 4|W 14|W 17|"
## [18] " MI | 14601533 / R: 1655 ->1690 |N:2 |B |W |B |W |B |W |B |"
## [19] "-----------------------------------------------------------------------------------------"
## [20] " 6 | HANSEN SONG |5.0 |W 34|D 29|L 11|W 35|D 10|W 27|W 21|"player_lines <- tournament[seq(5, length(tournament), by = 3)]
players <- data.frame(
player_number = as.numeric(str_extract(player_lines, "^\\s*\\d+")),
player_name = str_trim(str_sub(player_lines, 8, 40)),
total_points = as.numeric(str_extract(str_sub(player_lines, 41, 50), "\\d+\\.?\\d*"))
)
head(players)## player_number player_name total_points
## 1 1 GARY HUA 6.0
## 2 2 DAKSHESH DARURI 6.0
## 3 3 ADITYA BAJAJ 6.0
## 4 4 PATRICK H SCHILLING 5.5
## 5 5 HANSHI ZUO 5.5
## 6 6 HANSEN SONG 5.0rating_lines <- tournament[seq(6, length(tournament), by = 3)]
pre_ratings <- as.numeric(
str_match(rating_lines, "R:\\s*(\\d+)")[, 2]
)
players$pre_rating <- pre_ratings
head(players)## player_number player_name total_points pre_rating
## 1 1 GARY HUA 6.0 1794
## 2 2 DAKSHESH DARURI 6.0 1553
## 3 3 ADITYA BAJAJ 6.0 1384
## 4 4 PATRICK H SCHILLING 5.5 1716
## 5 5 HANSHI ZUO 5.5 1655
## 6 6 HANSEN SONG 5.0 1686round_data <- str_extract_all(
player_lines,
"[WLD]\\s*\\d+"
)
head(round_data)## [[1]]
## [1] "W 39" "W 21" "W 18" "W 14" "W 7" "D 12" "D 4"
##
## [[2]]
## [1] "W 63" "W 58" "L 4" "W 17" "W 16" "W 20" "W 7"
##
## [[3]]
## [1] "L 8" "W 61" "W 25" "W 21" "W 11" "W 13" "W 12"
##
## [[4]]
## [1] "W 23" "D 28" "W 2" "W 26" "D 5" "W 19" "D 1"
##
## [[5]]
## [1] "W 45" "W 37" "D 12" "D 13" "D 4" "W 14" "W 17"
##
## [[6]]
## [1] "W 34" "D 29" "L 11" "W 35" "D 10" "W 27" "W 21"game_data <- data.frame(
player_number = rep(players$player_number, lengths(round_data)),
result = unlist(lapply(round_data, function(x) str_extract(x, "[WLD]"))),
opponent_number = as.numeric(
unlist(lapply(round_data, function(x) str_extract(x, "\\d+")))
)
)
head(game_data, 15)## player_number result opponent_number
## 1 1 W 39
## 2 1 W 21
## 3 1 W 18
## 4 1 W 14
## 5 1 W 7
## 6 1 D 12
## 7 1 D 4
## 8 2 W 63
## 9 2 W 58
## 10 2 L 4
## 11 2 W 17
## 12 2 W 16
## 13 2 W 20
## 14 2 W 7
## 15 3 L 8game_data <- game_data %>%
left_join(
players %>% select(player_number, pre_rating),
by = "player_number"
) %>%
rename(player_rating = pre_rating)
game_data <- game_data %>%
left_join(
players %>% select(player_number, pre_rating),
by = c("opponent_number" = "player_number")
) %>%
rename(opponent_rating = pre_rating)
head(game_data, 15)## player_number result opponent_number player_rating opponent_rating
## 1 1 W 39 1794 1436
## 2 1 W 21 1794 1563
## 3 1 W 18 1794 1600
## 4 1 W 14 1794 1610
## 5 1 W 7 1794 1649
## 6 1 D 12 1794 1663
## 7 1 D 4 1794 1716
## 8 2 W 63 1553 1175
## 9 2 W 58 1553 917
## 10 2 L 4 1553 1716
## 11 2 W 17 1553 1629
## 12 2 W 16 1553 1604
## 13 2 W 20 1553 1595
## 14 2 W 7 1553 1649
## 15 3 L 8 1384 1641game_data <- game_data %>%
mutate(
expected_score = 1 / (
1 + 10^((opponent_rating - player_rating) / 400)
)
)
head(game_data, 15)## player_number result opponent_number player_rating opponent_rating
## 1 1 W 39 1794 1436
## 2 1 W 21 1794 1563
## 3 1 W 18 1794 1600
## 4 1 W 14 1794 1610
## 5 1 W 7 1794 1649
## 6 1 D 12 1794 1663
## 7 1 D 4 1794 1716
## 8 2 W 63 1553 1175
## 9 2 W 58 1553 917
## 10 2 L 4 1553 1716
## 11 2 W 17 1553 1629
## 12 2 W 16 1553 1604
## 13 2 W 20 1553 1595
## 14 2 W 7 1553 1649
## 15 3 L 8 1384 1641
## expected_score
## 1 0.8870357
## 2 0.7907981
## 3 0.7533861
## 4 0.7425356
## 5 0.6973451
## 6 0.6800707
## 7 0.6104024
## 8 0.8980683
## 9 0.9749402
## 10 0.2812432
## 11 0.3923389
## 12 0.4271277
## 13 0.4398499
## 14 0.3652567
## 15 0.1855164game_data <- game_data %>%
mutate(
actual_score = case_when(
result == "W" ~ 1,
result == "D" ~ 0.5,
result == "L" ~ 0
)
)
head(game_data, 15)## player_number result opponent_number player_rating opponent_rating
## 1 1 W 39 1794 1436
## 2 1 W 21 1794 1563
## 3 1 W 18 1794 1600
## 4 1 W 14 1794 1610
## 5 1 W 7 1794 1649
## 6 1 D 12 1794 1663
## 7 1 D 4 1794 1716
## 8 2 W 63 1553 1175
## 9 2 W 58 1553 917
## 10 2 L 4 1553 1716
## 11 2 W 17 1553 1629
## 12 2 W 16 1553 1604
## 13 2 W 20 1553 1595
## 14 2 W 7 1553 1649
## 15 3 L 8 1384 1641
## expected_score actual_score
## 1 0.8870357 1.0
## 2 0.7907981 1.0
## 3 0.7533861 1.0
## 4 0.7425356 1.0
## 5 0.6973451 1.0
## 6 0.6800707 0.5
## 7 0.6104024 0.5
## 8 0.8980683 1.0
## 9 0.9749402 1.0
## 10 0.2812432 0.0
## 11 0.3923389 1.0
## 12 0.4271277 1.0
## 13 0.4398499 1.0
## 14 0.3652567 1.0
## 15 0.1855164 0.0player_performance <- game_data %>%
group_by(player_number) %>%
summarise(
expected_total = sum(expected_score, na.rm = TRUE),
actual_total = sum(actual_score, na.rm = TRUE)
) %>%
left_join(
players %>% select(
player_number,
player_name,
pre_rating,
total_points
),
by = "player_number"
) %>%
mutate(
performance_difference = actual_total - expected_total
) %>%
select(
player_number,
player_name,
pre_rating,
total_points,
expected_total,
actual_total,
performance_difference
)
head(player_performance, 10)## # A tibble: 10 × 7
## player_number player_name pre_rating total_points expected_total actual_total
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1 GARY HUA 1794 6 5.16 6
## 2 2 DAKSHESH D… 1553 6 3.78 6
## 3 3 ADITYA BAJ… 1384 6 1.95 6
## 4 4 PATRICK H … 1716 5.5 4.74 5.5
## 5 5 HANSHI ZUO 1655 5.5 4.38 5.5
## 6 6 HANSEN SONG 1686 5 4.94 5
## 7 7 GARY DEE S… 1649 5 4.58 5
## 8 8 EZEKIEL HO… 1641 5 5.03 5
## 9 9 STEFANO LEE 1411 5 2.29 5
## 10 10 ANVIT RAO 1365 5 1.94 5
## # ℹ 1 more variable: performance_difference <dbl>top_overperformers <- player_performance %>%
arrange(desc(performance_difference)) %>%
slice_head(n = 5)
top_overperformers## # A tibble: 5 × 7
## player_number player_name pre_rating total_points expected_total actual_total
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 3 ADITYA BAJAJ 1384 6 1.95 6
## 2 15 ZACHARY JAM… 1220 4.5 1.37 4.5
## 3 10 ANVIT RAO 1365 5 1.94 5
## 4 46 JACOB ALEXA… 377 3 0.0432 3
## 5 9 STEFANO LEE 1411 5 2.29 5
## # ℹ 1 more variable: performance_difference <dbl>top_underperformers <- player_performance %>%
arrange(performance_difference) %>%
slice_head(n = 5)
top_underperformers## # A tibble: 5 × 7
## player_number player_name pre_rating total_points expected_total actual_total
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 25 LOREN SCHWI… 1745 3.5 6.28 3.5
## 2 30 GEORGE AVER… 1522 3.5 6.02 3.5
## 3 54 LARRY HODGE 1270 2 3.40 1
## 4 42 JARED GE 1332 3 5.01 3
## 5 31 RISHI SHETTY 1494 3.5 5.09 3.5
## # ℹ 1 more variable: performance_difference <dbl>The results show that Aditya Bajaj had the largest positive performance difference. Based on his Elo rating, his expected score was approximately 1.95 points, but he earned 6.0 points in his rated games. This means he performed about 4.05 points better than expected.
The other strongest overperformers were Zachary James Houghton, Anvit Rao, Jacob Alexander Lavalley, and Stefano Lee.
Loren Schwiebert had the largest negative performance difference. His expected score was approximately 6.28 points, but he earned 3.5 points, which was about 2.78 points below his expected performance.
The other largest underperformers were George Avery Jones, Larry Hodge, Jared Ge, and Rishi Shetty.
Overall, the Elo calculations show how a player’s actual performance against rated opponents can differ from the performance predicted by their pre-tournament Elo rating.
singingbanana. (2019, February 15). The Elo Rating System for Chess and Beyond [Video]. YouTube. https://www.youtube.com/watch?v=AsYfbmp0To0
Tournament Information Dataset. GitHub. https://raw.githubusercontent.com/LBoodram26/Data607_-Week-5/refs/heads/main/tournamentinfo.txt
Wickham, H., François, R., Henry, L., Müller, K., & Vaughan, D. dplyr: A Grammar of Data Manipulation. Tidyverse. https://dplyr.tidyverse.org/
Tidyverse. Mutating Joins – dplyr. https://dplyr.tidyverse.org/reference/mutate-joins.html
Tidyverse. summarise(): Summarise Each Group Down to One Row – dplyr. https://dplyr.tidyverse.org/reference/summarise.html
Tidyverse. arrange(): Order Rows Using Column Values – dplyr. https://dplyr.tidyverse.org/reference/arrange.html
Tidyverse. slice(): Subset Rows Using Their Positions – dplyr. https://dplyr.tidyverse.org/reference/slice.html
Wickham, H. stringr: Simple, Consistent Wrappers for Common String Operations. Tidyverse. https://stringr.tidyverse.org/
Tidyverse. str_extract(): Extract the Complete Match – stringr. https://stringr.tidyverse.org/reference/str_extract.html
Tidyverse. str_match(): Extract Components from a Match – stringr. https://stringr.tidyverse.org/reference/str_match.html
Posit. R Markdown: HTML Document. https://rmarkdown.rstudio.com/docs/reference/html_document.html