Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
8 Queens Problem
;; ゲーム盤のサイズ
(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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment