/* * Sudoku solver for SAS DATA Step * * Richard A. DeVenezia * http://www.devenezia.com * * Original version posted to SAS-L on May 19, 2006 * * Mod * 25MAY2006 RAD * Block states maintained in array blkChoices * One cell remains look ahead verification also performed on blocks */ 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; maxempty = 9*9; do row = 1 to 9; do col = 1 to 9; p = grid [ row, col ]; if p then do; maxempty + (-1); 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; *---------------------------------------------------------------; * 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 = maxempty then do; put 'Done in ' step= comma15. checks= comma15.; link DumpGrid; 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 ); checks + 1; 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; * onesy look ahead; if rowChoices[row,10] = 8 then do; * one spot left in row, check for conflict in column or block; n = 0; c = 0; do i = 1 to 9 until (n and c); if grid[row,i] < 1 then c = i; * find column of onesy; if rowChoices[row,i] > 0 then n = i; * find value of onesy; end; b = blkOfCell[row,c]; if (colChoices[c,n] < 0) or (blkChoices[b,n] < 0) then do; * put grid[row,col]= 'failed due to' colChoices[c,n]= ' or ' blkChoices[b,n]=; link release; return; end; end; * onesy look ahead; if colChoices[col,10] = 8 then do; * one spot left in col, check for conflict in row; n = 0; r = 0; do i = 1 to 9 until (n and r); if grid[i,col] < 1 then r = i; * find row of onesy; if colChoices[col,i] > 0 then n = i; * find value of onesy; end; b = blkOfCell[r,col]; if (rowChoices[r,n] < 0) or (blkChoices[b,n] < 0) then do; * put grid[row,col]= 'failed due to' rowChoices[r,n]= ' or ' blkChoices[b,n]=; link release; return; end; end; * onesy look ahead; if blkChoices[blk,10] = 8 then do; * one spot left in blk, check for conflict in row or col; b = blkOfCell[row,col]; n = 0; r = 0; c = 0; i0 = floor((row-1)/3)*3 + 1; j0 = floor((col-1)/3)*3 + 1; k = 0; do i = i0 to i0+2 until (n and r); do j = j0 to j0+2 until (n and c); if grid[i,j] < 1 then do; * find row and column of onesy; r = i; c = j; end; k + 1; if blkChoices[b,k] > 0 then n = k; * find value of onesy; end; end; if (rowChoices[r,n] < 0) or (colChoices[c,n] < 0) then do; * put grid[row,col]= 'failed due to' rowChoices[r,n]= ' or ' colChoices[c,n]=; link release; return; end; end; return; release: rowChoices[row,p] = -rowChoices[row,p]; colChoices[col,p] = -colChoices[col,p]; blkChoices[blk,p] = -blkChoices[blk,p]; rowChoices[row,10] + (-1); colChoices[col,10] + (-1); blkChoices[blk,10] + (-1); grid[row,col] = .; index + (-1); return; 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; return; */ pathOfMostConstrainedFirst: * this path will fill in the most constrained rows and columns first; * it could be improved by changing the order in which the * elements of a row or column are pursued. Any attempts * to delve ahead further than one step ahead constraint wise * would require recursion which would make the data step * code even more unintelligible; i = 0; do while (1); link pickMostConstrained; if pick = 0 then LEAVE; if pick > 9 then do; col = pick - 9; do row = 1 to 9; if grid[row,col] = . then do; grid[row,col] = 0; i + 1; empty[i,1] = row; empty[i,2] = col; end; end; end; else do; row = pick; do col = 1 to 9; if grid[row,col] = . then do; grid[row,col] = 0; i + 1; empty[i,1] = row; empty[i,2] = col; end; end; end; * link dumpGrid; * put 35*'-'/; end; pickMostConstrained: array filled [18]; do ix = 1 to 18; if filled[ix] ne -1 then filled[ix]=0; end; max = 0; * link dumpGrid; do row = 1 to 9; do col = 1 to 9; if grid[row,col] = . then CONTINUE; if filled[row+00] ne -1 then filled[row+00] + 1; if filled[col+09] ne -1 then filled[col+09] + 1; newmax = max (max, filled[row+00], filled[col+09]); if newmax > max then do; max = newmax; maxCount = 0; end; if max = filled[row+00] then maxCount + 1; if max = filled[col+09] then maxCount + 1; end; end; pick = 0; if max = 0 then return; pick = 1 + floor(maxCount * ranuni(&seed)); count = 0; do ix = 1 to 18 until (count = pick); if filled[ix] = max then count + 1; end; pick = ix; * put filled[*] 3. +1 max= maxCount= pick=; filled [pick] = -1; return; updateViewer: display sudoku ; if upcase(exit) = 'X' then stop; return; run;