SAS Fun: Sudoko

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;

Author: Ajay Ohri

http://about.me/ajayohri

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s