sudoku.l (1821B)
1 # 10jul10abu 2 # (c) Software Lab. Alexander Burger 3 4 (load "@lib/simul.l") 5 6 ### Fields/Board ### 7 # val lst 8 9 (setq 10 *Board (grid 9 9) 11 *Fields (apply append *Board) ) 12 13 # Init values to zero (empty) 14 (for L *Board 15 (for This L 16 (=: val 0) ) ) 17 18 # Build lookup lists 19 (for (X . L) *Board 20 (for (Y . This) L 21 (=: lst 22 (make 23 (let A (* 3 (/ (dec X) 3)) 24 (do 3 25 (inc 'A) 26 (let B (* 3 (/ (dec Y) 3)) 27 (do 3 28 (inc 'B) 29 (unless (and (= A X) (= B Y)) 30 (link 31 (prop (get *Board A B) 'val) ) ) ) ) ) ) 32 (for Dir '(`west `east `south `north) 33 (for (This (Dir This) This (Dir This)) 34 (unless (memq (:: val) (made)) 35 (link (:: val)) ) ) ) ) ) ) ) 36 37 # Cut connections (for display only) 38 (for (X . L) *Board 39 (for (Y . This) L 40 (when (member X (3 6)) 41 (con (car (val This))) ) 42 (when (member Y (4 7)) 43 (set (cdr (val This))) ) ) ) 44 45 # Display board 46 (de display () 47 (disp *Board 0 48 '((This) 49 (if (=0 (: val)) 50 " " 51 (pack " " (: val) " ") ) ) ) ) 52 53 # Initialize board 54 (de main (Lst) 55 (for (Y . L) Lst 56 (for (X . N) L 57 (put *Board X (- 10 Y) 'val N) ) ) 58 (display) ) 59 60 # Find solution 61 (de go () 62 (unless 63 (recur (*Fields) 64 (with (car *Fields) 65 (if (=0 (: val)) 66 (loop 67 (NIL 68 (or 69 (assoc (inc (:: val)) (: lst)) 70 (recurse (cdr *Fields)) ) ) 71 (T (= 9 (: val)) (=: val 0)) ) 72 (recurse (cdr *Fields)) ) ) ) 73 (display) ) ) 74 75 # vi:et:ts=3:sw=3