I rewrote my Sudoku solver. It's now twice as fast. There is still room for improvement...
\
\ Simple backtracking Sudoku solver for the 8th programming language
\
\ Sub-board window for the given board index
[ 00, 00, 00, 01, 01, 01, 02, 02, 02,
00, 00, 00, 01, 01, 01, 02, 02, 02,
00, 00, 00, 01, 01, 01, 02, 02, 02,
03, 03, 03, 04, 04, 04, 05, 05, 05,
03, 03, 03, 04, 04, 04, 05, 05, 05,
03, 03, 03, 04, 04, 04, 05, 05, 05,
06, 06, 06, 07, 07, 07, 08, 08, 08,
06, 06, 06, 07, 07, 07, 08, 08, 08,
06, 06, 06, 07, 07, 07, 08, 08, 08 ]
( swap a:_@ ) curry: window? \ n -- n
\ Sub-board indices for the given window
[
[00,01,02,09,10,11,18,19,20],
[03,04,05,12,13,14,21,22,23],
[06,07,08,15,16,17,24,25,26],
[27,28,29,36,37,38,45,46,47],
[30,31,32,39,40,41,48,49,50],
[33,34,35,42,43,44,51,52,53],
[54,55,56,63,64,65,72,73,74],
[57,58,59,66,67,68,75,76,77],
[60,61,62,69,70,71,78,79,80]
] ( swap a:_@ a:_@ ) curry: sub? \ a n -- a
[
[0,1,2,3,4,5,6,7,8],
[9,10,11,12,13,14,15,16,17],
[18,19,20,21,22,23,24,25,26],
[27,28,29,30,31,32,33,34,35],
[36,37,38,39,40,41,42,43,44],
[45,46,47,48,49,50,51,52,53],
[54,55,56,57,58,59,60,61,62],
[63,64,65,66,67,68,69,70,71],
[72,73,74,75,76,77,78,79,80]
] ( swap a:_@ a:_@ ) curry: row? \ a n -- a
[
[0,9,18,27,36,45,54,63],
[1,10,19,28,37,46,55,64,73],
[2,11,20,29,38,47,56,65,74],
[3,12,21,30,39,48,57,66,75],
[4,13,22,31,40,49,58,67,76],
[5,14,23,32,41,50,59,68,77],
[6,15,24,33,42,51,60,69,78],
[7,16,25,34,43,52,61,70,79],
[8,17,26,35,44,53,62,71,80]
] ( swap a:_@ a:_@ ) curry: col? \ a n -- a
: trailing-zero-bits \ n -- n
32 >r
dup n:neg n:band
dup if -1 n:r+ then
dup x0000ffff n:band if -16 n:r+ then
dup x00ff00ff n:band if -8 n:r+ then
dup x0f0f0f0f n:band if -4 n:r+ then
dup x33333333 n:band if -2 n:r+ then
x55555555 n:band if -1 n:r+ then
r> ;
\ Bit number presentations
a:new 0 a:push ( 1 swap n:shl a:push ) 0 8 loop constant posbit
: posbit? \ n -- n
posbit swap a:_@ ;
: search \ n -- n n | n null
dup trailing-zero-bits dup 8 n:> if
drop null
then ;
: bxor \ n n -- n
n:bxor 511 n:band ;
: bnot \ n n -- n
n:bnot 511 n:band ;
: b-any \ a -- n
' n:bor 0 posbit? a:reduce ;
a:new 0 args "Give Sudoku text file as param" thrownull
f:slurp "Cannot read file" thrownull >s "" s:/
' >n a:map ( posbit? "Bad data" thrownull a:push ) a:each! drop constant board
: display-board
board ( search nip -1 ?: n:1+ ) a:map
"+-----+-----+-----+\n"
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
s:strfmt . ;
\ Store move history
a:new constant history
\ Possible numbers for a cell
: candidates? \ n -- n
dup dup 9 n:/ n:int swap 9 n:mod \ row col
board swap col? b-any
board rot row? b-any
n:bor
board rot window? sub? b-any
n:bor
bnot ;
\ If found: -- n T
\ If not found: -- F
: find-free-cell
false board
( 0 posbit? n:= if
nip true break
else
drop
then ) a:each drop ;
: validate
true
board
( dup -rot a:@ swap 2 pick 0 posbit? a:! 2 pick candidates? 2 pick n:= if
-rot a:!
else
3drop
false swap
break
then ) 0 80 loop drop ;
: solve
repeat
find-free-cell if
dup candidates?
repeat
search null? if
drop board -rot a:! drop
history a:len !if
drop false ;;
then
a:pop nip
a:open
else
n:1+ posbit? dup
board 4 pick rot a:! drop
bxor
2 a:close
history swap a:push drop
break
then
again
else
validate break
then
again ;
: app:main
"Sudoku puzzle:\n" .
display-board cr
solve if
"Sudoku solved:\n" .
display-board
else
"No solution!\n" .
then ;
C:\temp>8th sudoku.8th puzzle.txt
Sudoku puzzle:
+-----+-----+-----+
|0 0 0|5 9 0|0 0 0|
|2 3 0|0 0 4|0 0 1|
|0 0 0|8 0 0|0 0 3|
+-----+-----+-----+
|0 0 2|0 0 0|0 0 0|
|0 5 0|0 0 2|0 0 6|
|4 1 6|7 0 0|0 8 0|
+-----+-----+-----+
|8 0 7|0 0 0|0 0 0|
|0 0 9|0 6 7|0 3 4|
|0 0 0|0 0 0|0 7 9|
+-----+-----+-----+
Sudoku solved:
+-----+-----+-----+
|1 7 4|5 9 3|2 6 8|
|2 3 8|6 7 4|5 9 1|
|6 9 5|8 2 1|7 4 3|
+-----+-----+-----+
|9 8 2|4 1 6|3 5 7|
|7 5 3|9 8 2|4 1 6|
|4 1 6|7 3 5|9 8 2|
+-----+-----+-----+
|8 6 7|3 4 9|1 2 5|
|5 2 9|1 6 7|8 3 4|
|3 4 1|2 5 8|6 7 9|
+-----+-----+-----+
C:\temp>
