P97
(load "@lib/simul.l") ### Fields/Board ### # val lst (setq *Board (grid 9 9) *Fields (apply append *Board) ) # Init values to zero (empty) (for L *Board (for This L (=: val 0) ) ) # Build lookup lists (for (X . L) *Board (for (Y . This) L (=: lst (make (let A (* 3 (/ (dec X) 3)) (do 3 (inc 'A) (let B (* 3 (/ (dec Y) 3)) (do 3 (inc 'B) (unless (and (= A X) (= B Y)) (link (prop (get *Board A B) 'val) ) ) ) ) ) ) (for Dir '(`west `east `south `north) (for (This (Dir This) This (Dir This)) (unless (memq (:: val) (made)) (link (:: val)) ) ) ) ) ) ) ) # Cut connections (for display only) (for (X . L) *Board (for (Y . This) L (when (member X (3 6)) (con (car (val This))) ) (when (member Y (4 7)) (set (cdr (val This))) ) ) ) # Display board (de display () (disp *Board 0 '((This) (if (=0 (: val)) " " (pack " " (: val) " ") ) ) ) ) # Initialize board (de main (Lst) (for (Y . L) Lst (for (X . N) L (put *Board X (- 10 Y) 'val N) ) ) (display) ) # Find solution (de go () (unless (recur (*Fields) (with (car *Fields) (if (=0 (: val)) (loop (NIL (or (assoc (inc (:: val)) (: lst)) (recurse (cdr *Fields)) ) ) (T (= 9 (: val)) (=: val 0)) ) (recurse (cdr *Fields)) ) ) ) (display) ) ) ### Usage ### : (main (quote (0 0 4 8 0 0 0 1 7) (6 7 0 9 0 0 0 0 0) (5 0 8 0 3 0 0 0 4) (3 0 0 7 4 0 1 0 0) (0 6 9 0 0 0 7 8 0) (0 0 1 0 6 9 0 0 5) (1 0 0 0 8 0 3 0 6) (0 0 0 0 0 6 0 9 1) (2 4 0 0 0 1 5 0 0) ) ) +---+---+---+---+---+---+---+---+---+ 9 | 4 | 8 | 1 7 | + + + + + + + + + + 8 | 6 7 | 9 | | + + + + + + + + + + 7 | 5 8 | 3 | 4 | +---+---+---+---+---+---+---+---+---+ 6 | 3 | 7 4 | 1 | + + + + + + + + + + 5 | 6 9 | | 7 8 | + + + + + + + + + + 4 | 1 | 6 9 | 5 | +---+---+---+---+---+---+---+---+---+ 3 | 1 | 8 | 3 6 | + + + + + + + + + + 2 | | 6 | 9 1 | + + + + + + + + + + 1 | 2 4 | 1 | 5 | +---+---+---+---+---+---+---+---+---+ a b c d e f g h i -> NIL : (go) +---+---+---+---+---+---+---+---+---+ 9 | 9 3 4 | 8 2 5 | 6 1 7 | + + + + + + + + + + 8 | 6 7 2 | 9 1 4 | 8 5 3 | + + + + + + + + + + 7 | 5 1 8 | 6 3 7 | 9 2 4 | +---+---+---+---+---+---+---+---+---+ 6 | 3 2 5 | 7 4 8 | 1 6 9 | + + + + + + + + + + 5 | 4 6 9 | 1 5 3 | 7 8 2 | + + + + + + + + + + 4 | 7 8 1 | 2 6 9 | 4 3 5 | +---+---+---+---+---+---+---+---+---+ 3 | 1 9 7 | 5 8 2 | 3 4 6 | + + + + + + + + + + 2 | 8 5 3 | 4 7 6 | 2 9 1 | + + + + + + + + + + 1 | 2 4 6 | 3 9 1 | 5 7 8 | +---+---+---+---+---+---+---+---+---+ a b c d e f g h i -> NIL
http://picolisp.com/wiki/?99p97
10jul10 | abu |