home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 01e / lisp211.zip / QUEENS.L < prev    next >
Lisp/Scheme  |  1986-05-15  |  3KB  |  99 lines
  1.  
  2. ;
  3. ; Place n queens on a board (graphical version)
  4. ;  See Winston and Horn Ch. 11
  5. ; 
  6. ; Usage:
  7. ;       (queens <n>)
  8. ;          where <n> is an integer -- the size of the board - try (queens 4)
  9. ;
  10. ; I do not know who the original Author of this is but it was found with some
  11. ; XLISP example lisp programs. This has been slightly modified to run on   
  12. ; PC-LISP V2.11.
  13. ;
  14. ;               Peter Ashwood-Smith
  15. ;               May 15, 1986
  16.  
  17. ; Do two queens threaten each other ?
  18.  
  19. (defun threat (i j a b)
  20.   (or (= i a)                       ;Same row
  21.       (= j b)                       ;Same column
  22.       (= (- i j) (- a b))           ;One diag.
  23.       (= (+ i j) (+ a b))))         ;the other diagonal
  24.  
  25. ; Is poistion (n,m) on the board safe for a queen ?
  26.  
  27. (defun conflict (n m board)
  28.   (cond ((null board) nil)
  29.     ((threat n m (caar board) (cadar board)) t)
  30.     (t (conflict n m (cdr board)))))
  31.  
  32.  
  33. ; Place queens on a board of size SIZE
  34.  
  35. (defun queens (size)
  36.   (prog (n m board soln)
  37.     (setq soln 0)                   ;Solution #
  38.     (setq board ())
  39.     (setq n 1)                      ;Try the first row
  40.    loop-n     
  41.     (setq m 1)                      ;Column 1
  42.    loop-m     
  43.     (cond ((conflict n m board) (go un-do-m))) ;Check for conflict
  44.     (setq board (cons (list n m) board))       ; Add queen to board
  45.     (cond ((> (setq n (1+ n)) size)            ; Placed N queens ?
  46.            (print-board (reverse board) (setq soln (1+ soln))))) ; Print it
  47.     (go loop-n)                                ; Next row which column?
  48.    un-do-n     
  49.     (cond ((null board) (return 'Done)))       ; Tried all possibilities
  50.     (setq m (cadar board))                     ; No, Undo last queen placed
  51.     (setq n (caar board))
  52.     (setq board (cdr board))  
  53.    un-do-m
  54.     (cond ((> (setq m (1+ m)) size)          ; Go try next column
  55.            (go un-do-n))
  56.           (t (go loop-m)))))
  57.  
  58.  
  59. ;Print a board
  60.  
  61. (defun print-board  (board soln)
  62.   (prog (size)
  63.     (setq size (length board))            ;we can find our own size
  64.     (princ "\f\n\t\tSolution: ")
  65.     (princ soln)
  66.     (princ "\n\n\t")
  67.     (print-header size 1)
  68.     (princ "\n")
  69.     (print-board-aux board size 1)
  70.     (princ "\n")
  71.   )
  72. )
  73.  
  74. ; Put Column #'s on top
  75.  
  76. (defun print-header (size n)
  77.   (cond ((> n size) (princ "\n"))
  78.     (t (prog () (patom n)
  79.             (princ " ") 
  80.             (print-header size (1+ n))))))
  81.  
  82. (defun print-board-aux (board size row)
  83.   (princ "\n")
  84.   (cond ((null board) ())
  85.     (t (prog () 
  86.          (princ row)                  ;print the row #
  87.          (princ "\t")
  88.          (print-board-row (cadar board) size 1) ;Print the row
  89.          (print-board-aux (cdr board) size (1+ row))))))  ;Next row
  90.  
  91. (defun print-board-row (column size n)
  92.   (cond ((> n size)())
  93.     (t (prog () 
  94.           (cond ((equal column n) (princ "Q"))
  95.             (t (princ ".")))
  96.           (princ " ") 
  97.           (print-board-row column size (1+ n))))))
  98.  
  99.