RosettaCodeData/Task/Sudoku/PicoLisp/sudoku-1.l
Ingy döt Net 68f8f3e56b all tasks
2013-04-11 01:07:29 -07:00

82 lines
2 KiB
Text

(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) ) )
(main
(quote
(5 3 0 0 7 0 0 0 0)
(6 0 0 1 9 5 0 0 0)
(0 9 8 0 0 0 0 6 0)
(8 0 0 0 6 0 0 0 3)
(4 0 0 8 0 3 0 0 1)
(7 0 0 0 2 0 0 0 6)
(0 6 0 0 0 0 2 8 0)
(0 0 0 4 1 9 0 0 5)
(0 0 0 0 8 0 0 7 9) ) )