Sudoku Solver in DATA Step

From sasCommunity

This solver was not presented at SGF 2007.

The code solves the puzzle using the process of elimination. It will halt if a guess is needed.

[edit] SAS Code

/* Richard A. DeVenezia
 * Sudoku solver
 * April 20, 2007
 */

data solution (keep=id puzzlestring s1-s81);

  set sasuser.sudokus;
  where id = 7;

/*
 * A [ d, r, c ] - Available candidate items
 * N [    r, c ] - Number of available candidates
 * S [    r, c ] - Placed items
 * M - relative offsets for other cells in block 
 */

  array A[9,9,9] a1-a729 (81*1,81*2,81*3,81*4,81*5,81*6,81*7,81*8,81*9);
  array N[9,9]   n1-n81  (81*9);
  array S[9,9]   s1-s81  (81*.);
  array M[0:2,2] _temporary_ (-2,-1,+1,+2,-1,+1);
 
  * validate puzzle;

  index = 0;
  do r = 1 to 9;
  do c = 1 to 9;
    index + 1;
    length vc $1;
    vc = substr(puzzleString,index);
    if verify (vc,'123456789') then continue;
    vn = input (vc,1.);
    row = r;
    col = c;
    digit = vn;
    link SetCell;
    if status = -1 then do;
      put "Invalid puzzle string detected at " row= col= digit=;
      link renderPuzzleString;
      stop;
    end;
  end;
  end;

  * report puzzle to log;

  put 'Initial conditions:';
  put (s[*]) (9*3. /) /;

  * elimination core;

  do until (status < 0);
    status = -2;
    max = 0;
    min = 10;
    do row = 1 to 9 while (status = -2);
    do col = 1 to 9 while (status = -2);
      remain = N [ row, col ]; 
      if remain = 1 then do;
        do digit = 1 to 9;
          if A [ digit, row, col ] eq . then continue;
          link SetCell;
          leave;
        end;
      end;
      else do;
        max = max (max, N [ row, col ]);
        if 0 < remain < min then min = remain;
      end;
    end;
    end;
  end;

  * when core is done the puzzle is finished or a guess is needed;

  if status = -2 and max = 0 then do;
    put / 'Solution:';
    put (n[*]) (9*3. /) /;
    put (s[*]) (9*3. /);
  end;
  else do;
    put 'Solution indeterminate, guessing is required';
    put 'Determined cells exhausted at ' setcount=;
*   put (a[*]) (9*3. /) /;
    put (n[*]) (9*3. /) /;
    put (s[*]) (9*3. /);
  end;

  output;

  stop;
return;

SetCell:
* put digit= row= col= n[row,col]=;

  status = -1;

  if A [ digit, row, col ] = . then return;

  setcount + 1;

  * clear cell possibilities;
  do _d = 1 to 9;
    if A [ _d, row, col ] = . then continue;
    A [ _d, row, col ] = .;
    N [     row, col ] + (-1);
  end;

  * clear row possibilities;
  do _c = 1 to 9;
    if A [ digit, row, _c ] = . then continue;
    if N [ row, _c ] = 1 and S [ row, _c ] = . then do;
      put "Invalid elimination: " digit= row= col= _c=;
      put (a[*]) (9*3. /) /;
      stop;
    end;

    A [ digit, row, _c ] = .;
    N [        row, _c ] + (-1);
  end;

  * clear col possibilities;
  do _r = 1 to 9;
    if A [ digit, _r, col ] = . then continue;
    if N [ _r, col ] = 1 and S [ _r, col ] = . then do;
      put "Invalid elimination: " digit= row= col= _r=;
      put (a[*]) (9*3. /) /;
      stop;
    end;

    A [ digit, _r, col ] = .;
    N [        _r, col ] + (-1);
  end;

  * clear block possibilities;
  _rm = mod (row,3);
  _cm = mod (col,3);

  do _ro = M[_rm,1] , M[_rm,2]; _r = row + _ro;
  do _co = M[_cm,1] , M[_cm,2]; _c = col + _co;
    if A [ digit, _r, _c ] = . then continue;
    if N [ _r, _c ] = 1 and S [ _r, _c ] = . then do;
      put "Invalid elimination: " digit= row= col= _r= _c=;
      put (a[*]) (9*3. /) /;
      stop;
    end;

    A [ digit, _r, _c ] = .;
    N [        _r, _c ] + (-1);
  end;
  end;

  * set cell;
  S [ row, col ] = digit;

  status = 0;
return;

renderPuzzleString:
  index = 0;
  do r = 1 to 9;  if mod(r,3)=1 then put;
  do c = 1 to 9;  if mod(c,3)=1 then put ' ' @;
    index + 1;
    length vc $1;
    vc = substr(puzzleString,index);
    put vc @;
  end; put;
  end; put;
return;

run;