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