Recursive Queries: Sudoku Solver

This Sudoku solver uses a number of recursive queries, first to generate fixed data structures and then to drive the search for a solution.

This solver simply applies the rules.

1. Every row, column and box (3×3) must have the digits 1 to 9 once and once only.
2. If only one digit can go in a cell then it must go there.
3. If a digit can go in only one place in a row, column or box then it must go there.

Here is the code.

First, the fixed data structures.

digits := {{ sdigit:= '1', ndigit := 1}} recurse( {{ sdigit:=text(ndigit+1), ndigit:=ndigit+1 }} [?(ndigit <= 9)] )
digitsx := digits union {{ sdigit := '.', ndigit := 0 }}
units := {{ index := 0, row := 0, col := 0, box := 0 }} recurse( 
        {{ index := index + 1, 
          row := (index + 1) div 9, 
          col := (index + 1) mod 9, 
          box := (index + 1) div 3 mod 3 + (index + 1) div 27 * 3 }} [?(index <= 80)] )
poss := units [{ index }] join digits [{ ndigit }]
possu := units join digits [{ ndigit }]

Now some useful functions.

showb(t:text) => do {
     seq(11)[{ N, line:=
         if(N mod 4 = 3,
            fill('-', 9),
            right(left(t, 9 + (N - N div 4) * 9), 9))}]
 }  
// Show a set of knowns. First fill out all index values, then convert to text
 showunk(k:poss) => do {
 t := (k union (units ajoin k)[{ index, ndigit := 0}]) join digitsx[{ ndigit, sdigit }]
 showb(t [$(index)][{ fold(&, sdigit) }])
}

The original raw data

inp := {{ sud := '53..7....6..195....98....6.8...6...34..8.3..17...2...6.6....28....419..5....8..79' }}
 //inp := {{ sud := '1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..' }}
 inp
 board := ((units join inp) [{ * sud, sdigit := right(left(sud, index + 1), 1) }] compose digitsx) [{ index, ndigit }]
 knowns := board [?( ndigit <> 0)]
 'Knowns=' & knowns.count
 showunk(knowns)

This the solver, which recurses as long as it can make progress. After this you have to guess.

solution := knowns recurse(
 do {
 // start with the 729 possiblities, progressively remove conflicts with knowns
 knownsu := knowns join units
 allowedu := possu ajoin knownsu[{ index }]
 ajoin knownsu[{ row, ndigit }]
 ajoin knownsu[{ col, ndigit }]
 ajoin knownsu[{ box, ndigit }]

// algorithm 1 - a cell with only one possible digit must be that digit
 new1 := allowedu [{ index, tot:=fold(+,1) }] [?(tot=1)] join allowedu

// algorithm 2 - a digit with only one place in a unit must go there
 new2a := allowedu [{ ndigit, row, tot:=fold(+,1) }] [?(tot=1)] join allowedu
 new2b := allowedu [{ ndigit, col, tot:=fold(+,1) }] [?(tot=1)] join allowedu
 new2c := allowedu [{ ndigit, box, tot:=fold(+,1) }] [?(tot=1)] join allowedu

 new1[{ index, ndigit }] union new2a union new2b union new2c
 }
)
showunk(solution)

And here is the grid, before and after solving.

N      | line
------------------
     0 | 53..7....
     1 | 6..195...
     2 | .98....6.
     3 | ---------
     4 | 8...6...3
     5 | 4..8.3..1
     6 | 7...2...6
     7 | ---------
     8 | .6....28.
     9 | ...419..5
    10 | ....8..79

N      | line
------------------
     0 | 534678912
     1 | 672195348
     2 | 198342567
     3 | ---------
     4 | 859761423
     5 | 426853791
     6 | 713924856
     7 | ---------
     8 | 961537284
     9 | 287419635
    10 | 345286179