[Jprogramming] updated sudoku solver

[Roger Hui]

Extending my Sudoku solver using "non-guessing" methods
does not necessarily result in a better result.
(better = faster, shorter, easier to understand, etc.)  
Earlier Henry Rich posted a lengthy list of such methods.
After evaluating Henry's list I decided against changing
the solver that I had.



----- Original Message ----- 
From: "p j" <godspiral2000 at yahoo.ca>
To: <programming at jsoftware.com>
Sent: Monday, February 13, 2006 12:22 PM
Subject: [Jprogramming] updated sudoku solver

I've updated Roger Hui's sudoku solver.
The significant part I've added is an extra search
space reducer before the guessing part of the
algorithm kicks in.
The theoretical value of this step is that those
puzzles solvable through this search elimination
without guessing are those that would be classifiable
as intermediate to hard, but not extraordinarily hard.
Rogers' non-guessing part of the algorithm would only
solve puzzles I would classify as easy.  So the
function can be used to filter generated sudoku.

The extra search space refined by this algorithm are
patterns like the following (3 box horizontal patern):

1 0 0 9 2 0 0 0 0
5 2 4 0 1 7 0 0 9 
0 0 0 0 0 0 2 7 1
4 must be in upper left row (of 3), so cannot be in
upper middle row (of 3). 

Here's code, including ustility functions.  (a lot
borrowed from Roger Hui)

x2=: ];._2 noun define
043080250
600000000
000001094
900004070
000608000
010200003
820500000
000000005
034090710
)
fltr =: 1 : '(I. u. y.) { y.'
x2=: ,,. dig2list(x2)
t =: x2
dig2list =: ,. &.":"0

list2dig =: 10 p.~ |."1
grids =:  _9 {."_1 ((((0{$ grids) % 10), 10) $ grids)
NB. chop off game num, ravel into $ x 81
grids =: ,. &.":"1 ( ,. grids)

j      =. (]/. i.@#) ,{;~3#i.3
r      =. 9#i.9 9
c      =. 81$|:i.9 9
b      =. (,j{9#i.9) { j

I      =: ~."1 r,.c,.b NB. each row gives cells to
cross out when cell set.
R      =: j,(,|:)i.9 9

regions=: R"_ {"_ 1 ]
free   =: 0&= > (1+i.9)"_ e."1 I&{
free2 =: avecs@:free
ok     =: (27 9$1)"_ -:"2 (0&= +. ~:"1)@regions

ac     =: +/ .*&(1+i.9) * 1: = +/"1
NB. ac = ac1 * ac2
ac1 =: 1=(+/"1 ) NB.(+/"1 free t ) = 1 NB. count of
candidates for each slot.
ac2 =: +/ .*&(1+i.9)  NB.(free t)) NB. sum of all
candidates
ac3 =: 3 : '+/"1 (1+ i.9) *"1 y.' NB. free t NB. sum
of all candidates
NB. ac3 equiv to ac2.. made because (+/ . *) is voodoo



ar     =: 3 : 0
 m=. 1=+/"2 R{y. NB. 1or0 of 27 brc's with exactly 1
val open. 
 j=. I. +./"1 m  NB. ordinal value of brc from m. 1
for each found val.
 k=. 1 i."1~ j{m
 i=. ,(k{"_1 |:"2 (j{R){y.) #"1 j{R
 (1+k) i}81$0 NB.Output new cells
)
NB. R{y. selects (full) row number 81 9 $ from free t
for each 27 9 $ cell of R into a new rowof 9. +/"2
rolls up rows from $27 9 9 to $ 27 9
NB. j{m each brc taken"0 from m into $ each 9 shape of
0,1. k takes index# of 1s.
NB. j{R $ each 9 from brcs in R selected by j.
(j{R){y. makes an x 9 9 $ of 1,0. 
NB. |:"2 flips rows and columns within tables. k{
selects 1 row of 9 from each table(,$x 9).acts as 1/0
filter to only keep those j{R values allowed.

NB. 27 + 27 $ 3 vectors ; 54 $ 6 other elements in
same box ; 54 $ 6 elements to filter from other 2
boxes.
NB. if free only in $3, and not in same box, then
filter out of free implied adjacent box cells
Note 1
1 0 0 9 2 0 0 0 0
5 2 4 0 1 7 0 0 9 
0 0 0 0 0 0 2 7 1
4 must be in upper left row, so cannot be in upper
middle row.
)
b1b =: (3 3 3 $ (<"1(_3+\,((18+i.9){R))))
b1 =: > (,,.(,.(<"1 (_3+\ , 9{. R)),((, 0{"1 b1b), (,
1{"1 b1b) ,(, 2{"1 b1b)))) NB. 9{. R is idxs for 9
3x3boxes
b2=:  3# (,. 18 3 $  b1) NB. init full box to match
against
b2b=: ( 3 #(9{.R)) , ( 3 #(9{.R))
b2=:  ;"1 b2b -."1 b1
NB.b3b=: (9# 3 27$(,9{.R)), (27 27 $(,(3# 3 27$
,(18+i.9){R)))
b3b=: (27 9 $ ,( 3#( 3 27 $ ,((9+i.9) { R)))) , (27 9
$ ,((18+i.9) { R))
b3=: ;"1 b3b -."1 b1 NB.6 left to be crossed out if
matching b1.

boxed =:  b1 ; b2 ; b3 NB. scaffolding for avecs
function.
avecs=: 3 : 0 
 b1t=: +./"2 (b1) { y. NB.{ free t)
 b2t=: +./"2 (b2) { y.
 mp =: b1t *. (-.b2t)
 fltb =: (+/"1 mp > 0)# ]
 NB. for each cell in b3, t andnot mp
 (((fltb b3){ y.)>"_2 1 (fltb mp))(fltb b3)}y.
)
fullass =: (+ ((ac1*ac3) >. ar)@free2"1)^:_"1
assign =: (+ ((ac) >. ar)@free2)^:_"1

guessa =: 3 : 0
 if. -. 0 e. y. do. ,:y. return. end.
 b=. free y.
 i=. (i.<./) (+/"1 b){10,}.i.10
 y. +"1 (1+I.i{b)*/i=i.81
)

guess  =: ; @: (<@guessa"1)

Fullsudoku =: guess @: (ok # ]) @: fullass ^:_ @ ,"1

p96=: +/ list2dig( 3 {."1 Fullsudoku grids)

assign2 =: (+ ((ac) >. ar)@free)^:_"1
sudoku =: guess @: (ok # ]) @: assign ^:_ @ ,
see1   =: (;~9$1 0 0)&(<;.1) @ ({&'.123456789') @ (9
9&$) @ ,
see    =: <@see1"1`see1 at .(1:=#@$)
diff   =: * 0&=@}:@(0&,)
f=: (+ (ac >. ar)@free) 
f1=: + (ac1*ac3)@free
f2=:  (+ ar at free)