Skip to content

Instantly share code, notes, and snippets.

@kohyama kohyama/nq.clj
Last active Oct 19, 2017

Embed
What would you like to do?
N クイーン問題を Clojure で解きます Solve N-Queen problems
(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 :_ :_]]})))
@kohyama

This comment has been minimized.

Copy link
Owner Author

commented Jul 24, 2013

実行例です.

% 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.