N-Queen: 高速化
こちらの記事に刺激を受けて、以前に実装したN-Queenを高速化してみた(Common Lisp版のみ)。
(defvar *fastest* '(optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))) (deftype max-board-size () '(mod #x100)) (declaim (inline check)) ; inline宣言を追加 (defun check (row queens &optional (r 1) &aux (q (car queens))) (declare #.*fastest* (max-board-size r row q)) (or (null queens) (and (/= q (+ row r) (- row r)) (check row (cdr queens) (1+ r))))) ;; dolistの亜種 ;; - リストの走査時に各要素を変数に束縛するのと同時に、走査中の要素を除いたリストも変数に束縛する ;; ※ 先頭要素は走査対象外 (defmacro dolist2 ((x but-x list) &body body) (multiple-value-bind (recur prev cur next) (values #1=(gensym) #1# #1# #1#) `(let ((,but-x ,list)) (labels ((,recur (,prev &aux (,cur (cdr ,prev))) (when ,cur (destructuring-bind (,x . ,next) ,cur (setf (cdr ,prev) ,next) (locally ,@body) (setf (cdr ,prev) ,cur) (,recur ,cur))))) (,recur ,but-x))))) #| ex: > (dolist2 (x but-x '(:head 1 2 3 a b c)) (print `(:x ,x :but-x ,but-x))) (:X 1 :BUT-X (:HEAD 2 3 A B C)) (:X 2 :BUT-X (:HEAD 1 3 A B C)) (:X 3 :BUT-X (:HEAD 1 2 A B C)) (:X A :BUT-X (:HEAD 1 2 3 B C)) (:X B :BUT-X (:HEAD 1 2 3 A C)) (:X C :BUT-X (:HEAD 1 2 3 A B)) --> NIL |# (defun n-queen (n) (declare #.*fastest* (max-board-size n)) (nlet-acc self (queens (rows (cons :head (loop FOR i FROM 0 BELOW n COLLECT i)))) (if (null (cdr rows)) ; rows == '(:head) (accumulate queens) (dolist2 (row rest-rows rows) (when (check row queens) (self (cons row queens) rest-rows))))))
