world team championships 2015 part 3

The Elo rating gave some predictiveness for game outcomes. But given the small number of games present even in three years of WTC data means that there was not sufficient sensitivity to describe the players. Elo made a number of assumptions for ease of computation. Some of these can assumptions can be relaxed due to the power of a desktop PC. One assumption is that the variability in a player’s rating is the same for all players is the same for all players. This assumption is relaxed by the Glicko and Stephenson method, as implemented by the steph function in R.

Using three years’ data we can apply the pair lookup method for predicting the WTC outcome. Since then I further restricted how far each pair penalty could travel each updateLookup call. To recreate this analysis, create the ‘scorefrac’ column as before.

> # create scorefrac as before
> wtc <- na.omit(wtc)
> wtc$allrounds <- wtc$round + (wtc$year - 2013) * 6 
> head(wtc)
   game_id round TP year victory_condition        scenario
1       1     1  1 2013       Caster Kill Into the Breach
2       2     1  0 2013       Caster Kill Into the Breach
3       3     1  1 2013       Caster Kill Into the Breach
4       4     1  1 2013       Caster Kill Into the Breach
5       5     1  0 2013          Scenario Into the Breach
6       6     1  1 2013       Caster Kill Into the Breach
               player1            team1  list1
1   Pär-Ola Nilsson Team Epic Sweden  Vlad2
2 Robert Willemstein Team Netherlands Feora2
3      Christian Aas Team Epic Sweden  Vayl2
4      Jeppa Resmark Team Epic Sweden Haley2
5      Harm Kleijnen Team Netherlands  Vayl2
6     Alexander Grob Team Austria Red Skarre
                  faction1 CP1        AP1             player2
1                 Khador   0 0.57377049          Aat Niehot
2 Protectorate of Menoth   0 0.08196721         Joakim Rapp
3   Legion of Everblight   0 0.91803279         Tom Starren
4                 Cygnar   0 0.90163934      Casper Jellema
5   Legion of Everblight   1 0.26229508 Christoffer Wedding
6                   Cryx   4 0.98360656          David Kane
               team2    list2       faction2 CP2        AP2
1 Team Netherlands    Borka     Trollblood   2 0.03278689
2 Team Epic Sweden  Bartolo    Mercenaries   4 0.06557377
3 Team Netherlands Butcher2         Khador   1 0.01639344
4 Team Netherlands Krueger2 Circle Orboros   0 0.00000000
5 Team Epic Sweden Krueger2 Circle Orboros   5 0.08196721
6    Team Scotland    Vlad2         Khador   1 0.01639344
   scorefracCP scorefracAP scorefrac allrounds
1   0.3000000   0.9459459 0.6229730         1
2   0.1000000   0.5555556 0.3277778         1
3   0.4000000   0.9824561 0.6912281         1
4   0.5000000   0.9508197 0.7254098         1
5   0.1666667   0.7619048 0.4642857         1
6   0.8000000   0.9836066 0.8918033         1

From this dataset we can perform the analysis for each year. To compare this method with the Elo rating, we can perform three cycles of analysis.

> pairLookup <- initializeLookup(
+   data = unique(c(wtc$list1, wtc$list2)))
> wtc2013 <- wtc[wtc$year == 2013, ]
> # sequentially optimize restricted 
> pairLookup13 <- updateLookup(data = wtc2013, 
+     pairlookup = pairLookup, 
+     penalty = 10, result = "TP")
> # ratings based on pairings with selected caster pairings
> rating2013 <- steph(
+   x = wtc2013[, c("round", "player1", "player2", "TP")], 
+       gamma = getMatrixVal(
+            list1 = wtc2013[, "list1"], 
+            list2 = wtc2013[, "list2"], 
+            x = pairLookup))
> rating2013$ratings[1:8, 
+     c("Player", "Rating", "Deviation", "Games", "Win", "Loss")]
                  Player   Rating Deviation Games Win Loss
1  Andrzej Kasiewicz 2647.358  165.8147     5   5    0
2         Will Pagani 2610.678  172.8383     5   5    0
3      Moritz Riegler 2586.560  175.4116     5   5    0
4 Keith Christianson 2585.981  170.8883     5   5    0
5       Johan Persson 2570.921  174.0227     5   5    0
6             Enno May 2512.887  168.4785     5   4    1
7         Tomek Tutaj 2510.662  163.5944     5   4    1
8       Lewis Johnson 2509.211  187.4594     5   5    0

Each round the pair lookup table is created, then the player ratings are created. The lookup table and ratings are then initialization inputs for the following year.

> wtc2014 <- wtc[wtc$year == 2014, ]
> pairLookup14 <- updateLookup(data = wtc2014, 
+      pairlookup = pairLookup13, 
+      penalty = 10,
+      result = "TP")
> rating2014 <- steph(
+   x = wtc2014[, c("allrounds", "player1", "player2", "TP")], 
+      status = rating2013$ratings,
+      gamma = getMatrixVal(
+            list1 = wtc2014[, "list1"], 
+           list2 = wtc2014[, "list2"], 
+           x = pairLookup14))
> rating2014$ratings[1:8, 
+      c("Player", "Rating", "Deviation", "Games", "Win", "Loss")]
            Player   Rating Deviation Games Win Loss
1           Brian White 2663.619  126.0339    11  10    1
2           Will Pagani 2656.168  132.2770    11  10    1
3  Andrzej Kasiewicz 2648.529  132.5830    11  10    1
4            Colin Hill 2624.061  161.8688     6   6    0
5            Ben Leeper 2613.997  152.6823     6   6    0
6 Keith Christianson 2585.981  170.8883     5   5    0
7       Johan Persson 2570.921  174.0227     5   5    0
8      Jake Van Meter 2564.071  125.5282    11   9    2

This approach means that at the start of 2015, many players already have a rating, and matchups already have a home advantage.

> wtc2015 <- wtc[wtc$year == 2015, ]
> pairLookup15 <- updateLookup(data = wtc2015, 
+       pairlookup = pairLookup14, 
+      penalty = 10,
+      result = "TP")
> rating2015 <- steph(
+   x = wtc2015[, c("allrounds", "player1", "player2", "TP")], 
+     status = rating2014$ratings,
+      gamma = getMatrixVal(
+            list1 = wtc2015[, "list1"], 
+            list2 = wtc2015[, "list2"], 
+            x = pairLookup15))
> rating2015$ratings[1:8, 
+     c("Player", "Rating", "Deviation", "Games", "Win", "Loss")]
                   Player   Rating Deviation Games Win Loss
1             Brian White 2639.599  112.2389    17  15    2
2              Jay Larsen 2638.713  151.8721     6   6    0
3            Sheldon Pace 2635.978  149.9138     6   6    0
4              Colin Hill 2624.061  161.8688     6   6    0
5 William Cruickshanks 2599.129  125.5863    12  11    1
6              Aaron Wale 2598.380  156.4778     6   5    1
7       Jaakko Uusitupa 2597.534  108.0831    17  15    2
8             Peter Bates 2596.015  181.0864     6   6    0

This new rating penalizes Jaakko for playing all of his games with a high advantage caster,
Haley2 dropping him down to seventh place. If Jaakko and Brian play a game, this method predicts that Jaakko has a 42% chance of winning if Brian plays Harbinger and 46% chance of winning if he plays High Reclaimer. If Jaakko plays the player rated lowest by the Elo method, he is estimated as having a 98% chance of winning.

> unique(c(wtc2015$list1[wtc2015$player1 == "Jaakko Uusitupa"],
+      wtc2015$list2[wtc2015$player2 == "Jaakko Uusitupa"]))
[1] "Haley2"
> unique(c(wtc2015$list1[wtc2015$player1 == "Brian White"],
+      wtc2015$list2[wtc2015$player2 == "Brian White"]))
[1] "Harbinger"      "High Reclaimer"
> # Harbinger as list2 is slightly favoured into Haley2
> gm <- getMatrixVal(x = pairLookup15, 
+      list1 = "Haley2", 
+      list2 = c("Harbinger", "High Reclaimer"))
> gm
[1] -21.38652  18.10739
> predict(object = rating2015, 
+      newdata = data.frame(c(19, 19), 
+     "Jaakko Uusitupa", "Brian White"), 
+      gamma = gm)
# [1] 0.4188713 0.4691343

I performed the method calibration as for the Elo rating, by not including the final round from 2015 in the pair lookup calculation, or for creating the player ratings. This is a much better prediction of the final round results. Each point is the average of 12 or 13 results. The points are not completely on the line partly because these are the average of a small number of results. This is a good result and suggests that this method is worth pursuing further.

> ggplot() + 
+       geom_point(data = data.frame(
+             Predicted_Quantile = pQuantiles, 
+             Result_Quantile = rQuantiles),
+       aes(x = Result_Quantile, y = Predicted_Quantile)) + 
+       geom_abline() +
+       theme_economist()

wtc_quantiles_Steph_2015
For comparison with the Elo rating here are the top 16 players from 2015. This method has allowed players with fewer ratings to place higher up the results table.

> players2015 <- unique(
+      unlist(
+            wtc2015[, c("player1", "player2")]))
> head(rating2015$ratings[
+      rating2015$ratings$Player %in% players2015, 
+      c("Player", "Rating", "Deviation", "Games", "Win", "Loss")], n = 16)
Player Rating Deviation Games Win Loss
Brian White 2639.599 112.2389 17 15 2
Jay Larsen 2638.713 151.8721 6 6 0
Sheldon Pace 2635.978 149.9138 6 6 0
William Cruickshanks 2599.129 125.5863 12 11 1
Aaron Wale 2598.38 156.4778 6 5 1
Jaakko Uusitupa 2597.534 108.0831 17 15 2
Peter Bates 2596.015 181.0864 6 6 0
Sascha Maisel 2580.45 155.1466 6 6 0
Bubba Dalton 2554.847 172.07 6 6 0
Konrad Sosnowski 2552.253 130.6567 12 11 1
Ben Leeper 2536.705 123.9089 12 10 2
Alessandro Montagnani 2528.729 126.5368 12 11 1
Adam Bell 2517.283 156.1071 6 5 1
Tomek Tutaj 2515.555 112.9234 17 14 3
Patrick Dunford 2513.166 125.5094 12 10 2
David Potts 2512.103 124.0504 12 10 2
Advertisements

2 thoughts on “world team championships 2015 part 3

  1. Pingback: Balancing Casters | analytical gaming

  2. Pingback: Battle Reporter and the WITC 2016 | analytical gaming

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s