Created
October 22, 2016 00:20
-
-
Save CSJCampbell/7d5bf75fb2d31b0e75223e0690eaf4d7 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ########################################################### | |
| # | |
| # Battle Reporter and the WITC 2016 | |
| # csjcampbell | |
| # 2016-10-22 | |
| # | |
| # Copyright 2016 CSJCampbell | |
| # This document may be reproduced in whole or part provided | |
| # that this notice is retained. | |
| # | |
| ########################################################### | |
| setwd("C:/Users/ccampbell/Documents/Misc/R") | |
| load(file = "pairLookup16-br.RData") | |
| sum(attr(pairLookup16, "n") != 0) | |
| # [1] 2142 | |
| library(dplyr) | |
| witc16 <- read.csv(file = "witc16-skinny.csv", | |
| stringsAsFactors = FALSE) | |
| witc161 <- cbind( | |
| select(rename(filter(witc16, role == 1), player1 = player, | |
| team1 = team, list1 = list), -role), | |
| select(rename(filter(witc16, role == 2), player2 = player, | |
| team2 = team, list2 = list), player2:list2)) | |
| head(witc161) | |
| load("rating2015-reg.RData") | |
| rating2016us <- rating2015 | |
| rating2016us$ratings <- select(filter(rating2016us$ratings, | |
| country == "USA"), -country) | |
| length(unique(witc16$player[witc16$player %in% | |
| rating2016us$ratings$Player])) | |
| # [1] 8 | |
| length(unique(witc16$player)) | |
| library(PlayerRatings) | |
| library(WTCTools) | |
| # pl <- matrix(data = c(0, 30, -30, 0), nrow = 2, | |
| # dimnames = list(c("a", "b"), c("a", "b"))) | |
| # dat <- data.frame(round = rep(1:6, each = 2), | |
| # player1 = rep(c("A", "B"), times = 2), | |
| # player2 = rep(c("B", "A"), times = 2), | |
| # result = c(0, 1, 1, 1, 0, 1, 0, 0, 0, 1, 1, 0), | |
| # list1 = c("a", "b", "b", "a"), | |
| # list2 = c("b", "a", "a", "b"), stringsAsFactors = FALSE) | |
| # calibration(data = dat, pairlookup = pl) | |
| getCalibStat <- function(data, status = NULL, | |
| pairlookup, expand = 1, binsize = 10, round = "round", | |
| player1 = "player1", player2 = "player2", | |
| result = "result", list1 = "list1", list2 = "list2") { | |
| if (missing(data)) { stop("data is missing") } | |
| if (missing(pairlookup)) { stop("pairlookup is missing") } | |
| if (!is.matrix(pairlookup) || !(nrow(pairlookup) == ncol(pairlookup))) { | |
| stop("pairlookup must be a square matrix") | |
| } | |
| if (!all(rownames(pairlookup) %in% colnames(pairlookup))) { | |
| stop("rownames of pairlookup must be colnames of pairlookup") | |
| } | |
| res <- calibration(data, status = status, | |
| pairlookup = pairlookup * expand, | |
| binsize = binsize, round = round, | |
| player1 = player1, player2 = player2, | |
| result = result, list1 = list1, list2 = list2) | |
| # measure calibration | |
| calibLm <- summary(lm(ProportionWins ~ PredictedWins - 1, data = res)) | |
| # reduce variance and maximise "straightness" | |
| stat <- calibLm$r.squared - abs(1 - calibLm$coefficients["PredictedWins", "Estimate"]) | |
| stat | |
| } | |
| # add new players to ratings | |
| rating2016us$ratings <- rbind(rating2016us$ratings, | |
| cbind(transmute(filter(witc16, !player %in% rating2016us$ratings$Player & | |
| !duplicated(player)), | |
| Player = player), Rating = 1400, Deviation = 200, | |
| Games = 0, Win = 0, Draw = 0, Loss = 0, Lag = 0, | |
| stringsAsFactors = FALSE)) | |
| sum(witc161$list1 == "") | |
| # scale pairLookup16 for maximum calibration | |
| getCalibStat(data = witc161, status = NULL, | |
| pairlookup = pairLookup16, expand = 1, result = "TP") | |
| getNewCalib <- function(val, data, status, | |
| pairlookup, binsize = 10) { | |
| getCalibStat(data = data, pairlookup = pairlookup, status = status, | |
| expand = val, binsize = binsize, result = "TP") | |
| } | |
| rating2016us <- steph(x = witc161[witc161$round %in% 1:2, | |
| c("round", "player1", "player2", "TP")], | |
| status = rating2016us$ratings, | |
| gamma = getMatrixVal( | |
| list1 = witc161[, "list1"], | |
| list2 = witc161[, "list2"], | |
| x = pairLookup16)) | |
| vmin <- optimize(getNewCalib, | |
| interval = c(-10, 20), | |
| data = witc161[witc161$round %in% 3:4, ], | |
| status = rating2016us$ratings, | |
| pairlookup = pairLookup16, | |
| maximum = TRUE, tol = 0.01) | |
| #names(vmin) | |
| vmin | |
| # $maximum | |
| # [1] 9.28773 | |
| # | |
| # $objective | |
| # [1] 0.9141535 | |
| rating2016us <- steph(x = witc161[witc161$round %in% 3:4, | |
| c("round", "player1", "player2", "TP")], | |
| status = rating2016us$ratings, | |
| gamma = getMatrixVal( | |
| list1 = witc161[, "list1"], | |
| list2 = witc161[, "list2"], | |
| x = pairLookup16 * vmin$maximum)) | |
| predict(object = rating2016us, | |
| newdata = data.frame(round = rep(4, times = 7), | |
| player1 = "Brent Simon", player2 = "Dan Yount"), | |
| tng = -1, gamma = c(-55.7, -50, -20, -10, 10, 20, 50)) | |
| rating2016us$ratings[rating2016us$ratings$Player %in% witc16$player, ] | |
| pairLookup16 <- pairLookup16 * vmin$maximum | |
| plot(calibration(data = witc161, | |
| pairlookup = pairLookup16 * vmin$maximum, | |
| status = rating2016us$ratings, result = "TP") | |
| ) | |
| abline(coef = c(0, 1)) | |
| range(attr(pairLookup16, "n")) | |
| lis1 <- c("Helynna1", "Kozlov1", "Madrak2", | |
| "Ragnar1", "Tanith1", "Vladimir1") | |
| col1 <- c("#40A59D", "red", "#EFA133", | |
| "#EFA133", "#7D7D36", "red") | |
| pos1 <- c(8.5, 9, 10, 9, 8.5, 10) | |
| # create plots | |
| for (i in seq_along(lis1)) { | |
| allbarplots(list("(Battle Reporter)" = pairLookup16), | |
| lists = lis1[i], | |
| nmin = 3, | |
| col = col1[i], | |
| fileroot = "battle_reporter", | |
| height = 600, | |
| mar = c(2, pos1[i], 2, 1), cex.main = 1) | |
| } | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment