Resources

Logic Based Puzzles (oclpe01)

/***************************************************************/
/*                                                             */
/*          S A S   S A M P L E   L I B R A R Y                */
/*                                                             */
/*    NAME: oclpe01                                            */
/*   TITLE: Logic Based Puzzles (oclpe01)                      */
/* PRODUCT: OR                                                 */
/*  SYSTEM: ALL                                                */
/*    KEYS: OR                                                 */
/*   PROCS: OPTMODEL                                           */
/*    DATA:                                                    */
/*                                                             */
/* SUPPORT:                             UPDATE:                */
/*     REF:                                                    */
/*    MISC: Example 1 from the CLP solver chapter of the       */
/*          Mathematical Programming book.                     */
/*                                                             */
/***************************************************************/

/* Given a sudoku problem */
data indata;
   input C1-C9;
   datalines;
. . 5 . . 7 . . 1
. 7 . . 9 . . 3 .
. . . 6 . . . . .
. . 3 . . 1 . . 5
. 9 . . 8 . . 2 .
1 . . 2 . . 4 . .
. . 2 . . 6 . . 9
. . . . 4 . . 8 .
8 . . 1 . . 5 . .
;

/* Print sudoku */
%macro print_sudoku(dsn);
   goptions hsize=4in vsize=4in;
   data _null_;
      set &dsn;
      array c{9} C1-C9;
      if _n_=1 then do;
         rc=ginit();
         rc=graph('clear');
      end;
      rc=gset('texheight',4);
      rc=gset('texfont',"swiss");
      do h=1 to 9;
         rc=gdraw('Bar', 100*(h-1)/9,100*(9-_n_)/9,100*(h)/9,100*(10-_n_)/9);
         if c{h}~=. then
            rc=gdraw('text', 100*(h-1)/9+4.5,100*(9-_n_)/9+4.5, put(c{h},1.));
      end;
      rc=gset('linwidth', 3);
      rc=gdraw('line', 2, 0, 0, 0, 100);
      rc=gdraw('line', 2, 100/3, 100/3, 0, 100);
      rc=gdraw('line', 2, 200/3, 200/3, 0, 100);
      rc=gdraw('line', 2, 100, 100, 0, 100);
      rc=gdraw('line', 2, 0, 100, 0, 0);
      rc=gdraw('line', 2, 0, 100, 100/3, 100/3);
      rc=gdraw('line', 2, 0, 100, 200/3, 200/3);
      rc=gdraw('line', 2, 0, 100, 100, 100);
      if _n_=9 then do;
         rc=graph('update');
         rc=gterm();
      end;
   run;
title;
%mend print_sudoku;

%print_sudoku(indata);

data Indata;
   input C1-C9;
   datalines;
. . 5 . . 7 . . 1
. 7 . . 9 . . 3 .
. . . 6 . . . . .
. . 3 . . 1 . . 5
. 9 . . 8 . . 2 .
1 . . 2 . . 4 . .
. . 2 . . 6 . . 9
. . . . 4 . . 8 .
8 . . 1 . . 5 . .
;

proc optmodel;
   /* Declare variables */
   set ROWS = 1..9;
   set COLS = ROWS; /* Use an alias for convenience and clarity */
   var X {ROWS, COLS} >= 1 <= 9 integer;

   /* Nine row constraints */
   con RowCon {i in ROWS}:
      alldiff({j in COLS} X[i,j]);

   /* Nine column constraints */
   con ColCon {j in COLS}:
      alldiff({i in ROWS} X[i,j]);

   /* Nine 3x3 block constraints */
   con BlockCon {s in 0..2, t in 0..2}:
      alldiff({i in 3*s+1..3*s+3, j in 3*t+1..3*t+3} X[i,j]);

   /* Fix variables to cell values */
   /* X[i,j] = c[i,j] if c[i,j] is not missing */
   num c {ROWS, COLS};
   read data indata into [_N_] {j in COLS} <c[_N_,j]=col('C'||j)>;
   for {i in ROWS, j in COLS: c[i,j] ne .}
      fix X[i,j] = c[i,j];

   solve;
quit;

data raw;
   input C1-C12;
   datalines;
3 . . 1 5 4 . . 1 . 9 5
. 1 . . 3 . . . . 1 3 6
. . 4 . . 3 . 8 . . 2 .
5 . . 1 . . 9 2 5 . . 1
. 9 . . 5 . . 5 . . . .
5 8 1 . . 9 . . 3 . 6 .
. 5 . 8 . . 2 . . 5 5 3
. . . . 5 . . 6 . . 1 .
2 . . 5 1 5 . . 5 . . 9
. 6 . . 4 . 1 . . 3 . .
1 5 1 . . . . 5 . . 5 .
5 5 . 4 . . 3 1 6 . . 8
;

%macro print_piday(dsn);
   goptions reset=title;
   goptions hsize=4in vsize=4in;
   data _null_;
      set &dsn;
      array c{12} C1-C12;
      if _n_=1 then do;
         rc=ginit();
         rc=graph('clear');
         rc=gset('texheight',4);
         rc=gset('texfont',"swiss");
         /* set colors */
         rc=gset('colrep', 1, 'black');
         rc=gset('colrep', 2, 'cxfde28a');
         rc=gset('colrep', 3, 'cxffedaf');
         rc=gset('colrep', 4, 'cxbd85ff');
         rc=gset('colrep', 5, 'cxd3aefe');
         rc=gset('colrep', 6, 'cxffdc61');
         rc=gset('filtype', 'solid');
         /* draw the color bars */
         rc=gset('filcolor', 2);
         rc=gdraw('bar', 0,100,100,0);
         rc=gset('filcolor', 3);
         rc=gdraw('bar', 0,300/12,300/12,700/12);
         rc=gdraw('bar', 500/12,100/12,700/12,700/12);
         rc=gdraw('bar', 900/12,300/12,100,700/12);
         rc=gdraw('bar', 300/12,1000/12,900/12,100);
         rc=gset('filcolor', 4);
         rc=gdraw('bar', 200/12,700/12,600/12,1000/12);
         rc=gdraw('bar', 700/12,100/12,900/12,700/12);
         rc=gset('filcolor', 5);
         rc=gdraw('bar', 300/12,100/12,500/12,700/12);
         rc=gdraw('bar', 600/12,700/12,1000/12,1000/12);
         rc=gset('filcolor', 6);
         rc=gdraw('bar', 0,0,600/12,100/12);
         rc=gdraw('bar', 0,100/12,300/12,300/12);
         rc=gdraw('bar', 1000/12,700/12,100,1000/12);
         rc=gdraw('bar', 900/12,1000/12,100,100);
         /* draw grids and fill the numbers */
         rc=gset('filcolor',1);
         rc=gset('filtype','hollow');
      end;
      do h=1 to 12;
         rc=gdraw('Bar', 100*(h-1)/12,100*(12-_n_)/12,100*(h)/12,
                  100*(13-_n_)/12);
         if c{h}~=. then
            rc=gdraw('text', 100*(h-1)/12+3,100*(12-_n_)/12+3,
                     put(c{h},1.));
      end;
      /* draw separating lines */
      rc=gset('lincolor',1);
      rc=gset('linwidth', 3);
      rc=gdraw('line', 7, 0,0,300/12,300/12,600/12,600/12,0, 0,300/12,
               300/12,100/12,100/12,0,0);
      rc=gdraw('line', 6, 600/12,900/12,900/12,100,100,600/12, 100/12,
               100/12,300/12,300/12,0,0);
      rc=gdraw('line', 4, 0,0,300/12,300/12, 300/12,700/12,700/12,300/12);
      rc=gdraw('line', 4, 900/12,900/12,100,100, 300/12,700/12,700/12,
               300/12);
      rc=gdraw('line', 6, 0,0,300/12,300/12,200/12,200/12, 700/12,100,100,
               1000/12,1000/12,700/12);
      rc=gdraw('line', 6, 1000/12,1000/12,900/12,900/12,100,100, 700/12,
               1000/12,1000/12,100,100,700/12);
      rc=gdraw('line', 4, 300/12,900/12,900/12,300/12, 100,100,1000/12,
               1000/12);
      rc=gdraw('line', 5, 600/12,600/12,300/12,500/12,500/12, 1000/12,
               700/12,700/12,700/12,100/12);
      rc=gdraw('line', 4, 900/12,600/12,700/12,700/12, 700/12,700/12,
               700/12,100/12);
      if _n_=12 then do;
         rc=graph('update');
         rc=gterm();
      end;
   run;
%mend print_piday;

%print_piday(raw);

data Raw;
   input C1-C12;
   datalines;
3  .  .  1  5  4  .  .  1  .  9  5
.  1  .  .  3  .  .  .  .  1  3  6
.  .  4  .  .  3  .  8  .  .  2  .
5  .  .  1  .  .  9  2  5  .  .  1
.  9  .  .  5  .  .  5  .  .  .  .
5  8  1  .  .  9  .  .  3  .  6  .
.  5  .  8  .  .  2  .  .  5  5  3
.  .  .  .  5  .  .  6  .  .  1  .
2  .  .  5  1  5  .  .  5  .  .  9
.  6  .  .  4  .  1  .  .  3  .  .
1  5  1  .  .  .  .  5  .  .  5  .
5  5  .  4  .  .  3  1  6  .  .  8
;

proc optmodel;
   set ROWS = 1..12;
   /* These declarations are inexpensive and improve clarity: */
   set COLS = ROWS, REGIONS = ROWS, CELLS = ROWS cross COLS;

   /* specify a 12x12 array of region identifiers.
      The spacing is just to make the regions easier to visualize. */
   num region{CELLS} = [
       1  1  1    2  2  2  2  2  2    3  3  3
       1  1  1    2  2  2  2  2  2    3  3  3
       1  1   4  4  4  4    5  5  5  5   3  3
       1  1   4  4  4  4    5  5  5  5   3  3
       1  1   4  4  4  4    5  5  5  5   3  3
       6  6  6   7  7   8  8   9  9  10 10 10
       6  6  6   7  7   8  8   9  9  10 10 10
       6  6  6   7  7   8  8   9  9  10 10 10
       6  6  6   7  7   8  8   9  9  10 10 10
      11 11 11   7  7   8  8   9  9  12 12 12
      11 11 11   7  7   8  8   9  9  12 12 12
      11 11 11 11 11 11     12 12 12 12 12 12 ];

   /* Each area must contain two 1's, two 3's, three 5's, no 7's,
      and one for each of other values from 1 to 9. */
                    /* 1 2 3 4 5 6 7 8 9 */
   num nTimes{1..9} = [2 1 2 1 3 1 0 1 1];
   /* For convenience, create a triplet set version of nTimes.
      In this model, GCC's lower and upper bounds are the same. */
   set N_TIMES = setof{ni in 1..9} <ni,nTimes[ni],nTimes[ni]>;

   /* The number assigned to the ith row and jth column. */
   var X {CELLS} >= 1 <= 9 integer;

   /* X[i,j] = c[i,j] if c[i,j] is not missing */
   num c {CELLS};
   read data raw into [_N_] {j in COLS} <c[_N_,j]=col('C'||j)>;
   for {<i,j> in CELLS: c[i,j] ne .}
      fix X[i,j] = c[i,j];

   con RowCon {i in ROWS}:
      gcc({j in COLS} X[i,j], N_TIMES);

   con ColCon {j in COLS}:
      gcc({i in ROWS} X[i,j], N_TIMES);

   con RegionCon {ri in REGIONS}:
      gcc({<i,j> in CELLS: region[i,j] = ri} X[i,j], N_TIMES);

   solve;
   /* Replicate typical PROC CLP output from PROC OPTMODEL arrays */
   create data pdsout from
      {<i,j> in ROWS cross COLS}<col('X_'||i||'_'||j)=X[i,j]>;
quit;

/* convert solution to matrix in dense format */
%macro pds_out;
   data pdsoutsq;
   set pdsout;
   array C{12};
      %do i = 1 %to 12;
         %do j = 1 %to 12;
            C[&j.] = X_&i._&j.;
         %end;

         output;
      %end;
      drop X:;
   run;

   proc print data=pdsoutsq;
      title "Pi Day Sudoku 2008";
   run;

%mend pds_out;

%pds_out;

%print_piday(pdsoutsq);

%macro magic(n);
   proc optmodel;
      num n = &n;
      /* magic constant */
      num sum = n*(n^2+1)/2;
      set ROWS = 1..n;
      set COLS = 1..n;

      /* X[i,j] = entry (i,j) */
      var X {ROWS, COLS} >= 1 <= n^2 integer;

      /* row sums */
      con RowCon {i in ROWS}:
         sum {j in COLS} X[i,j] = sum;

      /* column sums */
      con ColCon {j in COLS}:
         sum {i in ROWS} X[i,j] = sum;

      /* diagonal: upper left to lower right */
      con DiagCon:
         sum {i in ROWS} X[i,i] = sum;

      /* diagonal: upper right to lower left */
      con AntidiagCon:
         sum {i in ROWS} X[n+1-i,i] = sum;

      /* symmetry-breaking */
      con BreakRowSymmetry:
         X[1,1] + 1 <= X[n,1];
      con BreakDiagSymmetry:
         X[1,1] + 1 <= X[n,n];
      con BreakAntidiagSymmetry:
         X[1,n] + 1 <= X[n,1];

      con alldiff(X);

      solve with CLP / varselect=minrmaxc maxtime=3;
      create data magic&n from
         {<i,j> in ROWS cross COLS}<col('X_'||i||'_'||j)=X[i,j]>;
   quit;
%mend magic;

%magic(7)

%macro convert_to_dense(n);
   /* convert solution to matrix in dense format */
   data magic7_dense;
      set magic7;
      array C{7};
      %do i = 1 %to &n;
         %do j = 1 %to &n;
            C[&j] = X_&i._&j;
         %end;
         output;
      %end;
      drop X:;
   run;
%mend convert_to_dense;
%convert_to_dense(7);

/* Print Magic Square */
%macro print_msq(dsn);
   goptions hsize=3in vsize=3in;
   data _null_;
      set &dsn;
      array c{7} C1-C7;
      if _n_=1 then do;
         rc=ginit();
         rc=graph('clear');
      end;
   rc=gset('texheight',4);
   rc=gset('texfont',"swiss");
   do h=1 to 7;
      rc=gdraw('Bar', 100*(h-1)/7.,100*(7-_n_)/7.,100*(h)/7,100*(10-_n_)/7);
      if c{h}~=. then
         rc=gdraw('text', 100*(h-1)/7+4.5,100*(7-_n_)/7+4.5, put(c{h},2.));
   end;
   if _n_=7 then do;
      rc=graph('update');
      rc=gterm();
   end;
run;
%mend print_msq;
%print_msq(magic7_dense);