N クイーン問題を Clojure で解きます Solve N-Queen problems

nq.clj

(require '[clojure.test :refer (with-test is run-tests)])

(with-test
  (defn- trns "盤を転置します"
    [b] (vec (apply (partial map vector) b)))

  ; テスト
  (is (= (trns [[:a :b]
                [:c :d]])
         [[:a :c]
          [:b :d]])))

(with-test
  (defn- rot90 "盤を90度回転します"
    [b] (trns (reverse b)))

  ; テスト
  (is (= (rot90 [[:a :b]
                 [:c :d]])
         [[:c :a]
          [:d :b]])))

(with-test
  (defn- symmetrics "自身を含め対称な盤 8種類の集合を返します"
    [b] (set (mapcat #(take 4 (iterate rot90 %)) (list b (trns b)))))

  ; テスト
  (is (= (symmetrics [[:a :b]
                      [:c :d]])
         #{[[:a :b] [:c :d]] [[:c :a] [:d :b]]
           [[:d :c] [:b :a]] [[:b :d] [:a :c]]
           [[:a :c] [:b :d]] [[:b :a] [:d :c]]
           [[:d :b] [:c :a]] [[:c :d] [:a :b]]})))

(with-test
  (defn- minimum?
 "盤の状態を compare で比較した時の意味において
  自身を含む対称 8種類の中で最小の盤であるか判定します"
    [b] (= b (first (sort (symmetrics b)))))

  ; テスト
  (is (= (minimum? [[:a :b] [:c :d]]) true))
  (is (= (minimum? [[:c :a] [:d :b]]) false))
  (is (= (minimum? [[:d :c] [:b :a]]) false)))

(with-test
  (defn- putq
 "0 行から y - 1 行まで一つずつクイーン(値 :q で表す)がおいてあり
  ある行に置かれたクイーンに対して, その行より下の行に対する全て
  の効き筋に値 :e が置かれた状態の盤があり,
  行番号 y と :e が置かれていない列番号 x が与えられた場合,
  y 行 x 列に :q を置き, 同じ法則で, 以下の行に :e を置いた
  盤を返します.
  盤の行数 = 列数 = n も与えられるとします."
    [n b y x]
    (reduce
      (fn [a yx] (assoc-in a yx :e)) ; 効き筋に :e を置く
      (assoc-in b [y x] :q) ; クイーン :q を置く
      (filter (fn [[_ x]] (< -1 x n)) ; 盤の外への効き筋は無視します
        (mapcat #(list [%1 %2] [%1 %3] [%1 %4]) ; y より下の行の効き筋
          (range (inc y) n)     ; y より下の行の行番号
          (repeat x)            ; 対応する垂直下方への効き筋の列番号
          (iterate inc (inc x)) ; 対応する右斜め下への効き筋の列番号
          (iterate dec (dec x)) ; 対応する左斜め下への効き筋の列番号
          ))))

  ; テスト
  (is (= (putq 4 [[:_ :q :_ :_]
                  [:e :e :e :_]
                  [:_ :e :_ :e]
                  [:_ :e :_ :_]] 1 3)
         [[:_ :q :_ :_]
          [:e :e :e :q]
          [:_ :e :e :e]
          [:_ :e :_ :e]])))

(with-test
  (defn- replace-b
 "盤中の値 s を持つセルの値を値 d に変更します"
    [b s d]
    (mapv (fn [l] (mapv #(if (= % s) d %) l)) b))

  ; テスト
  (is (= (replace-b [[:_ :q :_ :_]
                     [:e :e :e :q]
                     [:q :e :e :e]
                     [:e :e :q :e]] :e :_)
         [[:_ :q :_ :_]
          [:_ :_ :_ :q]
          [:q :_ :_ :_]
          [:_ :_ :q :_]])))


(with-test
  (defn nq
 "N-クイーン問題を解きます.
  盤の行数 = 桁数 = n を与えます.
  n * n のベクタのベクタで解となる盤の状態を表します.
  クイーンの置いてないセルは :_ で, クイーンの置いてあるセルは :q
  で示されます.
  対称性を排除した上で見つかった全ての解を集合で返します."
    [n]                                   ; 番号順にコメントを読んで下さい
    (set                                  ; 9. 全体を集合で返します
      (reduce
        (fn [bs y]
          (for [b bs                      ; 3. y - 1 行までおいた全ての盤 b
                x (range n)               ; 4. 0 以上 n 未満の桁 x について
                :when (not= ((b y) x) :e) ; 5. b の y 行 x 列が :e で無いなら
                :let [t (putq n b y x)    ; 6. クイーンを置く
                      s (if (= y (dec n)) ; 7. 最後の行まで置いたなら
                            (replace-b t :e :_) ; 効き筋の表記をクリアする
                            t)]
                :when (or (< y (dec n))   ; 8. まだ最後の行でないか
                          (minimum? s))]  ;    最後の行まで置いた時に
             s))                          ;    対称 8個中, 最小値を持つ盤なら
                                          ;    盤の状態を返す
        (list (vec (repeat n (vec (repeat n :_)))))
                                          ; 1. 全てのセルを :_ で初期化
        (range n))))                      ; 2. 0 以上 n 未満の行 y について

   ; テスト
   (is (= (nq 4)
          #{[[:_ :_ :q :_]
             [:q :_ :_ :_]
             [:_ :_ :_ :q]
             [:_ :q :_ :_]]})))

実行例です.

% java -cp /path/to/clojure.jar clojure.main
Clojure 1.5.1
user=> (load-file "nq.clj")
#'user/nq
user=> (run-tests)

Testing user

Ran 7 tests containing 9 assertions.
0 failures, 0 errors.
{:type :summary, :pass 9, :test 7, :error 0, :fail 0}
user=> (def nq8 (nq 8))
#'user/nq8
user=> (count nq8)
12
user=> (pprint nq8)
#{[[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :q :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :_ :_ :q :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]]
  [[:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :q :_ :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :_ :q :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]]
  [[:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :q :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:_ :_ :_ :q :_ :_ :_ :_]]
  [[:_ :_ :_ :_ :_ :_ :q :_]
   [:_ :_ :_ :q :_ :_ :_ :_]
   [:_ :q :_ :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :_ :_ :_ :q]
   [:_ :_ :_ :_ :_ :q :_ :_]
   [:q :_ :_ :_ :_ :_ :_ :_]
   [:_ :_ :q :_ :_ :_ :_ :_]
   [:_ :_ :_ :_ :q :_ :_ :_]]}
nil