028: Balanced Incomplete Block Designs

[bibd(v:integer, b:integer, r:integer, k:integer, lambda:integer) : Problem
 -> let n := (v * b) + (b * v * (v - 1)) / 2,
        pb := makeProblem("BIBD",n)
    in (for i in (1 .. v)
         (for j in (1 .. b)
           makeIntVar(pb,"V[" /+ string!(i) /+ "," /+ string!(j) /+ "]",{0,1})),
        (for i in (1 .. v) post(pb,occur(1,row(pb.vars,i,v,b)) == r)),
        (for j in (1 .. b) post(pb,occur(1,column(pb.vars,j,v,b)) == k)),
        (for i1 in (1 .. v - 1)
          (for i2 in (i1 + 1 .. v)
            let D := list{makeIntVar(pb,
                                     "D[" /+ string!(i1) /+ "," 
                                          /+ string!(i2) /+ ","
                                          /+ string!(i)  /+ "]",
                                     {0,1}) | i in (1 .. b)}
            in (for l in (1 .. b)
                 let P := and(M(pb.vars,i1,l,v,b) == 1, M(pb.vars,i2,l,v,b) == 1),
                     Q := D[l] == 1
                 in post(pb,ifOnlyIf(P,Q)),
                post(pb,occur(1,D) == lambda)))),
        pb)]
//
// Produces a problem pb that corresponds to a balanced incomplete block design
// with v points, b blocks, each of size k. Each element of v occurs in r blocks
// and every possible pair of points occurs in lambda blocks
//
// v points
// b blocks 
// k block size 
// r occurrences of each object
// lambda occurrences of each pair
//
// This is the most naive encoding, using only 0/1 variables, no symmetry breaking
// It should be used only for first solution search.
//
// To run the program do as follows
// 
// > p:Problem := bibd(6,10,5,3,2)
// > solve(p,false)
// > look(p,6,10)
//


[M(A:list[IntVar],i:integer,j:integer,rows:integer,cols:integer) : IntVar
 -> A[cols * (i - 1) + j]]

[row(A:list[IntVar],i:integer,rows:integer,cols:integer) : list[IntVar]
 -> list{M(A,i,j,rows,cols) | j in (1 .. cols)}]

[column(A:list[IntVar],j:integer,rows:integer,cols:integer) : list[IntVar]
 -> list{M(A,i,j,rows,cols) | i in (1 .. rows)}]

[look(p:Problem,rows:integer,columns:integer) : void
 -> for i in (1 .. rows) 
      printf("\n ~S ",list{getValue(v) | v in row(p.vars,i,rows,columns)}),
    printf("\n")]
//
// Given a bibd p  display it as a 0/1 incidence matrix
// look(p,v,b)
//


//
// Patrick Prosser
// September the 18th 2001
//


--------------------------cut here----------------------------

Script started on Tue Sep 18 15:18:38 2001
>> choco -s 3 3
increasing memory size by 2^3 and 2^3
-- CLAIRE run-time library v 2.5.6 [os: ntv, C++:gcc ] --
-- CLAIRE interpreter - Copyright (C) 1994-00 Y. Caseau (see about())
Choco version 1.07, Copyright (C) 1999-2001 F. Laburthe
Choco comes with ABSOLUTELY NO WARRANTY; for details read licence.txt
This is free software, and you are welcome to redistribute it
under certain conditions; read licence.txt for details.
choco> load("bibd")
eval[0]> true
choco> p:Problem := bibd(6,10,5,3,2)
eval[1]> p
choco> system.verbose := 1
eval[2]> 1
choco> solve(p,false)
eval[3]> solve => 1 solution [76nd., 82bk.] in 40 ms.
true
choco> look(p,6,10)
eval[4]> 
 (0, 0, 0, 0, 0, 1, 1, 1, 1, 1) 
 (0, 0, 1, 1, 1, 0, 0, 0, 1, 1) 
 (0, 1, 0, 1, 1, 0, 1, 1, 0, 0) 
 (1, 0, 1, 0, 1, 1, 0, 1, 0, 0) 
 (1, 1, 0, 1, 0, 1, 0, 0, 0, 1) 
 (1, 1, 1, 0, 0, 0, 1, 0, 1, 0) 
nil
choco> q
eval[5]> Bye.
>> exit
exit

Script done on Tue Sep 18 15:19:44 2001