[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