diff --git a/tools/stats/R/calcStats.R b/tools/stats/R/calcStats.R index 14ce9061c..4d5dbfbdd 100644 --- a/tools/stats/R/calcStats.R +++ b/tools/stats/R/calcStats.R @@ -7,22 +7,9 @@ box::use( data.table, Matrix, jsonlite, - dplyr, - condformat + htmltools ) -# These were imported as libraries in the initial code, but don't -# appear to me to be needed: -# * colorRamps - -# The %>% operator is imported from dplyr, and needs to be invoked -# under that exact name with no namespace, for reasons described -# in the first comment by "greg" in -# https://forum.posit.co/t/magrittr-inside-a-package/2033 -# (That thread is about magrittr, but dplyr implements the same -# operator, and clearly has the same issue.) -`%>%` <- dplyr$`%>%` - save_dir <- function() { # Choose target file save directory if (('unix' == .Platform$OS.type) && ('X11' == .Platform$GUI)) { @@ -33,7 +20,7 @@ save_dir <- function() { dir_path <- './' } - return(dir_path); + return(dir_path) } connectToDatabase <- function() { @@ -48,7 +35,7 @@ connectToDatabase <- function() { unix.sock = "/Applications/MAMP/tmp/mysql/mysql.sock" ) } else { - # Otherwise connect via TCP/IP + # Otherwise connect via Unix socket db <- RMySQL$dbConnect( RMySQL$MySQL(), user = 'root', @@ -102,7 +89,7 @@ queryPlayerNames <- function(db) { } queryButtonStats <- function(db) { - # Submit query for button vs button data, ignoring mirror matches + # Submit query for button vs button data; mirror matches are flagged but not filtered here suppressWarnings( data.df <- DBI$dbGetQuery( db, @@ -194,16 +181,12 @@ calcButtonMatchupsPlayed <- function(data.df, button.names.df) { ngame <- nrow(data.df) / 2 max.button <- max(button.names.df$alt_button_id) - # Create data frame with button involved in each game - games.played.df <- data.frame( - first_button_id = data.df$alt_button_id[2*(1:ngame) - 1], - second_button_id = data.df$alt_button_id[2*(1:ngame)] - ) - # Create matchup frequency matrix of games played - dt <- data.table$data.table(games.played.df, key = c('first_button_id', 'second_button_id')) - freq.dt <- dt[, .N, by = eval(data.table$key(dt))] - freq.matrix <- as.matrix(with(freq.dt, Matrix$sparseMatrix(i = first_button_id, j = second_button_id, x = N, dims = c(max.button, max.button)))) + freq.matrix <- buildFrequencyMatrix( + data.df$alt_button_id[2*(1:ngame) - 1], + data.df$alt_button_id[2*(1:ngame)], + max.button + ) freq.matrix.df <- as.data.frame(freq.matrix, row.names = button.names.df$button_name) colnames(freq.matrix.df) <- button.names.df$button_name @@ -219,10 +202,7 @@ calcButtonMatchupsPlayed <- function(data.df, button.names.df) { freq.matrix[0 == freq.matrix] <- NA # Take log of frequency matrix and increase dynamic range - log.freq.matrix <- log2(freq.matrix) - log.freq.matrix.limited <- log.freq.matrix - upper.limit <- 5 - log.freq.matrix.limited[log.freq.matrix.limited > upper.limit] <- upper.limit + log.freq.matrix.limited <- pmin(log2(freq.matrix), 5) # Create colour palette color.palette <- colorRampPalette(c('grey', 'red')) @@ -256,37 +236,75 @@ calcButtonMatchupsPlayed <- function(data.df, button.names.df) { dev.off() } -calcButtonMatchupWinStats <- function(data.df, button.names.df, is.colour = FALSE) { - # Create matchup matrix with win/loss info - game.winner.df <- data.frame( - winner_button_id = data.df$alt_button_id[data.df$did_win], - winner_button_name = data.df$button_name[data.df$did_win], - loser_button_id = data.df$alt_button_id[!data.df$did_win], - loser_button_name = data.df$button_name[!data.df$did_win] +buildFrequencyMatrix <- function(row_ids, col_ids, n) { + dt <- data.table$data.table(row_id = row_ids, col_id = col_ids, + key = c('row_id', 'col_id')) + freq.dt <- dt[, .N, by = eval(data.table$key(dt))] + as.matrix(Matrix$sparseMatrix( + i = freq.dt$row_id, + j = freq.dt$col_id, + x = freq.dt$N, + dims = c(n, n) + )) +} + +buildColouredHtmlTable <- function(df, caption) { + # Compute cell background colours from 'Win %' and '# games played' columns + output.colour <- pmin(4, floor(df$'Win %' / 20)) + # use a special colour for fewer than 5 matchups + output.colour[df$'# games played' < 5] <- 5 + + colour.map <- c('0' = '#ff8888', '1' = '#ffcccc', '2' = '#ffffcc', + '3' = '#ccffcc', '4' = '#88ff88', '5' = '#8888ff') + bg <- colour.map[as.character(output.colour)] + + col.names <- names(df) + header <- paste0( + '', + paste0('', col.names, '', collapse = ''), + '' ) + rows <- paste0( + '', + '', htmltools$htmlEscape(as.character(df[[1]])), '', + '', htmltools$htmlEscape(as.character(df[[2]])), '', + '', df[[3]], '', + '', df[[4]], '', + '' + ) + + paste0( + '', + header, + '', paste(rows, collapse = ''), '', + '
', htmltools$htmlEscape(caption), '
' + ) +} + +calcButtonMatchupWinStats <- function(data.df, button.names.df) { # Populate a button matchup frequency matrix - dt <- data.table$data.table(game.winner.df, key = c('winner_button_id', 'loser_button_id')) - freq.dt <- dt[, .N, by = eval(data.table$key(dt))] - max_button_id <- max(button.names.df$alt_button_id) - freq.matrix <- as.matrix(with(freq.dt, Matrix$sparseMatrix(i = winner_button_id, j = loser_button_id, x = N, dims = c(max_button_id, max_button_id)))) + freq.matrix <- buildFrequencyMatrix( + data.df$alt_button_id[data.df$did_win], + data.df$alt_button_id[!data.df$did_win], + max(button.names.df$alt_button_id) + ) # Calculate the total number of games played for each matchup n.games.matrix <- freq.matrix + t(freq.matrix) - n.games.matrix[row(n.games.matrix) == col(n.games.matrix)] <- n.games.matrix[row(n.games.matrix) == col(n.games.matrix)] / 2 + diag(n.games.matrix) <- diag(n.games.matrix) / 2 # Create a data frame with unplayed matchups - n.games.df <- data.frame( - button1 = rep(button.names.df$button_name, each = nrow(button.names.df)), - button2 = button.names.df$button_name, - n.games = as.vector(n.games.matrix) + zero.idx <- which(n.games.matrix == 0, arr.ind = TRUE) + unplayed.df <- data.frame( + button1 = button.names.df$button_name[zero.idx[, 1]], + button2 = button.names.df$button_name[zero.idx[, 2]] ) - unplayed.df <- n.games.df[0 == n.games.df$n.games, 1:2] write.csv(unplayed.df, file = 'unplayed_button_matchups.csv', row.names = FALSE) # Calculate the win percentage for each matchup win.percentage.matrix <- round(100 * freq.matrix / n.games.matrix, 2) - win.percentage.matrix[row(win.percentage.matrix) == col(win.percentage.matrix)] <- NA + diag(win.percentage.matrix) <- NA # Flatten the matrix out into a data frame with one matchup per row win.percentage.df <- data.frame( @@ -297,19 +315,18 @@ calcButtonMatchupWinStats <- function(data.df, button.names.df, is.colour = FALS ) # Save data as CSV and JSON object - win.percentage.df.short <- win.percentage.df - colnames(win.percentage.df.short) <- c('b1', 'b2', 'wp', 'ng') - write.table( - win.percentage.df.short, - file = 'win_percentage_stats.csv', - col.names = c('button_1', 'button_2', 'win_percentage', 'number_of_games'), + setNames(win.percentage.df, c('b1', 'b2', 'wp', 'ng')), + file = 'win_percentage_stats.csv', + col.names = c('button_1', 'button_2', 'win_percentage', 'number_of_games'), row.names = FALSE, sep = ',' ) - - df.json <- jsonlite$toJSON(win.percentage.df.short, pretty = TRUE, digits = 2) - writeLines(df.json, paste0(save_dir(), 'win_percentage_stats.json')) + + writeLines( + jsonlite$toJSON(setNames(win.percentage.df, c('b1', 'b2', 'wp', 'ng')), pretty = TRUE, digits = 2), + paste0(save_dir(), 'win_percentage_stats.json') + ) # Remove empty rows win.percentage.df <- win.percentage.df[!is.na(win.percentage.df$win.percentage),] @@ -317,57 +334,28 @@ calcButtonMatchupWinStats <- function(data.df, button.names.df, is.colour = FALS # Create HTML table of button matchup stats - if (is.colour) { - output.colour <- pmin(4, floor(win.percentage.df$'Win %'/20)) - # use a special colour for fewer than 5 matchups - output.colour[win.percentage.df$'# games played' < 5] <- 5 - - out.table <- condformat$condformat(win.percentage.df) %>% - condformat$rule_fill_discrete(contains('Win %'), - expression = output.colour, - colours = c('0' = '#ff8888', '1' = '#ffcccc', '2' = '#ffffcc', '3' = '#ccffcc', '4' = '#88ff88', '5' = '#8888ff')) %>% - condformat$theme_caption(paste0('Button stats generated on ', - as.character(as.Date(max(data.df$last_action_time))), - ', only contains played matchups')) - out.html <- condformat$condformat2html(out.table) - return(out.html) - } else { - stats.table <- xtable$xtable( - win.percentage.df, - display = c('s', 's', 's', 'f', 'd'), - caption = paste0( - 'Button stats generated on ', - as.character(as.Date(max(data.df$last_action_time))), - ', only contains played matchups' - ) - ) - } + caption <- paste0('Button stats generated on ', + as.character(as.Date(max(data.df$last_action_time))), + ', only contains played matchups') - return(stats.table) + return(buildColouredHtmlTable(win.percentage.df, caption)) } -calcPlayerMatchupWinStats <- function(data.df, player.names.df, is.colour = FALSE) { - # Create matchup matrix with win/loss info - game.winner.df <- data.frame( - winner_player_id = data.df$player_id[data.df$did_win], - winner_player_name = data.df$player_name[data.df$did_win], - loser_player_id = data.df$player_id[!data.df$did_win], - loser_player_name = data.df$player_name[!data.df$did_win] - ) - +calcPlayerMatchupWinStats <- function(data.df, player.names.df) { # Populate a player matchup frequency matrix - dt <- data.table$data.table(game.winner.df, key = c('winner_player_id', 'loser_player_id')) - freq.dt <- dt[, .N, by = eval(data.table$key(dt))] - max_player_id <- max(player.names.df$player_id) - freq.matrix <- as.matrix(with(freq.dt, Matrix$sparseMatrix(i = winner_player_id, j = loser_player_id, x = N, dims = c(max_player_id, max_player_id)))) + freq.matrix <- buildFrequencyMatrix( + data.df$player_id[data.df$did_win], + data.df$player_id[!data.df$did_win], + max(player.names.df$player_id) + ) # Calculate the total number of games played for each matchup n.games.matrix <- freq.matrix + t(freq.matrix) - n.games.matrix[row(n.games.matrix) == col(n.games.matrix)] <- n.games.matrix[row(n.games.matrix) == col(n.games.matrix)] / 2 + diag(n.games.matrix) <- diag(n.games.matrix) / 2 # Calculate the win percentage for each matchup win.percentage.matrix <- 100 * freq.matrix / n.games.matrix - win.percentage.matrix[row(win.percentage.matrix) == col(win.percentage.matrix)] <- NA + diag(win.percentage.matrix) <- NA # Flatten the matrix out into a data frame with one matchup per row win.percentage.df <- data.frame( @@ -392,59 +380,37 @@ calcPlayerMatchupWinStats <- function(data.df, player.names.df, is.colour = FALS win.percentage.sorted.df$win.percentage <- round(win.percentage.sorted.df$win.percentage, 2) names(win.percentage.sorted.df) <- c('Player Name', 'Opponent Name', 'Win %', '# games played') - # Create HTML table of button matchup stats - if (is.colour) { - output.colour <- pmin(4, floor(win.percentage.sorted.df$'Win %'/20)) - # use a special colour for fewer than 5 matchups - output.colour[win.percentage.sorted.df$'# games played' < 5] <- 5 - - out.table <- condformat$condformat(win.percentage.sorted.df) %>% - condformat$rule_fill_discrete(contains('Win %'), - expression = output.colour, - colours = c('0' = '#ff8888', '1' = '#ffcccc', '2' = '#ffffcc', '3' = '#ccffcc', '4' = '#88ff88', '5' = '#8888ff')) %>% - condformat$theme_caption(paste0('Player stats generated on ', - as.character(as.Date(max(data.df$last_action_time))), - ', only contains played matchups')) - out.html <- condformat$condformat2html(out.table) - return(out.html) - } else { - stats.table <- xtable$xtable( - win.percentage.sorted.df, - display = c('s', 's', 's', 'f', 'd'), - caption = paste0( - 'Player stats generated on ', - as.character(as.Date(max(data.df$last_action_time))), - ', only contains played matchups' - ) - ) + # Create HTML table of player matchup stats + caption <- paste0('Player stats generated on ', + as.character(as.Date(max(data.df$last_action_time))), + ', only contains played matchups') - return(stats.table) - } + return(buildColouredHtmlTable(win.percentage.sorted.df, caption)) } generateHtmlFile <- function(html.table, fname) { # Save HTML table to file - print( - html.table, - type = 'html', - include.rownames = FALSE, - file = paste0(save_dir(), fname) - ) + path <- paste0(save_dir(), fname) + if (is.character(html.table)) { + writeLines(html.table, path) + } else { + print(html.table, type = 'html', include.rownames = FALSE, file = path) + } } runAll <- function() { db <- connectToDatabase() + on.exit(RMySQL$dbDisconnect(db)) button.names.df <- queryButtonNames(db) player.names.df <- queryPlayerNames(db) data.df <- queryButtonStats(db) - RMySQL$dbDisconnect(db) data.df$alt_button_id <- button.names.df$alt_button_id[match(data.df$button_id, button.names.df$button_id)] generateHtmlFile(calcSingleButtonStats(data.df), 'button_stats.html') calcButtonMatchupsPlayed(data.df, button.names.df) - generateHtmlFile(calcPlayerMatchupWinStats(data.df, player.names.df, TRUE), 'player_matchup_stats.html') - generateHtmlFile(calcButtonMatchupWinStats(data.df, button.names.df, FALSE), 'button_matchup_stats.html') + generateHtmlFile(calcPlayerMatchupWinStats(data.df, player.names.df), 'player_matchup_stats.html') + generateHtmlFile(calcButtonMatchupWinStats(data.df, button.names.df), 'button_matchup_stats.html') } runAll()