User:Viktor Grigorov/sudoku
I wanted to create an arbitrary length, square sudoku solver in J, shaping the grid to 4 dimensions, hoping to make use of sudoku symmetries, or something. I began working on the problem months ago, but progress has been slow because of my unwillingness to be explicit, to debug, to use any help, and very often because of an ASCII character too little or too much. Although I very, very lately read Roger Hui's article on the topic, the Wikipedia pages on sudoku solvers and math, and Knuth's dancing links and general backtracking algorithms, begin a non-programmer, I still went with my interal logic for how it should be solved. My local copy contains <20 lines of not commented out code, with most everything else being minute variations on the same thing, but for visual clarity only current working permutation will be presented.
Using Hui's as a benchmark, and 2 easy and 2 very hard 9x9 sudokus, mine uses 1–5 times the space, and 1e1–1e2 times the time for solving. So, much can be improved, but at least it is working consistently. Solving happens thusly:
if empty (0)
amend with the intersection of the missing numbers of its frc
renew possibilities
until convergence
if possibilities
if cell has 1 unique possibility (its frc's possibilities with itself once removed, e.g., if a cell can be 1 2 3 4 5, and there are 3 empty cells in its frc: (1 2 3), (1 2 3), (2 3 4), 5 is only possibly in current cell)
amend to remove that value from its frc, and amend to add the value to the cell
else
(possibly renew possibilities, not sure) amend with intersection of missing numbers of its frc
is=:([-.-.) NB. intersection
c=:{{)m NB. creates verbs and nouns for square, y by y sudokus
assert.*./((>.=<.),(1&<),(''-:$),(_&~:))y NB. integer, greater 1, scalar, finite
a=:(2#y^2)$, NB. presentation verb
mn=:((>:i.y^2)&-.@;)"2)@:(((1=#@>)"0#])"1 NB. missing numbers of <"0 boxed slices
Q=:i.y NB. auxiliary noun
frc=:3 :'((q;Q;e;Q),(q;w;Q;Q),:(Q;Q;e;r))"_''q w e r''=.y' NB. get a cell's corresponding face's, row;s, and column's indicies, boxed, in 3 4 shape
i=:~.(4([{."_1]A.~#@:]([(]*i.@:%)&!-)[)(;/4&#Q)) NB. hypercube indices using https://code.jsoftware.com/wiki/Phrases/Sets
solv=:3 :'it^:_@rg@rz y' NB. solution verb
rz=:3 :'for_q.i do.if.0=>(<q){y do.y=.(<is/(mn(<"1 frc q){y))(<q)}y end.end.' NB. replace all 0s with could-be numbers
rg=:{{ NB. renew a grid's could-be numbers, recurses once for each exact solution
if.((*/@$)-:(+/@#@;))y do.y return.end.
for_q.i do.
if.1<#>(<q){y do.
e=.is/(mn(<"1 frc q){y)
if.1=#e do.y=.rg(<e)(<q)}y else.y=.(<e)(<q)}y
end.end.end.}}
it=:{{)m NB. iterate verb
if.((*/@$)-:(+/@#@;))y do.y return.end.
for_q.i do.NB. all
if.1<#w=.>(<q){y do.
if.1=#e=.,(>)`((is&(,@;))/)@.(1<#) ([:(a:&~:#])<"1@(w(-.@([e.])#[)w((-.@((i.@#@])e.(([(=i.1:)])"0 1)))#])])@;@((1<#@>)#])@:,"2@((F=.<"1 frc q){]))y do.
y=.rg(<e)(<q)}((-.&e&.>)F{y)F}y NB. fixme exclude solved cell from fcr to forgo 2. amend?
else.
if.1=#e=.is/(mn F{y)do.y=.rg(<e)(<q)}((-.&e&.>)F{y)F}y elseif.1<#e do.y=.rg(<e)(<q)}y end.
end.end.end.}}
''}}
c 3
qu =:<"0(3 3 3 3$QU =:5 1 0 4 0 0 0 3 0 0 7 0 0 0 0 0 0 6 0 0 8 0 0 0 0 0 0 0 0 0 7 4 8 0 0 0 0 3 0 5 0 0 0 6 0 0 5 0 0 2 0 0 0 8 0 0 6 1 0 0 7 0 4 0 0 9 0 0 3 0 0 1 0 0 0 0 0 0 0 0 0)
qs =:<"0(3 3 3 3$QS =:5 1 2 4 6 7 8 3 9 4 7 3 9 8 5 2 1 6 6 9 8 2 3 1 5 4 7 2 6 1 7 4 8 3 9 5 8 3 7 5 1 9 4 6 2 9 5 4 3 2 6 1 7 8 3 8 6 1 9 2 7 5 4 7 4 9 8 5 3 6 2 1 1 2 5 6 7 4 9 8 3)
a solv qu
NB. compare solv and Hui's sudoku verb, assuming you have it loaded
(<('rel.timespace';(<(%/"1&.|:)((10 timespacex 'solv qu'),:(10 timespacex 'sudoku QU')))),:('overlap';81%~+/;zzz)),(<zzz=:(z(=&.>)zz)),(<zz=:<"0(9 9$QS)),(<z=:9 9 $,solv qu)
NB. compare solv's solution to the solution
(<zc=:(zs(+./@:=&.>)zu)),(<zs=:a qs),(<zu=:a solv qu)