home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / xl21hos2.zip / QUEENS.LSP < prev    next >
Lisp/Scheme  |  1995-12-27  |  1KB  |  46 lines
  1. ;
  2. ; Place n queens on a board
  3. ;  See Winston and Horn Ch. 11
  4. ; 
  5. ; Usage:
  6. ;    (queens <n>)
  7. ;          where <n> is an integer -- the size of the board - try (queens 4)
  8.  
  9. ; Do two queens threaten each other ?
  10. (defun threat (i j a b)
  11.   (or (eql i a)            ;Same row
  12.       (eql j b)            ;Same column
  13.       (eql (- i j) (- a b))    ;One diag.
  14.       (eql (+ i j) (+ a b))))    ;the other diagonal
  15.  
  16. ; Is position (n,m) on the board not safe for a queen ?
  17. (defun conflict (n m board)
  18.   (cond ((null board) nil)
  19.     ((threat n m (caar board) (cadar board)) t)
  20.     (t (conflict n m (cdr board)))))
  21.  
  22.  
  23. ; Place queens on a board of size SIZE
  24. (defun queens (size)
  25.   (prog (board n m)
  26.     (setq board nil)
  27.     (setq n 1)            ;Try the first row
  28.     loop-n
  29.     (setq m 1)            ;Column 1
  30.     loop-m
  31.     (cond ((conflict n m board) (go un-do-m))) ;Check for conflict
  32.     (setq board (cons (list n m) board))       ; Add queen to board
  33.     (cond ((> (setq n (1+ n)) size)            ; Placed N queens ?
  34.            (print (reverse board))))           ; Print config
  35.     (go loop-n)                       ; Next row which column?
  36.     un-do-n
  37.     (cond ((null board) (return 'Done))        ; Tried all possibilities
  38.           (t (setq m (cadar board))           ; No, Undo last queen placed
  39.          (setq n (caar board))
  40.          (setq board (cdr board))))
  41.  
  42.     un-do-m
  43.     (cond ((> (setq m (1+ m)) size)          ; Go try next column
  44.            (go un-do-n))
  45.           (t (go loop-m)))))
  46.