## Balanced Incomplete Block Design (oclpe08)

```/***************************************************************/
/*                                                             */
/*          S A S   S A M P L E   L I B R A R Y                */
/*                                                             */
/*    NAME: oclpe08                                            */
/*   TITLE: Balanced Incomplete Block Design (oclpe08)         */
/* PRODUCT: OR                                                 */
/*  SYSTEM: ALL                                                */
/*    KEYS: OR                                                 */
/*   PROCS: OPTMODEL                                           */
/*    DATA:                                                    */
/*                                                             */
/* SUPPORT:                             UPDATE:                */
/*     REF:                                                    */
/*    MISC: Example 8 from the CLP Procedure chapter of the    */
/*          Constraint Programming book.                       */
/*                                                             */
/***************************************************************/

%macro bibd(v, b, r, k, lambda, out=bibdout);
/* Arrange v objects into b blocks such that:
(i) each object occurs in exactly r blocks,
(ii) each block contains exactly k objects,
(iii) every pair of objects occur together in exactly lambda blocks.

Equivalently, create a binary matrix with v rows and b columns,
with r 1s per row, k 1s per column,
and scalar product lambda between any pair of distinct rows.
*/

/* Check necessary conditions */
%if (%eval(&r * &v) ne %eval(&b * &k)) or
(%eval(&lambda * (&v - 1)) ne %eval(&r * (&k - 1))) or
(&v > &b) %then %do;
%put BIBD necessary conditions are not met.;
%goto EXIT;
%end;

proc optmodel;
num v = &v;
num b = &b;
num r = &r;
num k = &k;
num lambda = &lambda;
set OBJECTS = 1..v;
set BLOCKS = 1..b;

/* Decision variable X[i,c] = 1 iff object i occurs in block c. */
var X {OBJECTS, BLOCKS} binary;

/* Mandatory constraints: */
/* (i) Each object occurs in exactly r blocks. */
con Exactly_r_blocks {i in OBJECTS}:
gcc({c in BLOCKS} X[i,c], {<0,0,b-r>,<1,0,r>});

/* (ii) Each block contains exactly k objects. */
con Exactly_k_objects {c in BLOCKS}:
gcc({i in OBJECTS} X[i,c], {<0,0,v-k>,<1,0,k>});

/* (iii) Every pair of objects occurs in exactly lambda blocks. */
set PAIRS = {i in OBJECTS, j in OBJECTS: i < j};
/* auxiliary variable P[i,j,c] = 1 iff both i and j occur in c */
var P {PAIRS, BLOCKS} binary;
con Pairs_reify {<i,j> in PAIRS, c in BLOCKS}:
reify(P[i,j,c], X[i,c] + X[j,c] = 2);
con Pairs_gcc {<i,j> in PAIRS}:
gcc({c in BLOCKS} P[i,j,c], {<0,0,b-lambda>,<1,0,lambda>});

/* symmetry-breaking constraints: */
/* Break row symmetry via lexicographic ordering constraints. */
con Symmetry_i {i in OBJECTS diff {1}}:
lexico({c in BLOCKS} X[i,c] < {c in BLOCKS} X[i-1,c]);

/* Break column symmetry via lexicographic ordering constraints. */
con Symmetry_c {c in BLOCKS diff {1}}:
lexico({i in OBJECTS} X[i,c] <= {i in OBJECTS} X[i,c-1]);

solve with CLP / varselect=FIFO;
create data &out from
{i in OBJECTS, c in BLOCKS} <col('X'||i||'_'||c)=X[i,c]>;
quit;
%put &_oroptmodel_;
%EXIT:
%mend bibd;

%bibd(15,15,7,7,3);

%macro bibd_out(v, b, r, k, lambda, out=bibdout, transpose=0);
/* Create a binary matrix with v rows and b columns from the solution
of the bibd macro.  If transpose = 1 then the matrix will be transposed
for convenience of display.
*/
data bibdmat;
set &out;
array Block{&b.};
%do i = 1 %to &v.;
%do j = 1 %to &b.;
Block[&j.] = x&i._&j.;
%end;

output;
%end;

drop x:;
run;

%if &transpose %then %do;
/* Transposes the rows and columns of the binary matrix for
convenience of display.  */
proc transpose data=bibdmat
out=bibdmat2(rename=(_NAME_=Block))
prefix=Object;
run;

/* Print the solution */
proc print data=bibdmat2;
title "Balanced Incomplete Block Design Problem";
title2 "(&v, &b, &r, &k, &lambda)";
run;
%end;
%else %do;
/* Print the solution */
proc print data=bibdmat;
title "Balanced Incomplete Block Design Problem";
title2 "(&v, &b, &r, &k, &lambda)";
run;
%end;
%mend bibd_out;

%bibd_out(15,15,7,7,3);

```