Here is a SAS program to help you beat others at Sudoko, and impress people. It was written by a chap named Ryan Howard in 2006, and I am thankful for him in allowing me in sharing this.You can let us know if you find a puzzle it could not solve , or if you tweak the program a bit. The code is pasted below.
Have fun !
And the SAS paper on this was at SAS Global Forum 2007- the resulting
paper, “SAS and Sudoku”, was written by Richard DeVenezia, John Gerlach,
Larry Hoyle, Talbot Katz and Rick Langston, and can be viewed at
http://www2.sas.com/proceedings/forum2007/011-2007.pdf.
(p.s. I haven’t tested this on WPS , they still dont have the SAS Macro language ,but let me know if you have any equivalent in SPSS or R 🙂 )
*=============================================================================;
* sudoku.sas ;
* Written by: Ryan Howard ;
* Date: Sept. 2006 ;
*-----------------------------------------------------------------------------;
* Summary: This program solves sudoku puzzles consisting of a 9X9 matrix. ;
*-----------------------------------------------------------------------------;
* Upgrade Ideas: 1. Add a GUI to collect the input numbers and display output;
* 2. Expand logic to work for 16X16 matrices ;
*=============================================================================;
title;
options nodate nonumber;
data _null_;
*-----------------------------------------------------------------------------;
* input inital values for each cell from puzzle ;
*-----------------------------------------------------------------------------;
_1111=9; _1112=.; _1113=.; _1211=.; _1212=.; _1213=.; _1311=1; _1312=.; _1313=.;
_1121=5; _1122=.; _1123=.; _1221=.; _1222=6; _1223=.; _1321=.; _1322=4; _1323=2;
_1131=.; _1132=.; _1133=.; _1231=7; _1232=1; _1233=.; _1331=5; _1332=.; _1333=.;
_2111=.; _2112=.; _2113=2; _2211=.; _2212=.; _2213=.; _2311=.; _2312=1; _2313=.;
_2121=.; _2122=3; _2123=.; _2221=.; _2222=.; _2223=.; _2321=2; _2322=9; _2323=.;
_2131=.; _2132=7; _2133=.; _2231=.; _2232=.; _2233=6; _2331=.; _2332=.; _2333=3;
_3111=.; _3112=2; _3113=.; _3211=.; _3212=.; _3213=8; _3311=.; _3312=.; _3313=.;
_3121=.; _3122=.; _3123=4; _3221=5; _3222=.; _3223=.; _3321=.; _3322=.; _3323=.;
_3131=.; _3132=.; _3133=.; _3231=.; _3232=3; _3233=.; _3331=8; _3332=.; _3333=9;
%macro printmatrix;
*----------------------------------------------------------------;
* print the result matrix ;
*----------------------------------------------------------------;
*---------------------------------------------------;
* Assign column positions for printing matrix ;
*---------------------------------------------------;
c1=1;
c2=10;
c3=20;
c4=35;
c5=45;
c6=55;
c7=70;
c8=80;
c9=90;
do _i=1 to 3;
do _j=1 to 3;
do _k= 1 to 3;
do _l = 1 to 3;
if boxrowcol(_i,_j,_k,_l) ne . then char_guess(_i,_j,_k,_l)=put(boxrowcol(_i,_j,_k,_l),1.);
end;
end;
end;
end;
put/;
put @c1 c1111 @c2 c1112 @c3 c1113 @c4 c1211 @c5 c1212 @c6 c1213 @c7 c1311 @c8 c1312 @c9 c1313 ;
put @c1 c1121 @c2 c1122 @c3 c1123 @c4 c1221 @c5 c1222 @c6 c1223 @c7 c1321 @c8 c1322 @c9 c1323 ;
put @c1 c1131 @c2 c1132 @c3 c1133 @c4 c1231 @c5 c1232 @c6 c1233 @c7 c1331 @c8 c1332 @c9 c1333 ;
put/;
put @c1 c2111 @c2 c2112 @c3 c2113 @c4 c2211 @c5 c2212 @c6 c2213 @c7 c2311 @c8 c2312 @c9 c2313 ;
put @c1 c2121 @c2 c2122 @c3 c2123 @c4 c2221 @c5 c2222 @c6 c2223 @c7 c2321 @c8 c2322 @c9 c2323 ;
put @c1 c2131 @c2 c2132 @c3 c2133 @c4 c2231 @c5 c2232 @c6 c2233 @c7 c2331 @c8 c2332 @c9 c2333 ;
put/;
put @c1 c3111 @c2 c3112 @c3 c3113 @c4 c3211 @c5 c3212 @c6 c3213 @c7 c3311 @c8 c3312 @c9 c3313 ;
put @c1 c3121 @c2 c3122 @c3 c3123 @c4 c3221 @c5 c3222 @c6 c3223 @c7 c3321 @c8 c3322 @c9 c3323 ;
put @c1 c3131 @c2 c3132 @c3 c3133 @c4 c3231 @c5 c3232 @c6 c3233 @c7 c3331 @c8 c3332 @c9 c3333 ;
put ;
%mend printmatrix;
*------array to hold unique number found for each cell-----------;
array boxRowCol(3,3,3,3) 3 _1111 _1112 _1113
_1121 _1122 _1123
_1131 _1132 _1133
_1211 _1212 _1213
_1221 _1222 _1223
_1231 _1232 _1233
_1311 _1312 _1313
_1321 _1322 _1323
_1331 _1332 _1333
_2111 _2112 _2113
_2121 _2122 _2123
_2131 _2132 _2133
_2211 _2212 _2213
_2221 _2222 _2223
_2231 _2232 _2233
_2311 _2312 _2313
_2321 _2322 _2323
_2331 _2332 _2333
_3111 _3112 _3113
_3121 _3122 _3123
_3131 _3132 _3133
_3211 _3212 _3213
_3221 _3222 _3223
_3231 _3232 _3233
_3311 _3312 _3313
_3321 _3322 _3323
_3331 _3332 _3333;
*-----array to hold list of possible digits not for each cell until a unique value is found--;
array char_guess(3,3,3,3) $9 c1111 c1112 c1113
c1121 c1122 c1123
c1131 c1132 c1133
c1211 c1212 c1213
c1221 c1222 c1223
c1231 c1232 c1233
c1311 c1312 c1313
c1321 c1322 c1323
c1331 c1332 c1333
c2111 c2112 c2113
c2121 c2122 c2123
c2131 c2132 c2133
c2211 c2212 c2213
c2221 c2222 c2223
c2231 c2232 c2233
c2311 c2312 c2313
c2321 c2322 c2323
c2331 c2332 c2333
c3111 c3112 c3113
c3121 c3122 c3123
c3131 c3132 c3133
c3211 c3212 c3213
c3221 c3222 c3223
c3231 c3232 c3233
c3311 c3312 c3313
c3321 c3322 c3323
c3331 c3332 c3333;
file print;
*---------------------------------------------------;
*initailize character guess ;
*---------------------------------------------------;
do v=1 to 3;
do w=1 to 3;
do x=1 to 3;
do y=1 to 3;
if boxRowCol(v,w,x,y)=. then char_guess(v,w,x,y)='123456789';
end;
end;
end;
end;
*---marker for goto statements;
MAINLOOP:
*-----------------------------------------------------------------------------;
*remove known values in box row or col from char guess ;
*-----------------------------------------------------------------------------;
do v=1 to 3;
do w=1 to 3;
do x=1 to 3;
do y=1 to 3;
*----------------------------------------------------------------;
* remove any values in box from char guess ;
*----------------------------------------------------------------;
do a=1 to 3;
do b=1 to 3;
if boxRowCol(v,w,a,b) ne . then
char_guess(v,w,x,y)=compress(char_guess(v,w,x,y),put(boxRowCol(v,w,a,b),3.));
end;
end;
*----------------------------------------------------------------;
* remove any values in row from char guess ;
*----------------------------------------------------------------;
do a=1 to 3;
do b=1 to 3;
if boxRowCol(v,a,x,b) ne . then
char_guess(v,w,x,y)=compress(char_guess(v,w,x,y),put(boxRowCol(v,a,x,b),3.));
end;
end;
*----------------------------------------------------------------;
* remove any values in column from char guess ;
*----------------------------------------------------------------;
do a=1 to 3;
do b=1 to 3;
if boxRowCol(a,w,b,y) ne . then
char_guess(v,w,x,y)=compress(char_guess(v,w,x,y),put(boxRowCol(a,w,b,y),3.));
end;
end;
*----------------------------------------------------------------;
* if only one choice left for the cell, set the value ;
*----------------------------------------------------------------;
if (length(char_guess(v,w,x,y))=1 and char_guess(v,w,x,y) ne '' )
then do;
BoxRowCol(v,w,x,y)=input(char_guess(v,w,x,y),3.);
put BoxRowCol(v,w,x,y)=
' set because all other values were eliminated for this cell';
char_guess(v,w,x,y)=''; *not required as this is set to blank on next itteration;
GOTO MAINLOOP; *any time new value is definite go to top of outer loop
*and reitterate using the new information ;
end;
end;
end;
end;
end;
*-----------------------------------------------------------------------------;
* for each box, check if there is only one place a digit ;
* can possibly fit. If so, set that digit and return to mainloop ;
*-----------------------------------------------------------------------------;
do v=1 to 3; *block row;
do w=1 to 3; *block col;
do u=1 to 9; *cycle through digits;
skip=0; d_cnt=0;
do x=1 to 3; *row w/in bock ;
do y=1 to 3; * col w/in row w/in block;
if boxRowCol(v,w,x,y)=u then skip=1;
if skip=0 then if indexc(char_guess(v,w,x,y),put(u,1.)) then do;
dummy= indexc(char_guess(v,w,x,y),put(u,3.));
d_cnt=d_cnt+1;
if d_cnt>1 then skip=1;
else do;
v1=v; w1=w; x1=x; y1=y;
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------;
*at completion of the box if there is only one place;
* a digit can go, place it there ;
*-----------------------------------------------------;
if d_cnt=1 and skip=0 then do;
boxRowCol(v1,w1,x1,y1)=u;
char_guess(v1,w1,x1,y1)='' ; *not really required as this is reset in mainloop;
put 'Value Found as only place in box possible for digdet ' BoxRowCol(v1,w1,x1,y1)=;
GOTO MAINLOOP;
end;
end; *u;
end; *w;
end; *v;
*-----------------------------------------------------------------------------;
* for each of the 9 columns, check if there is only one place a digit ;
* can possibly fit. If so, set that digit and return to mainloop ;
*-----------------------------------------------------------------------------;
do v=1 to 3; *set of 3 blocks to take column from;
do w=1 to 3; *current col to compaire over the 3 blocks;
do u=1 to 9; *cycle through digits;
skip=0; d_cnt=0;
do x=1 to 3; *block row to take row from ;
do y=1 to 3; * row w/in row w/in block;
if boxRowCol(x,v,y,w)=u then skip=1;
if skip=0 then if indexc(char_guess(x,v,y,w),put(u,1.)) then do;
dummy= indexc(char_guess(x,v,y,w),put(u,3.));
d_cnt=d_cnt+1;
if d_cnt>1 then skip=1;
else do;
v1=v; w1=w; x1=x; y1=y;
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------;
*at completion of the column if there is only one place;
* a digit can go, place it there ;
*-----------------------------------------------------;
if d_cnt=1 and skip=0 then do;
boxRowCol(x1,v1,y1,w1)=u;
char_guess(x1,v1,y1,w1)='' ; *not really required as this is reset in mainloop;
put 'Value Found as only place allowable for digdet in Column' BoxRowCol(x1,v1,y1,w1)=;
GOTO MAINLOOP;
end;
end; *u;
end; *w;
end; *v;
*-----------------------------------------------------------------------------;
* for each of the 9 Rows, check if there is only one place a digit ;
* can possibly fit. If so, set that digit and return to mainloop ;
*-----------------------------------------------------------------------------;
do v=1 to 3; *set of 3 blocks to take row from;
do w=1 to 3; *current row to compaire over the 3 blocks;
do u=1 to 9; *cycle through digits;
skip=0; d_cnt=0;
do x=1 to 3; *block col to take row from ;
do y=1 to 3; * col w/in col w/in block;
if boxRowCol(v,x,w,y)=u then skip=1;
if skip=0 then if indexc(char_guess(v,x,w,y),put(u,1.)) then do;
dummy= indexc(char_guess(v,x,w,y),put(u,3.));
d_cnt=d_cnt+1;
if d_cnt>1 then skip=1;
else do;
v1=v; w1=w; x1=x; y1=y;
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------;
*at completion of the row if there is only one place;
* a digit can go, place it there ;
*-----------------------------------------------------;
if d_cnt=1 and skip=0 then do;
boxRowCol(v1,x1,w1,y1)=u;
char_guess(v1,x1,w1,y1)='' ; *not really required as this is reset in mainloop;
put 'Value Found as only place allowable for digit in overall Row ' BoxRowCol(v1,x1,w1,y1)=;
GOTO MAINLOOP;
end;
end; *u;
end; *w;
end; *v;
*-----------------------------------------------------------------------------;
* for each box, see if all possible locations for a digit occur ;
* in a single column. if so, remove this value from the corresponding ;
* columns in the adjacent boxes ;
*-----------------------------------------------------------------------------;
do u=1 to 9; *cycle through digits;
do v=1 to 3; *row of block;
do w=1 to 3; *column of block ;
skip=0;
col_track=.;
do x=1 to 3; *row in block ;
do y=1 to 3; * col in block;
if boxRowCol(v,w,x,y)=u then skip=1;
if skip=0 then if indexc(char_guess(v,w,x,y),put(u,1.))>0 then do;
*-------if value is in more than one col then go to next block;
if col_track NE . and col_track ne y then skip=1;
else col_track=y;
end;
*----if at the end of the block only one colunm can --------;
* contain the digit, then, make that column in the boxes;
* of the same column as the current box, remove current ;
* digit from their possible values ;
if x=3 and y=3 and skip=0 and col_track ne . then do;
update=0;
do j=1 to 3;
do k=1 to 3; /* only remove from adjacent boxes*/
/* in corresponding rows */
if indexc(char_guess(j,w,k,col_track),put(u,1.)) and j ne v then do;
char_guess(j,w,k,col_track)=compress(char_guess(j,w,k,col_track),put(u,1.));
update=update+1;
put 'Value ' U= ' removed from ' char_guess(j,w,k,col_track)=
' because other box needs it in this column';
end;
end;
end;
if update>0 then GOTO MAINLOOP;
end;
end; *y;
end; *x;
end; *w;
end; *v;
end; *u;
*-----------------------------------------------------------------------------;
* for each box, see if all possible locations for a digit occur ;
* in a single row. if so, remove this value from the corresponding ;
* rows in the adjacent boxes ;
*-----------------------------------------------------------------------------;
do u=1 to 9; *cycle through digits;
do v=1 to 3; *row of block;
do w=1 to 3; *col of block ;
skip=0;
row_track=.;
do x=1 to 3; *row in block ;
do y=1 to 3; * col in block;
if boxRowCol(v,w,x,y)=u then skip=1;
if skip=0 then if indexc(char_guess(v,w,x,y),put(u,1.))>0 then do;
*-------if value is in more than one col then go to next block;
if row_track NE . and row_track ne x then skip=1;
else row_track=x;
* put char_guess(v,w,x,y)= u= x= row_track= skip=;
end;
*----if at the end of the block only one column can --------;
* contain the digit, then, make that column in the boxes;
* of the same column as the current box, remove current ;
* digit from their possible values ;
if x=3 and y=3 and skip=0 and row_track ne . then do;
update=0;
do j=1 to 3;
do k=1 to 3; /* only remove from adjacent boxes*/
/* in corresponding rows */
if indexc(char_guess(v,j,row_track,k),put(u,1.)) and j ne w then do;
char_guess(v,j,row_track,k)=compress(char_guess(v,j,row_track,k),put(u,1.));
update=update+1;
put 'Value ' U= ' removed from ' char_guess(v,j,row_track,k)=
' because other box needs it in this row';
end;
end;
end;
if update>0 then GOTO MAINLOOP;
end;
end; *y;
end; *x;
end; *w;
end; *v;
end; *u;
%*macro skipthis1;
*-----------------------------------------------------------------------------;
* if 2 cells in a box have an identical set of 2 digits, these 2 digits should;
* be removed from the list of possible values for the other (7) cells in the ;
* box. ;
* this logic is also applied to rows and columns ;
* this logic is also expanded to include strings or 3,4,5,6,7, and 8 digits ;
* however it is not likely thatmore than 2 or 3 will ever be used ;
*-----------------------------------------------------------------------------;
do v=1 to 3;
do w=1 to 3;
*----------------------------------------------------------------;
* checking box for cells with identical list of possible values ;
*----------------------------------------------------------------;
do x=1 to 3;
do y=1 to 3;
*current cell = w,x,y,z;
length checklist $9 matchMatrixlist$20;
numMatchingCells=1;
matchMatrixList='';
checklist=strip(char_guess(v,w,x,y));
updated=0;
if length(checklist)>1 then do;
do a=1 to 3;
do b=1 to 3;
if (x=a )*(b=y)=0 then do;
if strip(char_guess(v,w,a,b))=checklist then do;
numMatchingCells=numMatchingCells+1;
if matchMatrixList='' then matchMatrixList=put(x,1.)||put(y,1.) ;
matchMatrixList=trim(left(MatchMatrixList))
||put(a,1.)||put(b,1.) ;
matchMatrixList=compress(matchMatrixList,' ');
*put v= w= x= y= a= b= numMatchingCells= matchMatrixList=;
end;
end;
end;
end;
if numMatchingCells=length(checklist)then do;
do a=1 to 3;
do b=1 to 3;
ab=put(a,1.)||put(b,1.);
if substr(matchMatrixList,1,2) ne ab and
substr(matchMatrixList,3,2) ne ab and
substr(matchMatrixList,5,2) ne ab and
substr(matchMatrixList,7,2) ne ab and
substr(matchMatrixList,9,2) ne ab and
substr(matchMatrixList,11,2) ne ab and
substr(matchMatrixList,13,2) ne ab and
substr(matchMatrixList,15,2) ne ab and
substr(matchMatrixList,17,2) ne ab and
char_guess(v,w,a,b) ne '' then do;
if indexc(char_guess(v,w,a,b),strip(checklist)) then do;
updated=1;
put 'Box Digits ' checklist= ' removed from '
char_guess(v,w,a,b)= ' because this unique set of '
NumMatchingCells ' digits is shared by '
NumMatchingCells ' Cells.';
*put v= w= x= y= a= b= matchMatrixList=;
char_guess(v,w,a,b)=compress(char_guess(v,w,a,b),checklist);
end;
end;
end; *b;
end; *a;
if updated > 0 then GOTO MAINLOOP;
end; *numMatchingCells=length(cheklist);
end; *length checklist >1;
end; *y;
end; *x;
end; *w;
end; *v;
%*mend skipthis1;
%*macro skipthis2;
do v=1 to 3;
do w=1 to 3;
*----------------------------------------------------------------;
* checking column for cells with identical list of possible values ;
*----------------------------------------------------------------;
do x=1 to 3;
do y=1 to 3;
*current cell = w,x,y,z;
length checklist $9 matchMatrixlist$20;
numMatchingCells=1;
matchMatrixList='';
checklist=strip(char_guess(x,v,y,w));
updated=0;
if length(checklist)>1 then do;
do a=1 to 3;
do b=1 to 3;
if (x=a )*(b=y)=0 then do;
if strip(char_guess(a,v,b,w))=checklist then do;
numMatchingCells=numMatchingCells+1;
if matchMatrixList='' then matchMatrixList=put(x,1.)||put(y,1.) ;
matchMatrixList=trim(left(MatchMatrixList))
||put(a,1.)||put(b,1.) ;
matchMatrixList=compress(matchMatrixList,' ');
* put v= w= x= y= a= b= numMatchingCells= matchMatrixList=;
end;
end;
end;
end;
if numMatchingCells=length(checklist)then do;
do a=1 to 3;
do b=1 to 3;
ab=put(a,1.)||put(b,1.);
if substr(matchMatrixList,1,2) ne ab and
substr(matchMatrixList,3,2) ne ab and
substr(matchMatrixList,5,2) ne ab and
substr(matchMatrixList,7,2) ne ab and
substr(matchMatrixList,9,2) ne ab and
substr(matchMatrixList,11,2) ne ab and
substr(matchMatrixList,13,2) ne ab and
substr(matchMatrixList,15,2) ne ab and
substr(matchMatrixList,17,2) ne ab and
char_guess(a,v,b,w) ne '' then do;
if indexc(char_guess(a,v,b,w),strip(checklist)) then do;
updated=1;
put 'Column Digits ' checklist= ' removed from ' char_guess(a,v,b,w)=;
*put a= x= v= b= y= w= matchMatrixList=;
char_guess(a,v,b,w)=compress(char_guess(a,v,b,w),checklist);
end;
end;
end; *b;
end; *a;
if updated > 0 then GOTO MAINLOOP;
end; *numMatchingCells=length(cheklist);
end; *length checklist >1;
end; *y;
end; *x;
end; *w;
end; *v;
%*mend skipthis2;
do v=1 to 3;
do w=1 to 3;
*----------------------------------------------------------------;
* checking rows for cells with identical list of possible values ;
*----------------------------------------------------------------;
do x=1 to 3;
do y=1 to 3;
*current cell = w,x,y,z;
length checklist $9 matchMatrixlist$20;
numMatchingCells=1;
matchMatrixList='';
checklist=strip(char_guess(v,x,w,y));
updated=0;
if length(checklist)>1 then do;
do a=1 to 3;
do b=1 to 3;
if (x=a )*(b=y)=0 then do;
if strip(char_guess(v,a,w,b))=checklist then do;
numMatchingCells=numMatchingCells+1;
if matchMatrixList='' then matchMatrixList=put(x,1.)||put(y,1.) ;
matchMatrixList=trim(left(MatchMatrixList))
||put(a,1.)||put(b,1.) ;
matchMatrixList=compress(matchMatrixList,' ');
* put v= w= x= y= a= b= numMatchingCells= matchMatrixList=;
end;
end;
end;
end;
if numMatchingCells=length(checklist)then do;
do a=1 to 3;
do b=1 to 3;
ab=put(a,1.)||put(b,1.);
if substr(matchMatrixList,1,2) ne ab and
substr(matchMatrixList,3,2) ne ab and
substr(matchMatrixList,5,2) ne ab and
substr(matchMatrixList,7,2) ne ab and
substr(matchMatrixList,9,2) ne ab and
substr(matchMatrixList,11,2) ne ab and
substr(matchMatrixList,13,2) ne ab and
substr(matchMatrixList,15,2) ne ab and
substr(matchMatrixList,17,2) ne ab and
char_guess(v,a,w,b) ne '' then do;
if indexc(char_guess(v,a,w,b),strip(checklist)) then do;
updated=1;
put 'Row Digits ' checklist= ' removed from ' char_guess(v,a,w,b)=;
*put v= a= x= w= b= y= matchMatrixList=;
char_guess(v,a,w,b)=compress(char_guess(v,a,w,b),checklist);
end;
end;
end; *b;
end; *a;
if updated > 0 then GOTO MAINLOOP;
end; *numMatchingCells=length(cheklist);
end; *length checklist >1;
end; *y;
end; *x;
end; *w;
end; *v;
%*mend skipthis2;
*-----------------------------------------------------------------------------;
* if all possible spots for a digit within a box occur within 2 rows of the box;
* and all possible spots for the same digit occur within the same 2 rows ;
* of an adjacent box. ;
* then the alternate adjacent box cannot have that digit in either of ;
* the rows of the other 2 boxes, if this digit is listed as a possible ;
* value in either of these rows for this box, it is deleted from ;
* the list of possible values. ;
* ;
* This logic is repeated for columns as well as rows. ;
*-----------------------------------------------------------------------------;
updated=0;
*----------------------------------------------------------------;
* rows ;
*----------------------------------------------------------------;
do u=1 to 9;
do v=1 to 3; *down puzzle row;
*-----------------------------------------------------------------;
* create list of rows in 1st box of current row containing digit u;
*-----------------------------------------------------------------;
length store_row1 $3;
store_row1='';
do x=1 to 3; *down box row ;
do y=1 to 3; *across box col;
if indexc(char_guess(v,1,x,y),put(u,1.)) then do;
if indexc(store_row1,put(x,1.))<1 then do;
store_row1=strip(store_row1)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------------------;
* create list of rows in 2nd box of current row containing digit u;
*-----------------------------------------------------------------;
length store_row2 $3;
store_row2='';
do x=1 to 3; *down box row ;
do y=1 to 3; *across box col;
if indexc(char_guess(v,2,x,y),put(u,1.)) then do;
if indexc(store_row2,put(x,1.))<1 then do;
store_row2=strip(store_row2)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------------------;
* create list of rows in 3rd box of current row containing digit u;
*-----------------------------------------------------------------;
length store_row3 $3;
store_row3='';
do x=1 to 3; *down box row ;
do y=1 to 3; *across box col;
if indexc(char_guess(v,3,x,y),put(u,1.)) then do;
if indexc(store_row3,put(x,1.))<1 then do;
store_row3=strip(store_row3)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*---------------------------------------------------;
* if 2 boxes uses same 2 rows for same digit ;
* remove that digit from those 2 rows of other box;
*---------------------------------------------------;
if length(store_row1)=2 and store_row1=store_row2 then do;
*----only remove digit if it exists------;
if indexc(store_row3,strip(store_row1))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_row1,put(x,1.))>0 then do;
if indexc(char_guess(v,3,x,y),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(v,3,x,y)
'because adjacent boxes require this row for this digit.';
char_guess(v,3,x,y)=compress(char_guess(v,3,x,y),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_row1=store_row2;
if length(store_row1)=2 and store_row1=store_row3 then do;
*----only remove digit if it exists------;
if indexc(store_row2,strip(store_row1))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_row1,put(x,1.))>0 then do;
if indexc(char_guess(v,2,x,y),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(v,2,x,y)
'because adjacent boxes require this row for this digit.';
char_guess(v,2,x,y)=compress(char_guess(v,2,x,y),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_row1=store_row3;
if length(store_row2)=2 and store_row2=store_row3 then do;
*----only remove digit if it exists------;
if indexc(store_row1,strip(store_row2))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_row2,put(x,1.))>0 then do;
if indexc(char_guess(v,1,x,y),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(v,1,x,y)
'because adjacent boxes require this row for this digit.';
char_guess(v,1,x,y)=compress(char_guess(v,1,x,y),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_row2=store_row3;
end; *v;
end; *u;
*----------------------------------------------------------------;
* columns ;
*----------------------------------------------------------------;
do u=1 to 9;
do w=1 to 3; *accross puzzle columns;
*-----------------------------------------------------------------;
* create list of rows in 1st box of current row containing digit u;
*-----------------------------------------------------------------;
length store_col1 $3;
store_col1='';
do x=1 to 3; *across box col;
do y=1 to 3; *down box row ;
if indexc(char_guess(1,w,y,x) ,put(u,1.)) then do;
if indexc(store_col1,put(x,1.))<1 then do;
store_col1=strip(store_col1)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------------------;
* create list of rows in 2nd box of current row containing digit u;
*-----------------------------------------------------------------;
length store_col2 $3;
store_col2='';
do x=1 to 3; *across box col;
do y=1 to 3; *down box row ;
if indexc(char_guess(2,w,y,x),put(u,1.)) then do;
if indexc(store_col2,put(x,1.))<1 then do;
store_col2=strip(store_col2)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*-----------------------------------------------------------------;
* create list of rows in 3rd box of current row containing digit u;
*-----------------------------------------------------------------;
length store_col3 $3;
store_col3='';
do x=1 to 3; *across box col;
do y=1 to 3; *down box row ;
if indexc(char_guess(3,w,y,x),put(u,1.)) then do;
if indexc(store_col3,put(x,1.))<1 then do;
store_col3=strip(store_col3)|| put(x,1.);
end;
end;
end; *y;
end; *x;
*---------------------------------------------------;
* if 2 boxes uses same 2 rows for same digit ;
* remove that digit from those 2 rows of other box;
*---------------------------------------------------;
if length(store_col1)=2 and store_col1=store_col2 then do;
*----only remove digit if it exists------;
if indexc(store_col3,strip(store_col1))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_col1,put(x,1.))>0 then do;
if indexc(char_guess(3,w,y,x),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(3,w,y,x)
'because adjacent boxes require this row for this digit.';
char_guess(3,w,y,x)=compress(char_guess(3,w,y,x),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_col1=store_col2;
if length(store_col1)=2 and store_col1=store_col3 then do;
*----only remove digit if it exists------;
if indexc(store_col2,strip(store_col1))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_col1,put(x,1.))>0 then do;
if indexc(char_guess(2,w,y,x),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(2,w,y,x)
'because adjacent boxes require this row for this digit.';
char_guess(2,w,y,x)=compress(char_guess(2,w,y,x),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_col1=store_col3;
if length(store_col2)=2 and store_col2=store_col3 then do;
*----only remove digit if it exists------;
if indexc(store_col1,strip(store_col2))>0 then do;
do x=1 to 3;
do y=1 to 3;
if indexc(store_col2,put(x,1.))>0 then do;
if indexc(char_guess(1,w,y,x),put(u,1.))>0 then do;
put u= 'Removed from ' char_guess(1,w,y,x)
'because adjacent boxes require this row for this digit.';
char_guess(1,w,y,x)=compress(char_guess(1,w,y,x),put(u,1.));
updated=1;
end;
end;
end; *y;
end;*x;
end;
end; *store_col2=store_col3;
end; *w;
end; *u;
put updated=;
if updated>0 then GOTO MAINLOOP;
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
* Check if a solution was found ;
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++;
if solved=. then solved=0; *binary variable to track if the puzzle is solved.;
do i=1 to 3;
do j=1 to 3;
do k= 1 to 3;
do l = 1 to 3;
if boxrowcol(i,j,k,l) = . then do;
if tryNum=. then tryNum=1;
else tryNum+1;
solved=0;
put 'A Solution Has Yet to be found ' trynum= boxRowCol(i,j,k,l)=;
*---set exit condition for loop sequence-----;
i=3; j=3; k=3; l=3;
end;
else solved=1;
end;
end;
end;
end;
put solved= tryNum=;
if solved=0 then do;
put solved=;
*----------------------------------------------------------------;
* This is a super-hard puzzle. (Much harder than printed in ;
* in newspapers and puzzle books.) ;
* Trial and er ror will now be used to determine if a unique ;
* solution exists. (It is possible that the puzzle has more ;
* than one solution, or that the puzzle has no solution at ;
* all.) If a unique solution is not found print the known ;
* information and ask the user to check the input values. ;
*----------------------------------------------------------------;
*------arrays used to store matrix of tried values ;
array store_guess(45,3,3,3,3) $9;
array store_boxRowCol(45,3,3,3,3) 3;
*----------note: in 45 tries this program will fill a completely----------;
*----------empty input matrix with consistant values----------------------;
*----------i do not forsee a worse case than this-------------------------;
if trynum>45 then do;
put / ;
put '*********************************************************************************************';
put 'ER' 'ROR: No solution was found. There is either a flaw in the program logic, or the ';
put ' ' ' input matrix contains a contradiction(s).';
put '*********************************************************************************************';
%printmatrix;
stop;
end;
*----------------------------------------------------------------;
* If previous guess was made, check if it caused ;
* inconsistant results. If so, remove that guess from possible;
* values for that cell and try again. ;
*----------------------------------------------------------------;
inconsistant=0;
do i=1 to 3;
do j=1 to 3;
do k= 1 to 3;
do l = 1 to 3;
if boxRowCol(i,j,k,l)=. and char_guess(i,j,k,l)=' ' then do;
inconsistant=1;
end;
end; *l;
end; *k;
end; *j;
end; *i;
if tryNum=1 and inconsistant=1 then do;
put / ;
put '*********************************************************************************************';
put 'ER' 'ROR: The input table contains inconsistant values. This puzzle has no solution.';
put ' ' ' Check the input matrix and try again.';
put '*********************************************************************************************';
%printmatrix;
stop;
end;
if inconsistant=1 then do;
length RemovedBadValue 3.;
RemovedBadValue=0;
do i=1 to 3;
do j=1 to 3;
do k= 1 to 3;
do l = 1 to 3;
*----last guess made puzzle unsolvable-----------;
*------undo last guess---------------------------;
boxRowCol(i,j,k,l)=store_boxRowCol((tryNum-1),i,j,k,l);
char_guess(i,j,k,l)=store_guess((tryNum-1),i,j,k,l);
if boxrowcol(i,j,k,l) = . and RemovedBadValue=0 then do;
*----removing the value that proved inconsistant-;
*----from the list of possible values for that cell;
badvalue=substr(left(char_guess(i,j,k,l)),1,1);
put 'Bad Value of ' badvalue ' removed from ' char_guess(i,j,k,l) =
' because it is inconsistant with the other table cells. ';
store_guess(tryNum,i,j,k,l)=substr(left(char_guess(i,j,k,l)),2);
char_guess(i,j,k,l)=substr(left(char_guess(i,j,k,l)),2);
RemovedBadValue=1;
if length(char_guess(i,j,k,l))=1 then do;
put;
put 'Cell set to only remaining possible value ' char_guess(i,j,k,l)= ;
put;
end;
end;
*put boxrowcol(i,j,k,l)= char_guess(i,j,k,l)=;
end; *l;
end; *k;
end; *j;
end; *i;
end; *inconsistant=1;
*----------------------------------------------------------------;
* store current matrix so we can revert to it later if geuss ;
* proves bad ;
*----------------------------------------------------------------;
do i=1 to 3;
do j=1 to 3;
do k= 1 to 3;
do l = 1 to 3;
store_boxRowCol(tryNum,i,j,k,l)= boxRowCol(i,j,k,l);
store_guess(tryNum,i,j,k,l) =char_guess(i,j,k,l);
end; *l;
end; *k;
end; *j;
end; *i;
*----------------------------------------------------------------;
* assign guess from possible values for first cell with ;
* value not yet known for certain ;
*----------------------------------------------------------------;
do i=1 to 3;
do j=1 to 3;
do k= 1 to 3;
do l = 1 to 3;
store_boxRowCol(tryNum,i,j,k,l)= boxRowCol(i,j,k,l);
store_guess(tryNum,i,j,k,l) =char_guess(i,j,k,l);
if boxrowcol(i,j,k,l) = . then do;
%printmatrix;
guess_len=length(char_guess(i,j,k,l));
boxRowCol(i,j,k,l)=input(substr(left(char_guess(i,j,k,l)),1,1),3.);
if length(char_guess(i,j,k,l))>1 then do;
put;
put 'Trial and Er' 'ror, Trying value ' boxRowCol(i,j,k,l)=
'of possible values ' char_guess(i,j,k,l)=;
put;
end;
lastGuessValue=boxRowCol(i,j,k,l);
char_guess(i,j,k,l)='';
GOTO MAINLOOP;
end;
end; *l;
end; *k;
end; *j;
end; *i;
end; *solved;
if solved=1 and tryNum>0 then do;
put /;
put '**********************************************************************************************';
put '* NOTE: Multiple solutions may exist for this puzzle. Only one solution is shown. *';
put '**********************************************************************************************';
end;
if solved=1 and tryNum=0 then do;
put /;
put '**********************************************************************************************';
put '* NOTE: A unique solution was found. No other solutions exist for this puzzle. *';
put '**********************************************************************************************';
end;
%printmatrix;
run;
DECISION STATS 