Sudoku solver

Anyone here written a Sudoku solver? I am thinking about adding GUI for my Sudoku solver. It would be interesting to see what ideas other people used for their Sudoku solvers.

My Sudoku solver is simple back tracking solver. I use bit presentation for numbers, so I can use bitwise operations to find possible candidates for a cell. I also use some simple binary “tricks”. It currently always selects the next empty cell to fill. I think it could be made faster by first selecting “singles” and “hidden singles” but that would require more book keeping. I also always validate Sudoku to make sure it’s correctly filled, so that takes a little extra time.

\
\  Simple backtracking Sudoku solver for the 8th programming language
\

\ Sub window for the given 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?

\ Sub window 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?

[
  [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?

[
  [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?

: 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
( swap a:_@ ) curry: posbit?

: search  \ n -- n n | n null
  dup trailing-zero-bits dup 8 n:> if
    drop null
  then ;

: b-xor  \ n n -- n
  n:bxor 511 n:band ;

: b-not  \ n n -- n
  n:bnot 511 n:band ;

: b-any  \ a -- n
  ' n:bor 0 a:reduce ;

a:new 0 args "Give Sudoku text file as param" thrownull
f:slurp "Cannot read file" thrownull >s "" s:/ ( "\n" s:= not ) a:filter
' >n a:map ( posbit? "Bad data" thrownull a:push ) a:each! drop constant board

: display-grid
  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 b-not ;

\ If found:     -- n T
\ If not found: -- F
: find-free-cell
  false board
  ( !if
      nip true break
    else
      drop
    then ) a:each drop ;

: validate \ -- T
  true board
  ( dup -rot a:@ swap 2 pick 0 a:! 2 pick candidates? 2 pick n:= if
      -rot a:!
    else
      3drop false swap break
    then ) 0 80 loop drop ;

: solve  \ -- T
  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
          b-xor 2 a:close
          history swap a:push drop
          break
        then
      again
    else
      validate break
    then
  again ;

: app:main
  "Sudoku puzzle:\n" .
  display-grid cr
  solve if
    "Sudoku solved:\n" .
    display-grid
  else
    "No solution!\n" .
  then ;

Simple Sudokus are solved instantly and very hard Sudokus take less than second to solve on my Raspberry Pi 4B.

ohjaus@raspberrypi:~ $ time /opt/8th/bin/rpi64/8th sudoku.8th puz.txt
Sudoku puzzle:
+-----+-----+-----+
|8 0 0|0 0 0|0 0 0|
|0 0 3|6 0 0|0 0 0|
|0 7 0|0 9 0|2 0 0|
+-----+-----+-----+
|0 5 0|0 0 7|0 0 0|
|0 0 0|0 4 5|7 0 0|
|0 0 0|1 0 0|0 3 0|
+-----+-----+-----+
|0 0 1|0 0 0|0 6 8|
|0 0 8|5 0 0|0 1 0|
|0 9 0|0 0 0|4 0 0|
+-----+-----+-----+

Sudoku solved:
+-----+-----+-----+
|8 1 2|7 5 3|6 4 9|
|9 4 3|6 8 2|1 7 5|
|6 7 5|4 9 1|2 8 3|
+-----+-----+-----+
|1 5 4|2 3 7|8 9 6|
|3 6 9|8 4 5|7 2 1|
|2 8 7|1 6 9|5 3 4|
+-----+-----+-----+
|5 2 1|9 7 4|3 6 8|
|4 3 8|5 2 6|9 1 7|
|7 9 6|3 1 8|4 5 2|
+-----+-----+-----+

real	0m0.657s
user	0m0.644s
sys	0m0.013s
1 Like

@jalih, I am really enjoying your 8th examples. Perhaps you should ask @npalardy to setup a channel (like they have for PHP, Java etc) for 4th|8th coding examples. That way your code shares become a more valuable reference to anyone interested in the language. What I enjoy about if not nil is the breadth and depth of the community’s programming experience. Nice one.

Kind regards, Andrew

@dickey Confused.... a) I can't set up channels here and b) why? I have no interest in 4th or 8th

@DaveS, apologies Dave, I mistakenly thought you were one of the site admins/moderators. I have edited my original post to alert Norman.

Nope, am not now,nor have I ever been