demo/RLR2.R

In REBayes: Empirical Bayes Estimation and Inference

# Bradley Terry Estimation with Ranking Lasso Regularization
dgp <- function(a,m){
    # Roundrobin tournament: n teams, m rounds
    n <- length(a)
    A <- combn(n, 2)
    i <- factor(rep(A[1,], each = m), levels = 1:n)
    j <- factor(rep(A[2,], each = m), levels = 1:n)
    p <- a[i]/(a[i] + a[j])
    y <- (runif(length(i)) < p) * 1
    data.frame(i = i, j = j, y = y)
}
set.seed(123)
n = 20
m = 10
a <- exp(rnorm(n))
D <- dgp(a, m)
y <- D$y
X <- with(D, model.matrix(~ i - 1) - model.matrix(~ j - 1))
X <- X[,-1] # 1 is the reference team

# Construct Ranking Penalty Matrix
teams <- factor(levels(D$i)[-1])
pairs <- t(combn(teams,2)) 
P <- model.matrix(~ pairs[,1] - 1) - model.matrix(~ pairs[,2] - 1)
P <- rbind(diag(length(teams)),P)

lambdas <- 1:10/2
groups <- lambdas
for(i in 1:length(lambdas)){
    f = RLR(X, y, P, lambdas[i])
    groups[i] <- length(unique(round(c(0,f$coef),4)))
}
plot(lambdas, groups, type = "b")