Logic Based Puzzles (clpe01)
/***************************************************************/
/* */
/* S A S S A M P L E L I B R A R Y */
/* */
/* NAME: clpe01 */
/* TITLE: Logic Based Puzzles (clpe01) */
/* PRODUCT: OR */
/* SYSTEM: ALL */
/* KEYS: OR */
/* PROCS: CLP, IML */
/* DATA: */
/* */
/* SUPPORT: UPDATE: */
/* REF: */
/* MISC: Example 1 from the CLP Procedure chapter of the */
/* Constraint 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 . .
;
run;
/* 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 . .
;
run;
%macro store_initial_values;
/* store initial values into macro variable C_i_j */
data _null_;
set indata;
array C{9};
do j = 1 to 9;
i = _N_;
call symput(compress('C_'||put(i,best.)||'_'||put(j,best.)),
put(C[j],best.));
end;
run;
%mend store_initial_values;
%store_initial_values;
%macro solve;
proc clp out=outdata;
/* Declare variables */
/* Nine row constraints */
%do i = 1 %to 9;
var (X_&i._1-X_&i._9) = [1,9];
alldiff(X_&i._1-X_&i._9);
%end;
/* Nine column constraints */
%do j = 1 %to 9;
alldiff(
%do i = 1 %to 9;
X_&i._&j
%end;
);
%end;
/* Nine 3x3 block constraints */
%do s = 0 %to 2;
%do t = 0 %to 2;
alldiff(
%do i = 3*&s + 1 %to 3*&s + 3;
%do j = 3*&t + 1 %to 3*&t + 3;
X_&i._&j
%end;
%end;
);
%end;
%end;
/* Initialize variables to cell values */
/* X_i_j = C_i_j if C_i_j is non-missing */
%do i = 1 %to 9;
%do j = 1 %to 9;
%if &&C_&i._&j ne . %then %do;
lincon X_&i._&j = &&C_&i._&j;
%end;
%end;
%end;
run;
%put &_ORCLP_;
%mend solve;
%solve
%macro convert_to_dense(n);
/* convert solution to matrix in dense format */
data outdata_dense;
set outdata;
array C{9};
%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(9);
%print_sudoku(outdata_dense);
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
;
run;
%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
;
run;
%macro cdata;
/* store each pre-filled value into macro variable C_i_j */
data _null_;
set raw;
array C{12};
do j = 1 to 12;
i = _N_;
call symput(compress('C_'||put(i,best.)||'_'||put(j,best.)),
put(C[j],best.));
end;
run;
%mend cdata;
%cdata;
%macro cons_row(r);
/* Row r 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. */
gcc(X_&r._1-X_&r._12) =
( (1, 2, 2) (3, 2, 2) (5, 3, 3) (7, 0, 0) DL=1 DU=1 );
%mend cons_row;
%macro cons_col(c);
/* Column c 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. */
gcc( %do r = 1 %to 12;
X_&r._&c.
%end;
) = ((1, 2, 2) (3, 2, 2) (5, 3, 3) (7, 0, 0) DL=1 DU=1);
%mend cons_col;
%macro cons_region(vars);
/* Jigsaw region that contains &vars 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. */
gcc(&vars.) = ((1, 2, 2) (3, 2, 2) (5, 3, 3) (7, 0, 0) DL=1 DU=1);
%mend cons_region;
%macro pds(solns=allsolns,varsel=MINR,maxt=900);
proc clp out=pdsout &solns
varselect=&varsel /* Variable selection strategy */
maxtime=&maxt; /* Time limit */
/* Variable X_i_j represents the grid of ith row and jth column. */
var (
%do i = 1 %to 12;
X_&i._1 - X_&i._12
%end;
) = [1,9];
/* X_i_j = C_i_j if C_i_j is non-missing */
%do i = 1 %to 12;
%do j = 1 %to 12;
%if &&C_&i._&j ne . %then %do;
lincon X_&i._&j = &&C_&i._&j;
%end;
%end;
%end;
/* 12 Row constraints: */
%do r = 1 %to 12;
%cons_row(&r);
%end;
/* 12 Column constraints: */
%do c = 1 %to 12;
%cons_col(&c);
%end;
/* 12 Jigsaw region constraints: */
/* Each jigsaw region is defined by the macro variable &vars. */
/* Region 1: */
%let vars = X_1_1 - X_1_3 X_2_1 - X_2_3
X_3_1 X_3_2 X_4_1 X_4_2 X_5_1 X_5_2;
%cons_region(&vars.);
/* Region 2: */
%let vars = X_1_4 - X_1_9 X_2_4 - X_2_9;
%cons_region(&vars.);
/* Region 3: */
%let vars = X_1_10 - X_1_12 X_2_10 - X_2_12
X_3_11 X_3_12 X_4_11 X_4_12 X_5_11 X_5_12;
%cons_region(&vars.);
/* Region 4: */
%let vars = X_3_3 - X_3_6 X_4_3 - X_4_6 X_5_3 - X_5_6;
%cons_region(&vars.);
/* Region 5: */
%let vars = X_3_7 - X_3_10 X_4_7 - X_4_10 X_5_7 - X_5_10;
%cons_region(&vars.);
/* Region 6: */
%let vars = X_6_1 - X_6_3 X_7_1 - X_7_3
X_8_1 - X_8_3 X_9_1 - X_9_3;
%cons_region(&vars.);
/* Region 7: */
%let vars = X_6_4 X_6_5 X_7_4 X_7_5 X_8_4 X_8_5
X_9_4 X_9_5 X_10_4 X_10_5 X_11_4 X_11_5;
%cons_region(&vars.);
/* Region 8: */
%let vars = X_6_6 X_6_7 X_7_6 X_7_7 X_8_6 X_8_7
X_9_6 X_9_7 X_10_6 X_10_7 X_11_6 X_11_7;
%cons_region(&vars.);
/* Region 9: */
%let vars = X_6_8 X_6_9 X_7_8 X_7_9 X_8_8 X_8_9
X_9_8 X_9_9 X_10_8 X_10_9 X_11_8 X_11_9;
%cons_region(&vars.);
/* Region 10: */
%let vars = X_6_10 - X_6_12 X_7_10 - X_7_12
X_8_10 - X_8_12 X_9_10 - X_9_12;
%cons_region(&vars.);
/* Region 11: */
%let vars = X_10_1 - X_10_3 X_11_1 - X_11_3 X_12_1 - X_12_6;
%cons_region(&vars.);
/* Region 12: */
%let vars = X_10_10 - X_10_12 X_11_10 - X_11_12 X_12_7 - X_12_12;
%cons_region(&vars.);
run;
%put &_ORCLP_;
%mend pds;
%pds;
/* 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);
%put n = &n;
/* magic constant */
%let sum = %eval((&n*(&n*&n+1))/2);
proc clp out=magic&n evalvarsel maxtime=3;
/* X_i_j = entry (i,j) */
%do i = 1 %to &n;
var (X_&i._1-X_&i._&n) = [1,%eval(&n*&n)];
%end;
/* row sums */
%do i = 1 %to &n;
lincon 0
%do j = 1 %to &n;
+ X_&i._&j
%end;
= ∑
%end;
/* column sums */
%do j = 1 %to &n;
lincon 0
%do i = 1 %to &n;
+ X_&i._&j
%end;
= ∑
%end;
/* diagonal: upper left to lower right */
lincon 0
%do i = 1 %to &n;
+ X_&i._&i
%end;
= ∑
/* diagonal: upper right to lower left */
lincon 0
%do i = 1 %to &n;
+ X_%eval(&n+1-&i)_&i
%end;
= ∑
/* symmetry-breaking */
lincon X_1_1 + 1 <= X_&n._1;
lincon X_1_1 + 1 <= X_&n._&n;
lincon X_1_&n + 1 <= X_&n._1;
alldiff();
run;
%put &_ORCLP_;
%put &_ORCLPEVS_;
%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);