1 ! Based on http://www.ffconsultancy.com/ocaml/sudoku/index.html
2 USING: sequences namespaces kernel math math.parser io
3 io.styles combinators columns ;
9 : pair+ swapd + >r + r> ;
13 : >board row set-nth ;
14 : f>board f -rot >board ;
16 : row-contains? ( n y -- ? ) row member? ;
17 : col-contains? ( n x -- ? ) board get swap <column> member? ;
18 : cell-contains? ( n x y i -- ? ) 3 /mod pair+ board> = ;
20 : box-contains? ( n x y -- ? )
22 9 [ >r 3dup r> cell-contains? ] contains?
28 [ >board ] 2keep [ >r 1+ r> search ] 2keep f>board ;
30 : attempt ( n x y -- )
32 { [ 3dup nip row-contains? ] [ 3drop ] }
33 { [ 3dup drop col-contains? ] [ 3drop ] }
34 { [ 3dup box-contains? ] [ 3drop ] }
38 : solve ( x y -- ) 9 [ 1+ 2over attempt ] each 2drop ;
41 standard-table-style [
58 solutions inc "Solution:" print board get board. ;
62 { [ over 9 = ] [ >r drop 0 r> 1+ search ] }
63 { [ over 0 = over 9 = and ] [ 2drop solution. ] }
64 { [ 2dup board> ] [ >r 1+ r> search ] }
70 "Puzzle:" print dup board.
73 [ clone ] map board set
77 solutions get number>string write " solutions." print