;;;=========================================================================
;;; Prints out a solution to the N-queens problem, for any N >= 4. A simple
;;; implementation of an algorithm from the SIGART bulletin, so feel free to
;;; do whatever you would like with this code.
;;;
;;; Invoke by calling (N-Queens <Board-Size>). Eg:
;;; > (N-Queens 16)
;;; -----------------------------------
;;; | _ Q _ _ _ _ _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ Q _ _ _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ Q _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ Q _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ Q _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ _ Q _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ _ _ _ Q _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ Q |
;;; | Q _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ Q _ _ _ _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ Q _ _ _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ Q _ _ _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ Q _ _ _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ Q _ _ _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ _ _ Q _ _ _ |
;;; | _ _ _ _ _ _ _ _ _ _ _ _ _ _ Q _ |
;;; -----------------------------------
;;;
;;; 1991 Marty Hall marty_hall@jhuapl.edu.
;;;=========================================================================

;;;=========================================================================
;;; From algorithm in SIGART Bulletin, Vol 2, Number 2, page 7. Determines 
;;; where to place each queen in constant time, so it takes longer to print
;;; out the board than to do the calculations. I am not aware of a 
;;; non-exponential approach that finds ALL solutions, as this just finds 
;;; ONE solution.
;;; 4/91 Marty Hall. Adapted to zlisp 0.1 by Alejandro Luque, 1999

(defun evenp (x) (zerop (mod x 2)))

(defun N-Queens (N) (N-Queens-actual N nil))

(defun N-Queens-actual (N Extra-Space?)
  (cond
    ((and (evenp N) (not (equal 0 (mod (- N 2) 6))))
     (Even-Queens-1 N Extra-Space?))
    ((evenp N)
     (Even-Queens-2 N Extra-Space?))
    (t
      (Odd-Queens N))
     ))

;;;========================================================================
;;; N even but not of form 6K+2.

(defun Even-Queens-1 (N Extra-Space?)
  (let ((M (if Extra-Space? (add1 N) N)))
    (do ((I 1 (add1 I))) ((> I (/ N 2)) nil)
      (Print-Row M (* 2 I)))
    (do ((I 1 (add1 I))) ((> I (/ N 2)) nil)
      (Print-Row M (sub1 (* 2 I))))
))

;;;========================================================================
;;; N even but not of form 6K

(defun Even-Queens-2 (N Extra-Space?)
  (let ((M (if Extra-Space? (add1 N) N)))
    (do ((I 1 (add1 I))) ((> I (/ N 2)) nil)
      (Print-Row M (add1 (Queen-Mod I N))))
    (do ((I (/ N 2) (sub1 I))) ((< I 1) nil)
      (Print-Row M (- N (Queen-Mod I N))))
))

;;;=========================================================================

(defun Queen-Mod (I N)
  (mod (+ (* 2 (1- I)) (/ N 2) -1) N))

;;;=========================================================================
;;; For odd N, just do N-1 case and then place queen on (N,N).
(defun Odd-Queens (N)
  (prog nil
    (N-Queens-actual (sub1 N) t)
    (Print-Row N N)
  )
)

;;;=========================================================================
;;; Prints a "Q" at Position, blanks otherwise.

(defun Print-Row (Length Position)
  (prog nil
    (msg t)
    (msg "|")
    (do ((I 1 (add1 I))) ((> I (sub1 Position)) nil)
        (msg " _")) 
    (msg " q")
    (do ((I 1 (add1 I))) ((> I (- Length Position)) nil)
        (msg " _")) 
    (msg " |")
  )
)

;;;======================================================================

(msg "Finds A (not ALL) solutions to any given size of the N-Queens" t
             "problem. Finds the position of each queen in constant time, so" t
             "the limiting step is printing out the board which is obviously" t
             "(N^2).  Invoke with  (N-Queens <N>). " t)

;;;======================================================================