8 Queens Problem

8q.lisp

;; ゲーム盤のサイズ
(defparameter N 8)

;; 各行にはどの列に駒を置いたか？
(defparameter *pos*  (make-array N :initial-element nil))
;; 列方向の利き筋判定
(defparameter *col*  (make-array N :initial-element nil))
;; 右斜め上方向の利き筋判定
(defparameter *up*   (make-array (1- (* 2 N)) :initial-element nil))
;; 左斜め下方向の利き筋判定
(defparameter *down* (make-array (1- (* 2 N)) :initial-element nil))

(defun board-init ()
  "ゲーム盤を初期化する。N を変更した場合は初期化が必要。"
  (setf *pos*  (make-array N :initial-element nil))
  (setf *col*  (make-array N :initial-element nil))
  (setf *up*   (make-array (1- (* 2 N)) :initial-element nil))
  (setf *down* (make-array (1- (* 2 N)) :initial-element nil)))

(defun up (row col)
  "*up* 配列のインデクス"
  (+ row col))

(defun down (row col)
  "*down* 配列のインデクス"
  (+ (- row col) (1- N)))

(defun solve (&optional limit)
  "limit 個まで解を求める（limit を省略した場合は全解探索）"
  (let (answer)
    (labels ((rec (row)
               (loop for col below N do 
                    (let ((u (up row col))
                          (d (down row col)))
                      (unless (or (aref *col*  col)
                                  (aref *up*   u)
                                  (aref *down* d))
                        (setf (aref *pos*  row) col
                              (aref *col*  col) t
                              (aref *up*   u)   t
                              (aref *down* d)   t)
                        (if (= row (1- N))
                            (push (copy-seq *pos*) answer)
                            (if (or (null limit)
                                    (< (length answer) limit))
                                (rec (1+ row))))
                        (setf (aref *pos*  row) nil
                              (aref *col*  col) nil
                              (aref *up*   u)   nil
                              (aref *down* d)   nil))))))
      (rec 0)
      answer)))

(defun show (answer)
  "solve で求めた解を表示する (show (solve)) "
  (dolist (a answer)
    (format t "  ~{~a~^ ~}~%" (loop for col below N collect col))
    (loop for row below N do
         (format t "~a " row)
         (loop for col below N do
              (if (= (aref a row) col)
                  (format t "Q ")
                  (format t ". ")))
         (fresh-line))
    (terpri)))