[R] A combinatorial assignment problem
Charles Berry
ccberry at ucsd.edu
Thu May 1 23:19:30 CEST 2014
Ravi Varadhan <ravi.varadhan <at> jhu.edu> writes:
>
> Thanks, Bert.
> I have written this simple code, which is crude, but seems to do a decent
job. It works perfectly when M is a
> factor of R. Otherwise, it gives decent balance (of course, balance is not
guaranteed). I guess it is
> possible to take the results, that are somewhat unbalanced and then
reshuffle it semi-randomly to get
> better balance. Any improvements are appreciated!
>
> assign <- function(K, R, M, iseed=1234) {
> assignment <- matrix(NA, K, M)
> N <- R %/% M
> Nrem <- R %% M
> iseq <- seq(1,K,N)
> for (i in iseq){
> size <- ifelse(K-i >= N, R-Nrem, M*(K-i+1))
> sel <- sample(1:R, size=size, replace=FALSE)
> end <- min((i+N-1),K)
> assignment[i:end, ] <- sel
> }
> assignment
> }
>
> sol <- assign(40,16,3)
> table(sol)
>
> Thanks,
> Ravi
>
crossdes::find.BIB() seems to do better wrt balance and 'mixing' than
assign().
If you consider the usage of pairs of reviewers in this case,
find.BIB() comes closer to equal usage.
> assgn <- t(apply(assign(40,16,3),1,sort))
> bib <- find.BIB(16,40,3)
> adf <- data.frame(r1=factor(assgn[,c(1,1,2)],1:16),
+ r2 = factor(assgn[,c(2,3,3)],1:16))
> bdf <- data.frame(r1=factor(bib[,c(1,1,2)],1:16),
+ r2 = factor(bib[,c(2,3,3)],1:16))
> table(xtabs(~.,adf)[upper.tri(diag(16))])
0 1 2 3 4
44 42 26 6 2
> table(xtabs(~.,bdf)[upper.tri(diag(16))])
0 1 2
5 110 5
>
In the assign(10,7,3) case, the balance is typically better with
find.BIB(7,10,3):
apply(replicate(10,table(assign(10,7,3))),2,range)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 3 2 2 3 3 3 2 3 3 3
[2,] 5 5 5 5 5 5 5 5 5 5
> apply(replicate(10,table(find.BIB(7,10,3))),2,range)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 4 4 4 4 4 4 4 4 4 4
[2,] 5 5 5 5 5 5 5 5 5 5
>
You will pay a price for find.BIB in CPU time, however.
HTH,
Chuck
More information about the R-help
mailing list