/*
 * Sudoku solver for SAS DATA Step
 *
 * Richard A. DeVenezia
 * http://www.devenezia.com
 *
 */

data Puzzles (keep=id puzzleString);
  length puzzleString $81;
  input (part1-part10) ($CHAR9. /);
  if part10 ne '#' then do;
    put "ERROR: Check alignment";
    stop;
  end;
  id + 1;
  puzzleString =
     part1 || part2 || part3 
  || part4 || part5 || part6 
  || part7 || part8 || part9
  ;
datalines;
.........
.4.1.6.9.
.7.3.9.8.
.13...75.
7..5.1..8
5.......6
6.......1
.52...84.
3..9.2..5
#
.........
.4.1.6.9.
.7.3.9.8.
.13...75.
7..5.1..8
5.......6
6.......1
.52...84.
3..9.4..5
#
5....826.
.3....147
.....7.9.
...79....
6...8...4
..3....92
28.4...1.
.........
71..5.4..
#
123......
...12....
......12.
.12......
....12...
.......12
..12.....
.....12..
2.......1
#
.7...9...
539.7..2.
...2.3..4
..3....1.
.85.2...6
6..5...8.
1..9.4.3.
.5.....7.
..2.1....
#
.......12
....35...
...6...7.
7.....3..
...4..8..
1........
...12....
.8.....4.
.5....6..
#
run;

%let seed = 12345;

%macro swin;

  %local i x y row col;

  rows=21 columns=60
  %let i = 1;
  %do row = 1 %to 9;
  %do col = 1 %to 9;
    %let x = %eval ( ((&col-1)/3)*2 + &col );
    %let y = %eval ( ((&row-1)/3)*1 + &row );
    #(1+&y)@(2+&x) cell_&i 1. protect=yes
    %let i = %eval (&i+1);
  %end;
  %end;

  # 2@19 "Do what? " exit $1. attr=underline
  # 3@19 "@ step " step 12. attr=underline protect=yes
  # 5@19 "Do what commands" attr=underline
  # 6@19 "Space step"
  # 7@19 "- do 1E4 steps" 
  # 8@19 "= step to completion"
  # 9@19 "' show next 1E4 steps"
  #10@19 "+ show every step to completion"
  #11@19 "! show every 1E4th step to completion"
  #12@19 "x quit"
  #13@19 "F3 quit                           " attr=underline
  #14@19 "Press enter to perform command";
%mend;

data _null_ ;

  set puzzles;
  where id = 6;

  autoRunToCompletion = 0;

  length exit $1;
  length step 8;

  window sudoku %swin;

  *---------------------------------------------------------------;
  * Populate grid from puzzle string;
  *---------------------------------------------------------------;

  array grid [9,9] cell_1-cell_81;

  i = 0;
  do row = 1 to 9;
  do col = 1 to 9;
    i + 1;
    grid [ row, col ] = input (substr(puzzleString,i), 1.);
  end;
  end;

  *---------------------------------------------------------------;
  * Mapping support;
  *---------------------------------------------------------------;

  array blkOfCell  [9,9];

  do i = 1 to 9;
  do j = 1 to 9;
    blkOfCell [i,j] = 1 + 3 * floor ((i-1) / 3) 
                            + floor ((j-1) / 3);
  end;
  end;

  *---------------------------------------------------------------;
  * Validate the puzzle;
  *---------------------------------------------------------------;

  array entity [9,3] (27*0);

  do row = 1 to 9;
  do col = 1 to 9;
    value = grid [row,col];
    if value = . then CONTINUE;

    mask = BLSHIFT(1,value);

    if BAND(entity [row,1],mask) ne 0 then do;
      put 'ERROR: BOGUS puzzle row found @ ' row= col= value=;
      link updateViewer;
      stop;
    end;

    entity [row,1] = BOR (entity [row,1], mask);

    if BAND(entity [col,2],mask) ne 0 then do;
      put 'ERROR: BOGUS puzzle column found @ ' row= col= value=;
      link updateViewer;
      stop;
    end;

    entity [col,2] = BOR (entity [col,2], mask);

    block = blkOfCell[row,col];

    if BAND(entity [block,3],mask) ne 0 then do;
      put 'ERROR: BOGUS puzzle block found @ ' row= col= value=;
      link updateViewer;
      stop;
    end;

    entity [block,3] = BOR (entity [block,3], mask);
  end;
  end;

  *---------------------------------------------------------------;
  * Solver init;
  *---------------------------------------------------------------;

  array rowChoices [9,10];
  array colChoices [9,10];
  array blkChoices [9,10];

  array empty [81,2];

  do i = 1 to 9;
  do j = 1 to 9;
    rowChoices [i,j] = 1;
    colChoices [i,j] = 1;
    blkChoices [i,j] = 1;
  end;
  end;

  do row = 1 to 9;
  do col = 1 to 9;
    p = grid [ row, col ];

    if p then do;
      blk = blkOfCell [ row, col ];

      rowChoices [ row, p ] = .;
      colChoices [ col, p ] = .;
      blkChoices [ blk, p ] = .; 

      rowChoices [ row, 10 ] + 1;
      colChoices [ col, 10 ] + 1;
      blkChoices [ blk, 10 ] + 1;
    end;
  end;
  end;

link dumpGrid;

  *---------------------------------------------------------------;
  * select a path to walk amongst the empty cells;
  *---------------------------------------------------------------;

  link pathOfLeftToRightTopToBottom;
* link pathOfMostConstrainedFirst;

  *---------------------------------------------------------------;
  * Solver;
  *---------------------------------------------------------------;

  if autoRunToCompletion then do;
    put autoRunToCompletion= /;
    link dumpGrid;
  end;
  else
    link updateViewer;

  do until (index=.);

    if exit = "'" then 
    do stepi = 1 to 1e4 while (index ne .);
      link step;
      display sudoku noinput;
    end;
    else
    if exit = '+' then
    do until (index=.);
      link step;
      display sudoku noinput;
    end;
    else
    if exit = '!' then
    do until (index=.);
      do stepi = 1 to 1e4 while (index ne .);
        link step;
      end;
      display sudoku noinput;
    end;
    else
    if exit = '=' or autoRunToCompletion then
    do until (index=.);
      link step;
    end;
    else
    if exit = '-' then
    do stepi = 1 to 1e4;
      link step;
    end;
    else
      link step;

    if not autoRunToCompletion then
      link updateViewer;
  end;

  if autoRunToCompletion then do;
    put;
    link dumpGrid;
  end;

  STOP;

*---------------------------------------------------------------;
step:

  if index = . then return;

  if index = maxempty then do;
    put 'Done in ' step=;
    index = .;
    return;
  end;

  step + 1;

  *---------------------------------------------------------------;
  * goto the next candidate cell in the predetermined path;
  *---------------------------------------------------------------;

  index + 1;

  row = empty [ index, 1 ];
  col = empty [ index, 2 ];
  blk = blkOfCell[row,col];

  array last [9,9];

  *---------------------------------------------------------------;
  * try placing a digit until it fits;
  *---------------------------------------------------------------;

  do until
  (rowChoices[row,p] > 0 and
   colChoices[col,p] > 0 and
   blkChoices[blk,p] > 0
  );

    last[row,col]+1;

    p = last[row,col];

    if p > 9 then do;
      * dead end;

      last[row,col] = .;

      * back off and release;

      index + (-1);

      row = empty [ index, 1 ];
      col = empty [ index, 2 ];

      blk = blkOfCell[row,col];
      p = last[row,col];

      rowChoices[row,p] = +1;
      colChoices[col,p] = +1;
      blkChoices[blk,p] = +1;

      rowChoices[row,10] + (-1);
      colChoices[col,10] + (-1);
      blkChoices[blk,10] + (-1);

      grid[row,col] = .; * for cosmetic purposes when updateViewer called;

      index + (-1);
      return;
    end;
  end; * do until;

  * corral;

  rowChoices[row,p] = -1;
  colChoices[col,p] = -1;
  blkChoices[blk,p] = -1;

  rowChoices[row,10] + 1;
  colChoices[col,10] + 1;
  blkChoices[blk,10] + 1;

  grid[row,col] = p;


return; * step: ;

*---------------------------------------------------------------;
dumpGrid:
  do dumpRow = 1 to 9;
    do dumpCol = 1 to 9;
      dumpOffset = mod(dumpCol-1,3)=2;
      put grid[dumpRow,dumpCol] 1. +(dumpOffset) @;
    end;
    put;
    if mod(dumpRow-1,3)=2 then put;
  end;
return;

*---------------------------------------------------------------;
pathOfLeftToRightTopToBottom:
  i = 0;
  do row = 1 to 9;
  do col = 1 to 9;
    if grid[row,col] > 0 then CONTINUE;
    i + 1;
    empty[i,1] = row;
    empty[i,2] = col;
  end;
  end;

  maxempty = i;
return; * pathOfLeftToRightTopToBottom: ;


*---------------------------------------------------------------;
updateViewer:
  display sudoku ;
  if upcase(exit) = 'X' then stop;
return; * updateViewer: ;
run;