Instantly share code, notes, and snippets.

# tanakahx/8q.lisp Created Jul 26, 2015

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)))