In gobbios/EloSteepness.data: Data Sets for Package EloSteepness

This document contains the code to reproduce the plots in the manuscript that do not directly present results, i.e. figures 1, 2, 3, and 8. The code to reproduce figures 4 through 7 that present actual results of the key empirical analyses are in separate documents alongside the code to reproduce those results ("method_evaluation" and "phylogenetic_examples").

Note that two R packages are required: EloSteepness (https://cran.r-project.org/package=EloSteepness) and EloSteepness.data (https://github.com/gobbios/EloSteepness.data).

knitr::opts_chunk$set(echo = TRUE)
library(EloSteepness)
library(EloSteepness.data)

library(EloSteepness)
library(EloSteepness.data)

\newpage

figure 1

# generate example ratings
r <- c(770, 875, 1100, 1400)
rats <- round((r - mean(r)) / 200, 2)
names(rats) <- LETTERS[4:1]

layout(matrix(c(1, 1, 2, 3, 4, 4), ncol = 2, byrow = TRUE), heights = c(1, 5, 1))

# ratings
par(mar = c(0, 4.5, 0, 4.5), family = "serif", cex = 1.2)
plot (0, 0, "n", xlim = c(0, 5), ylim = c(0.5, 2.5), axes = FALSE, ann = FALSE)
rect(-2, 0.5, 7, 2.5, border = NA, col = grey(0.9), xpd = TRUE)
text(1:4, rep(1, 4), rats)
text(1:4, rep(2, 4), LETTERS[4:1], font = 2)
text(-0.4, 1.5, label = "Elo-rating", adj = 0.5, xpd = TRUE)

# winning probabilities matrix
par(family = "serif", mar = c(3, 4, 3, 2), cex = 1)
mat <- round(outer(rev(rats), rev(rats), function(x, y)plogis(y - x)), 2)
# mat <- mat[4:1, 4:1]
mat <- t(mat)
colnames(mat) <- rownames(mat) <- LETTERS[1:4]

twocols <- hcl.colors(4, "zissou1")[3:4]

n <- ncol(mat)
colmat <- mat
colmat[, ] <- "black"
colmat[3, ] <- twocols[1]
colmat[1, ] <- twocols[2]
diag(colmat) <- NA
diag(mat) <- ""
plot(0, 0, "n", xlim = c(0.5, n + 0.5), ylim = c(n + 0.5, 0.5), ann = FALSE, axes = FALSE)
xmat <- sapply(seq_len(n), function(x) rep(x, n))
ymat <- t(xmat)
text(xmat, ymat, mat, col = colmat)
cn <- colnames(mat)
text(rep(0.1, n), seq_len(n), cn, xpd = TRUE, font = 2, col = colmat[, 2])
text(seq_len(n), rep(0.4, n), cn, xpd = TRUE, font = 2)
title(ylab = "winning probability", xpd = TRUE, line = 1.4)

# winning probabilities, sigmoid
par(family = "serif", mar = c(4, 3, 1, 1), mgp = c(1.5, 0.5, 0), tcl = -0.2)

xseq <- seq(-6, 6, by = 0.2)
plot(xseq, plogis(xseq), type = "n", ylim = c(0, 1), xlim = c(-6, 6), xaxs = "i", 
     yaxs = "i", las = 1, xlab = "rating difference", ylab = "winning probability")
points(xseq, plogis(xseq), type = "l", xpd = TRUE, col = "black", lwd = 3, lend = 3)

id <- 2
xvals <- rats[id] - rats[-id]
yvals <- plogis(xvals)
arrows(xvals, rep(0, 3), xvals, yvals, code = 2, length = 0.1, xpd = TRUE, col = twocols[1])
arrows(xvals, yvals, rep(-6, 3), yvals, code = 2, length = 0.1, xpd = TRUE, col =  twocols[1])

id <- 4
xvals <- rats[id] - rats[-id]
yvals <- plogis(xvals)
arrows(xvals, rep(0, 3), xvals, yvals, code = 2, length = 0.1, 
       xpd = TRUE, col = twocols[2], lty = 3, lwd = 1.5)
arrows(xvals, yvals, rep(-6, 3), yvals, code = 2, length = 0.1, 
       xpd = TRUE, col = twocols[2], lty = 3, lwd = 1.5)

# summed/cumulative winning probs
par(mar = c(0, 4.5, 0, 4.5), cex = 1.2)
plot (0, 0, "n", xlim = c(0, 5), ylim = c(0.5, 2.5), axes = FALSE, ann = FALSE)
rect(-2, 0.5, 7, 2.5, border = NA, col = grey(0.9), xpd = TRUE)
text(1:4, rep(1, 4), rev(colSums(round(outer(rev(rats), rev(rats), 
                                             function(x, y)plogis(y - x)), 2)) - 0.5))
text(1:4, rep(2, 4), LETTERS[4:1], font = 2)

text(-0.4, 1.5, label = "summed winning\nprobability", adj = 0.5, xpd = TRUE)

\newpage

figure 2

set.seed(123)
cols <- sample(hcl.colors(6, "zissou1", alpha = 0.7))

data("toy_example", package = "EloSteepness.data")

matlist <- list(toy_example$m1, toy_example$m2)
reslist <- list(toy_example$e1, toy_example$e2)

par(mfrow = c(2, 3), family = "serif")

par(mar = c(3, 3, 4, 1))
EloSteepness:::plot_matrix(matlist[[1]], greyout = 0)
mtext("winner", 2, line = 1.5, cex = 0.8)
mtext("loser", 3, line = 1.5, cex = 0.8)
par(mar = c(4, 3, 1, 1))
EloSteepness::plot_scores(reslist[[1]], color = cols, adjustpar = 4)
text(4.5, 2, "a", cex = 0.8)
text(3.72, 1.7, "b", cex = 0.8)
text(2.8, 1.1, "c", cex = 0.8)
text(2.05, 0.9, "e", cex = 0.8)
text(1.2, 0.73, "d", cex = 0.8)
text(0.4, 1.4, "f", cex = 0.8)

EloSteepness::plot_steepness(reslist[[1]])

par(mar = c(3, 3, 4, 1))
EloSteepness:::plot_matrix(matlist[[2]], greyout = 0)
mtext("winner", 2, line = 1.5, cex = 0.8)
mtext("loser", 3, line = 1.5, cex = 0.8)
par(mar = c(4, 3, 1, 1))
EloSteepness::plot_scores(reslist[[2]], color = cols, adjustpar = 4)
text(4.7, 5.2, "a", cex = 0.8)
text(3.98, 1.8, "b", cex = 0.8)
text(2.9, 1.7, "c", cex = 0.8)
text(1.95, 0.95, "e", cex = 0.8)
text(1.1, 0.85, "d", cex = 0.8)
text(0.5, 3, "f", cex = 0.8)

EloSteepness::plot_steepness(reslist[[2]])

\newpage

figure 3

set.seed(123)
cols <- sample(hcl.colors(6, "zissou1", alpha = 0.7))

par(mfrow = c(2, 2), family = "serif", mgp = c(1.5, 0.5, 0), tcl = -0.2)
data("toy_example", package = "EloSteepness.data")

EloSteepness::plot_steepness_regression(x = toy_example$e1, color = cols)
text(1.4, 4.8, "a", cex = 0.8)
text(2.3, 3.9, "b", cex = 0.8)
text(3.2, 3.3, "c", cex = 0.8)
text(4.3, 2.4, "e", cex = 0.8)
text(4.7, 2.6, "d", cex = 0.8)
text(6.1, 1.0, "f", cex = 0.8)

d <- EloRating::DS(toy_example$m1, prop = "Pij")
plot(0, 0, type = "n", xlim = c(1, 6), ylim = c(0, 5), las = 1, axes = FALSE,
     xlab = "ordinal rank", ylab = "normalized David's score", yaxs = "i")
axis(1, at = 1:6)
axis(2, at = 0:5, las = 1)
box(bty = "l")

r <- lm(d$normDS ~ I(rank(d$normDS * (-1))))
abline(r)
points(rank(d$normDS * (-1)), d$normDS + c(0, 0, 0, 0.1, -0.1, 0), 
       pch = 21, bg = "white", col = adjustcolor(cols, alpha.f = 1), lwd = 3, cex = 1.5, xpd = TRUE)
text(1, 4.5, "a", cex = 0.8)
text(2, 3.5, "b", cex = 0.8)
text(3, 2.5, "c", cex = 0.8)
text(4.4, 1, "e", cex = 0.8)
text(4.6, 2, "d", cex = 0.8)
text(6, 0.5, "f", cex = 0.8)



EloSteepness::plot_steepness_regression(x = toy_example$e2, color = cols)
text(1.4, 4.65, "a", cex = 0.8)
text(2.3, 4.0, "b", cex = 0.8)
text(3.1, 3.3, "c", cex = 0.8)
text(4.3, 2.3, "e", cex = 0.8)
text(4.7, 2.5, "d", cex = 0.8)
text(6.1, 0.9, "f", cex = 0.8)

d <- EloRating::DS(toy_example$m2, prop = "Pij")
plot(0, 0, type = "n", xlim = c(1, 6), ylim = c(0, 5), las = 1, axes = FALSE, 
     xlab = "ordinal rank", ylab = "normalized David's score", yaxs = "i")
axis(1, at = 1:6)
axis(2, at = 0:5, las = 1)
box(bty = "l")

r <- lm(d$normDS ~ I(rank(d$normDS * (-1))))
abline(r)
points(rank(d$normDS * (-1)), d$normDS + c(0, 0, 0, 0.1, -0.1, 0), 
       pch = 21, bg = "white", col = adjustcolor(cols, alpha.f = 1), lwd = 3, cex = 1.5, xpd = TRUE)
text(1, 4.5, "a", cex = 0.8)
text(2, 3.5, "b", cex = 0.8)
text(3, 2.5, "c", cex = 0.8)
text(4.4, 1, "e", cex = 0.8)
text(4.6, 2, "d", cex = 0.8)
text(6, 0.5, "f", cex = 0.8)

\newpage

figure 8

par(mfrow = c(1, 2), family = "serif", mgp = c(2, 0.7, 0), tcl = -0.3)

data("cred_width", package = "EloSteepness.data")
# limit table to initial matrices
pdata <- cred_width[grepl("_step00", cred_width$mat), ]

plot(log(pdata$i_ratio), pdata$median, xlab = "log interactions/group size ('data density')",
     ylab = "Elo steepness (median of posterior)", 
     las = 1, lwd = 0.4, xlim = c(0, 7), xaxs = "i", 
     ylim = c(0, 1), bty = "l", yaxs = "i", xpd = TRUE, cex = 0.7)
abline(v=log(c(10, 20)), lty = c(1, 2), col = "grey")

plot(log(pdata$i_ratio), pdata$cred_width89, xlab = "log interactions/group size ('data density')", 
     ylab = "Elo steepness (width of 89% credible interval)", 
     las = 1, lwd = 0.4, xlim = c(0, 7), xaxs = "i", 
     ylim = c(0, 1), bty = "l", yaxs = "i", xpd = TRUE, cex = 0.7)
abline(v=log(c(10, 20)), lty = c(1, 2), col = "grey")