**F**ollowing the question on dinner table permutations on StackExchange (mathematics) and the reply that the right number was *six*, provided by hardmath, I was looking for a constructive solution how to build the resolvable 2-(20,5,1) covering. A few hours later. hardmath again came up with an answer, found in the paper *Equitable Resolvable Coverings* by van Dam, Haemers and Peek (2002). In the meanwhile (and even during the Big’MC seminar of yesterday!), I had been thinking of a simulated annealing implementation, which actually was used by van Dam, Haemers and Peek. Here is my (plain) R code

#initialisation of tables
#rows for individuals, columns for courses
T=sample(rep(1:4,5))
for (i in 2:6)
T=cbind(T,sample(rep(1:4,5)))
#encounters table
meet=function(T){
M=outer(T[,1],T[,1],"==")
for (i in 2:6)
M=M+outer(T[,i],T[,i],"==")
M
}
#number of missed encounters
penalty=function(M){ sum(M==0) }
penat=penalty(meet(T))
N=10^5
gamma=100
for (t in 1:N){
#random pick of switched individuals
prop=sample(1:20,2,prob=apply(meet(T)==0,1,sum))
cour=sample(1:6,1)
Tp=T
Tp[prop[1],cour]=T[prop[2],cour]
Tp[prop[2],cour]=T[prop[1],cour]
penatp=penalty(meet(Tp))
print(c(penat,penatp))
if (penatp==0){
T=Tp
break()
}
if (log(runif(1))<(penat-penatp)/gamma){
T=Tp
penat=penatp}
if (t%%10==0)
gamma=gamma*.999
}

which happened to provide a solution on the second round (got stuck at a penalty of 4 in the first round):

> T
T
[1,] 1 4 3 2 2 3
[2,] 1 2 4 3 4 4
[3,] 3 2 1 4 1 3
[4,] 1 2 3 1 1 1
[5,] 4 2 4 2 3 3
[6,] 2 4 1 2 4 1
[7,] 4 3 1 1 2 4
[8,] 1 3 2 4 3 1
[9,] 3 3 3 3 4 3
[10,] 4 4 2 3 1 1
[11,] 1 1 1 3 3 2
[12,] 3 4 4 1 3 2
[13,] 4 1 3 4 4 2
[14,] 2 4 3 4 3 4
[15,] 2 3 4 2 1 2
[16,] 2 2 2 3 2 2
[17,] 2 1 2 1 4 3
[18,] 4 3 1 1 2 4
[19,] 3 1 4 4 2 1
[20,] 3 1 2 2 1 4

(This makes a great example for my general public talk in Australia this summer/winter!)

Filed under: R, Statistics, University life Tagged: combinatorics, covering, R, resolvable covering, simulated annealing, StackExchange

*Related*

To

**leave a comment** for the author, please follow the link and comment on their blog:

** Xi'an's Og » R**.

R-bloggers.com offers

**daily e-mail updates** about

R news and

tutorials on topics such as: visualization (

ggplot2,

Boxplots,

maps,

animation), programming (

RStudio,

Sweave,

LaTeX,

SQL,

Eclipse,

git,

hadoop,

Web Scraping) statistics (

regression,

PCA,

time series,

trading) and more...

If you got this far, why not

__subscribe for updates__ from the site? Choose your flavor:

e-mail,

twitter,

RSS, or

facebook...

**Tags:** combinatorics, covering, R, resolvable covering, simulated annealing, StackExchange, statistics, University life