├── images ├── 06_upsets.png ├── 04_winmatrix.png ├── 05_allgames.png ├── 01_allplayers.png ├── 03_playmatrix.png └── 02_individualplayers.png ├── .gitignore ├── install.R ├── README.md ├── server.R ├── games.csv ├── ui.R └── functions.R /images/06_upsets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/06_upsets.png -------------------------------------------------------------------------------- /images/04_winmatrix.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/04_winmatrix.png -------------------------------------------------------------------------------- /images/05_allgames.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/05_allgames.png -------------------------------------------------------------------------------- /images/01_allplayers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/01_allplayers.png -------------------------------------------------------------------------------- /images/03_playmatrix.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/03_playmatrix.png -------------------------------------------------------------------------------- /images/02_individualplayers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/chessclub/main/images/02_individualplayers.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .Rdata 4 | .httr-oauth 5 | .DS_Store 6 | chessclub.Rproj 7 | README.html 8 | rsconnect 9 | -------------------------------------------------------------------------------- /install.R: -------------------------------------------------------------------------------- 1 | ## dependencies: 2 | 3 | # dput(sort(unique(setdiff(renv::dependencies()$Package, "rsconnect")))) 4 | 5 | c( 6 | "dplyr", 7 | "DT", 8 | "elo", 9 | "ggplot2", 10 | "magrittr", 11 | "plotly", 12 | "rlang", 13 | "shiny", 14 | "shinydashboard", 15 | "tibble", 16 | "tidyr" 17 | ) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # chessclub 3 | 4 | 5 | 6 | 7 | Calculate progressive Elo rankings for your team. 8 | 9 | This shiny app takes a spreadsheet (CSV) of games played by players of a team (e.g. Chess), 10 | starts each player with an Elo score of 1000, then uses wins/losses/draws to calculate 11 | progressive Elo as more games are played. 12 | 13 | Set the team name and k-factor (default 40) in `functions.R`, and add a 14 | spreadsheet of played games as `games.csv` (example file included). 15 | 16 | ## Demo 17 | 18 | ![](images/01_allplayers.png) 19 | ![](images/02_individualplayers.png) 20 | ![](images/03_playmatrix.png) 21 | ![](images/04_winmatrix.png) 22 | ![](images/05_allgames.png) 23 | ![](images/06_upsets.png) 24 | 25 | ## Installation 26 | 27 | This app currently requires the following packages: 28 | 29 | ``` 30 | "dplyr", 31 | "DT", 32 | "elo", 33 | "ggplot2", 34 | "magrittr", 35 | "plotly", 36 | "rlang", 37 | "shiny", 38 | "shinydashboard", 39 | "tibble", 40 | "tidyr" 41 | ``` 42 | 43 | 44 | -------------------------------------------------------------------------------- /server.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinydashboard) 3 | 4 | source("functions.R") 5 | 6 | server <- function(input, output, session) { 7 | 8 | reload() 9 | 10 | for (i in seq_len(nrow(games))) { 11 | calc_elo(i) 12 | } 13 | 14 | updateSelectizeInput(session, "player", choices = unique(players$name)) 15 | 16 | output$allplayers <- plotly::renderPlotly({ 17 | all_charts_plotly() 18 | }) 19 | 20 | output$indivplayer_chart <- renderPlot({ 21 | chart_elo(input$player) 22 | }) 23 | 24 | output$indivplayer_table <- DT::renderDataTable({ 25 | table_elo(input$player) 26 | }, rownames = FALSE, options = list(pageLength = 100, dom = "ti")) 27 | 28 | output$indivgames_table <- DT::renderDataTable({ 29 | player_games(input$player) 30 | }, rownames = FALSE, options = list(pageLength = 100, dom = "ti")) 31 | 32 | output$playorwinmatrix <- renderPlot({ 33 | switch(input$playorwin, 34 | "Play" = plot_play_matrix(), 35 | "Win" = plot_win_matrix() 36 | ) 37 | }) 38 | 39 | output$games <- DT::renderDataTable({ 40 | games 41 | }, rownames = FALSE, options = list(pageLength = 100, dom = "fti")) 42 | 43 | output$upsets <- DT::renderDataTable({ 44 | largest_upsets() 45 | }, rownames = FALSE, options = list(pageLength = 20, dom = "ti")) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /games.csv: -------------------------------------------------------------------------------- 1 | date,p1_name,p2_name,p1_result 2 | 2023-01-21,PlayerA,PlayerB,0 3 | 2023-01-21,PlayerC,PlayerD,1 4 | 2023-01-21,PlayerE,PlayerF,0 5 | 2023-01-21,PlayerG,PlayerH,0 6 | 2023-01-21,PlayerI,PlayerJ,0 7 | 2023-01-21,PlayerL,PlayerM,1 8 | 2023-01-21,PlayerN,PlayerO,0.5 9 | 2023-01-23,PlayerL,PlayerN,1 10 | 2023-01-23,PlayerF,PlayerD,0.5 11 | 2023-01-23,PlayerN,PlayerF,0 12 | 2023-01-23,PlayerO,PlayerM,1 13 | 2023-01-23,PlayerB,PlayerO,0.5 14 | 2023-01-23,PlayerD,PlayerC,0 15 | 2023-01-23,PlayerH,PlayerJ,1 16 | 2023-01-23,PlayerA,PlayerL,0 17 | 2023-01-23,PlayerI,PlayerA,0 18 | 2023-01-23,PlayerM,PlayerG,1 19 | 2023-01-23,PlayerK,PlayerE,0.5 20 | 2023-01-23,PlayerE,PlayerK,0 21 | 2023-01-23,PlayerJ,PlayerB,1 22 | 2023-01-23,PlayerG,PlayerH,0.5 23 | 2023-01-23,PlayerC,PlayerI,0 24 | 2023-01-25,PlayerN,PlayerM,0 25 | 2023-01-25,PlayerD,PlayerK,1 26 | 2023-01-25,PlayerM,PlayerO,1 27 | 2023-01-25,PlayerJ,PlayerE,1 28 | 2023-01-25,PlayerE,PlayerL,0 29 | 2023-01-25,PlayerK,PlayerN,1 30 | 2023-01-25,PlayerL,PlayerF,1 31 | 2023-01-25,PlayerB,PlayerD,0 32 | 2023-01-25,PlayerF,PlayerH,0 33 | 2023-01-25,PlayerO,PlayerJ,1 34 | 2023-01-25,PlayerH,PlayerB,1 35 | 2023-01-27,PlayerH,PlayerC,0 36 | 2023-01-27,PlayerG,PlayerN,0.5 37 | 2023-01-27,PlayerO,PlayerH,1 38 | 2023-01-27,PlayerB,PlayerF,0 39 | 2023-01-27,PlayerD,PlayerL,0.5 40 | 2023-01-27,PlayerL,PlayerB,1 41 | 2023-01-27,PlayerE,PlayerI,0 42 | 2023-01-27,PlayerJ,PlayerA,0.5 43 | 2023-01-27,PlayerN,PlayerO,1 44 | 2023-01-27,PlayerF,PlayerD,0 45 | 2023-01-27,PlayerM,PlayerE,0.5 46 | 2023-01-27,PlayerK,PlayerM,1 47 | 2023-01-27,PlayerI,PlayerK,0 48 | 2023-01-27,PlayerA,PlayerG,0.5 49 | 2023-01-27,PlayerC,PlayerJ,1 50 | 2023-01-29,PlayerH,PlayerI,0.5 51 | 2023-01-29,PlayerD,PlayerN,1 52 | 2023-01-29,PlayerI,PlayerM,0.5 53 | 2023-01-29,PlayerF,PlayerE,0.5 54 | 2023-01-29,PlayerA,PlayerO,1 55 | 2023-01-29,PlayerC,PlayerL,0.5 56 | 2023-01-29,PlayerK,PlayerD,0.5 57 | 2023-01-29,PlayerB,PlayerG,1 58 | 2023-01-29,PlayerG,PlayerA,0.5 59 | 2023-01-29,PlayerE,PlayerC,0.5 60 | 2023-01-29,PlayerO,PlayerF,1 61 | 2023-01-29,PlayerM,PlayerJ,0.5 62 | 2023-01-29,PlayerN,PlayerB,0.5 63 | 2023-01-29,PlayerL,PlayerH,1 64 | 2023-01-29,PlayerJ,PlayerK,0.5 -------------------------------------------------------------------------------- /ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinydashboard) 3 | 4 | source("functions.R") 5 | 6 | dashboardPage( 7 | dashboardHeader(title = paste(CLUB_NAME, "Chess Club 2025")), 8 | ## Sidebar content 9 | dashboardSidebar( 10 | sidebarMenu( 11 | menuItem("All Players", tabName = "allplayers", icon = icon("users")), 12 | menuItem( 13 | "Individual Players", 14 | tabName = "indivplayers", 15 | icon = icon("user") 16 | ), 17 | menuItem("Pairings", tabName = "pairings", icon = icon("random")), 18 | menuItem("Games", tabName = "games", icon = icon("soccer-ball-o")), 19 | menuItem("Highlights", tabName = "highlights", icon = icon("star")), 20 | menuItem("Admin", tabName = "admin", icon = icon("unlock")) 21 | ) 22 | ), 23 | ## Body content 24 | dashboardBody( 25 | tabItems( 26 | # First tab content 27 | tabItem( 28 | tabName = "allplayers", 29 | fluidRow( 30 | box( 31 | plotly::plotlyOutput("allplayers", height = 500, width = 1000), 32 | width = 12 33 | ), 34 | ) 35 | ), 36 | 37 | # Second tab content 38 | tabItem( 39 | tabName = "indivplayers", 40 | fluidRow( 41 | box( 42 | width = 12, 43 | column(12, selectizeInput("player", "Player", choices = "")), 44 | column( 45 | 6, 46 | plotOutput("indivplayer_chart", height = 400, width = 600) 47 | ), 48 | column(4, offset = 2, DT::dataTableOutput("indivplayer_table")) 49 | ) 50 | ), 51 | fluidRow( 52 | box(width = 12, DT::dataTableOutput("indivgames_table")) 53 | ) 54 | ), 55 | tabItem( 56 | tabName = "pairings", 57 | fluidRow( 58 | box( 59 | width = 12, 60 | column( 61 | 12, 62 | radioButtons( 63 | "playorwin", 64 | "Play or Win Matrix?", 65 | choices = c("Play", "Win"), 66 | inline = TRUE 67 | ) 68 | ), 69 | column(12, plotOutput("playorwinmatrix", height = 800, width = 800)) 70 | ) 71 | ) 72 | ), 73 | tabItem( 74 | tabName = "games", 75 | fluidRow( 76 | box( 77 | width = 12, 78 | column(12, h2("All Games: "), DT::dataTableOutput("games")) 79 | ) 80 | ) 81 | ), 82 | tabItem( 83 | tabName = "highlights", 84 | fluidRow( 85 | box( 86 | width = 12, 87 | column(12, h2("Biggest Upsets:"), DT::dataTableOutput("upsets")) 88 | ) 89 | ) 90 | ) 91 | ) 92 | ) 93 | ) 94 | -------------------------------------------------------------------------------- /functions.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | CLUB_NAME = "DEMO" 4 | K_FACTOR = 40 5 | 6 | reload <- function(file = "games.csv") { 7 | games <<- read.csv(file) 8 | games$date <- as.Date(games$date, format = "%d/%m/%y") 9 | 10 | build_games <- function(d) { 11 | d <- dplyr::mutate(d, p1_elo = NA, .after = "p1_name") 12 | d <- dplyr::mutate(d, p2_elo = NA, .after = "p2_name") 13 | d <- dplyr::mutate(d, p1_prob_win = NA, .after = "p1_result") 14 | d <- dplyr::mutate(d, p1_new_elo = NA, .after = "p1_prob_win") 15 | d <- dplyr::mutate(d, p2_new_elo = NA, .after = "p1_new_elo") 16 | d 17 | } 18 | 19 | games <<- build_games(games) 20 | prior <- min(games$date) - 7 21 | 22 | build_players <- function(start_date = prior, start_elo = 1000L) { 23 | unique_players <- sort(unique(c(games$p1_name, games$p2_name))) 24 | data.frame(date = start_date, name = unique_players, elo = start_elo) 25 | } 26 | 27 | players <<- build_players() 28 | } 29 | 30 | calc_elo <- function(rownum, k = K_FACTOR) { 31 | # find current elos 32 | gamedata <- games[rownum, ] 33 | 34 | # calculate new elos 35 | gamedata$p1_elo <- tail(players[players$name == gamedata$p1_name, "elo"], 1) 36 | gamedata$p2_elo <- tail(players[players$name == gamedata$p2_name, "elo"], 1) 37 | pred <- elo::elo.prob(gamedata$p1_elo, gamedata$p2_elo) 38 | gamedata$p1_prob_win <- as.integer(100 * pred) 39 | result <- elo::elo.calc( 40 | gamedata$p1_result, 41 | gamedata$p1_elo, 42 | gamedata$p2_elo, 43 | k = k 44 | ) 45 | gamedata$p1_new_elo <- as.integer(result$elo.A) 46 | gamedata$p2_new_elo <- as.integer(result$elo.B) 47 | 48 | # update player data 49 | players <<- rbind( 50 | players, 51 | data.frame( 52 | date = gamedata$date, 53 | name = gamedata$p1_name, 54 | elo = gamedata$p1_new_elo 55 | ) 56 | ) 57 | players <<- rbind( 58 | players, 59 | data.frame( 60 | date = gamedata$date, 61 | name = gamedata$p2_name, 62 | elo = gamedata$p2_new_elo 63 | ) 64 | ) 65 | 66 | # update game data 67 | games[rownum, ] <<- gamedata 68 | } 69 | 70 | table_elo <- function(player) { 71 | players[players$name == player, ] 72 | } 73 | 74 | chart_elo <- function(player) { 75 | ggplot2::ggplot(table_elo(player), ggplot2::aes(date, elo)) + 76 | ggplot2::geom_line() + 77 | ggplot2::geom_point() + 78 | ggplot2::theme_bw() + 79 | ggplot2::labs( 80 | title = paste0("Player progress: ", player), 81 | x = "Date", 82 | y = "Elo" 83 | ) 84 | } 85 | 86 | all_charts <- function() { 87 | ggplot2::ggplot(players, ggplot2::aes(date, elo, col = name)) + 88 | ggplot2::geom_line() + 89 | ggplot2::geom_point() + 90 | ggplot2::theme_bw() + 91 | ggplot2::labs( 92 | title = paste0("Player progress: ALL PLAYERS"), 93 | x = "Date", 94 | y = "Elo" 95 | ) 96 | } 97 | 98 | all_charts_plotly <- function() { 99 | gg <- players %>% 100 | plotly::highlight_key(~name) %>% 101 | ggplot2::ggplot(ggplot2::aes(date, elo, col = name)) + 102 | ggplot2::geom_line() + 103 | ggplot2::geom_point() + 104 | ggplot2::theme_bw() + 105 | ggplot2::labs( 106 | title = paste0("Player progress: ALL PLAYERS"), 107 | x = "Date", 108 | y = "Elo" 109 | ) 110 | plotly::highlight(plotly::ggplotly(gg), on = "plotly_click") 111 | } 112 | 113 | current_elo <- function() { 114 | players %>% 115 | dplyr::group_by(name) %>% 116 | dplyr::filter(dplyr::row_number() == dplyr::n()) %>% 117 | dplyr::arrange(dplyr::desc(elo)) %>% 118 | as.data.frame() 119 | } 120 | 121 | player_games <- function(player) { 122 | games[games$p1_name == player | games$p2_name == player, ] 123 | } 124 | 125 | find_pairs <- function(player = NULL) { 126 | p <- games[, c("p1_name", "p2_name")] 127 | p$a <- ifelse(p$p1_name < p$p2_name, p$p1_name, p$p2_name) 128 | p$b <- ifelse(p$p1_name < p$p2_name, p$p2_name, p$p1_name) 129 | res <- dplyr::count(p, a, b, sort = TRUE) 130 | if (!is.null(player)) { 131 | res[res$a == player | res$b == player, ] 132 | } else { 133 | res 134 | } 135 | } 136 | 137 | have_played <- function(p1, p2) { 138 | nrow(games[ 139 | (games$p1_name == p1 & games$p2_name == p2) | 140 | (games$p1_name == p2 & games$p2_name == p1), 141 | ]) > 142 | 0 143 | } 144 | 145 | largest_upsets <- function() { 146 | wins <- dplyr::slice_max( 147 | games[games$p1_result == 0 & games$p1_prob_win > 55, ], 148 | p1_prob_win, 149 | n = 5 150 | ) 151 | losses <- dplyr::slice_min( 152 | games[games$p1_result == 1 & games$p1_prob_win < 45, ], 153 | p1_prob_win, 154 | n = 5 155 | ) 156 | rbind(wins, losses) 157 | } 158 | 159 | prob_win <- function(p1, p2) { 160 | cur <- current_elo() 161 | as.integer( 162 | 100 * elo::elo.prob(cur[cur$name == p1, "elo"], cur[cur$name == p2, "elo"]) 163 | ) 164 | } 165 | 166 | win_matrix <- function() { 167 | pwv <- Vectorize(prob_win) 168 | cur <- current_elo()$name 169 | o <- outer(cur, cur, "pwv") 170 | rownames(o) <- cur 171 | colnames(o) <- cur 172 | o 173 | } 174 | 175 | plot_win_matrix <- function() { 176 | wm <- win_matrix() 177 | wm %>% 178 | as.data.frame() %>% 179 | tibble::rownames_to_column('player') %>% 180 | tidyr::pivot_longer(cols = -player, names_to = 'vs', values_to = 'prob') %>% 181 | ggplot2::ggplot() + 182 | ggplot2::aes(player, vs, fill = prob) + 183 | ggplot2::geom_tile() + 184 | ggplot2::theme_bw() + 185 | ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) + 186 | ggplot2::scale_fill_viridis_c() + 187 | ggplot2::geom_hline(yintercept = seq(0.5, length(rownames(wm)), by = 1)) + 188 | ggplot2::geom_vline(xintercept = seq(0.5, length(rownames(wm)), by = 1)) + 189 | ggplot2::theme(aspect.ratio = 1) + 190 | ggplot2::guides(x.sec = guide_axis_label_trans(~.x)) + 191 | ggplot2::guides(y.sec = guide_axis_label_trans(~.x)) + 192 | ggplot2::theme( 193 | axis.text.x.top = ggplot2::element_text(angle = 45, hjust = 0) 194 | ) 195 | } 196 | 197 | play_matrix <- function() { 198 | pmv <- Vectorize(have_played) 199 | cur <- current_elo()$name 200 | o <- outer(cur, cur, "pmv") 201 | rownames(o) <- cur 202 | colnames(o) <- cur 203 | o 204 | } 205 | 206 | guide_axis_label_trans <- function(label_trans = identity, ...) { 207 | axis_guide <- ggplot2::guide_axis(...) 208 | axis_guide$label_trans <- rlang::as_function(label_trans) 209 | class(axis_guide) <- c("guide_axis_trans", class(axis_guide)) 210 | axis_guide 211 | } 212 | 213 | guide_train.guide_axis_trans <- function(x, ...) { 214 | trained <- NextMethod() 215 | trained$key$.label <- x$label_trans(trained$key$.label) 216 | trained 217 | } 218 | 219 | plot_play_matrix <- function() { 220 | pm <- play_matrix() 221 | diag(pm) <- "." 222 | pm %>% 223 | as.data.frame() %>% 224 | tibble::rownames_to_column('player') %>% 225 | tidyr::pivot_longer( 226 | cols = -player, 227 | names_to = 'vs', 228 | values_to = 'played' 229 | ) %>% 230 | ggplot2::ggplot() + 231 | ggplot2::aes(player, vs, fill = played) + 232 | ggplot2::geom_tile() + 233 | ggplot2::theme_bw() + 234 | ggplot2::theme( 235 | axis.text.x = ggplot2::element_text(angle = 45, hjust = 1, size = 14) 236 | ) + 237 | ggplot2::theme(axis.text.y = ggplot2::element_text(size = 14)) + 238 | ggplot2::scale_fill_manual( 239 | values = c("TRUE" = "green", "FALSE" = "steelblue", "." = "black") 240 | ) + 241 | ggplot2::geom_hline(yintercept = seq(0.5, length(rownames(pm)), by = 1)) + 242 | ggplot2::geom_vline(xintercept = seq(0.5, length(rownames(pm)), by = 1)) + 243 | ggplot2::theme(aspect.ratio = 1) + 244 | ggplot2::guides(x.sec = guide_axis_label_trans(~.x)) + 245 | ggplot2::guides(y.sec = guide_axis_label_trans(~.x)) + 246 | ggplot2::theme( 247 | axis.text.x.top = ggplot2::element_text(angle = 45, hjust = 0) 248 | ) 249 | } 250 | --------------------------------------------------------------------------------