ラベル nQueen問題 の投稿を表示しています。 すべての投稿を表示
ラベル nQueen問題 の投稿を表示しています。 すべての投稿を表示

2015/02/10

ClojureでリストのHylomorphismの変換マクロ

 前に書いた記事(Clojureでunfoldとhylomorphism) の続き.

 上の記事では, ClojureにおいてList版のHylomorphismを中間のデータ構造を生成しない純粋な再帰呼び出しで書きなおすことで高速化しました. しかし, 可読性が最悪で, はっきりいって読めない...
(defn correct-answer? [arrangement]
  (reduce andf
    (map not-conflict?
      (take-while first (iterate rest arrangement)))))

(defn correct-answer?-v2 [arrangement]
  (hylol andf true #(not (first %)) not-conflict? rest arrangement))
 上の関数が, リストを生成しながら計算するHylomorphism(に相当するもの), 下の関数が, リスト(中間のデータ構造)なしで同じ計算をするものです. (iterateで)リストを生成せずにプログラムが実行される分, 下の関数の方が高速であるという結果になったという話でした.

 hylolとはどいういった関数かというと, 次のような関数です.
(defn hylol
  [f e p g h b]
  (if (p b)
    e
    (f (g b) (hylol2 f e p g h (h b)))))
 ピカソの絵画ような抽象的な定義ですが, しかし抽象的であるがために, ある程度普遍性があります(様々なプログラムに出現する可能性が高いという意味です).

 できれば可読性を維持したまま(つまり, reduceとかmapとかが書かれた状態のまま) Hylomorphismに相当するプログラムを純粋な再帰に変換したいですね. というわけで, 関数でhylolを実装するのではなく, マクロで実装すれば良いのでは? という結論に至りました.
(hylol-expand
  (reduce + 0
       (take-while (partial not= 0)
                    (map dec (iterate dec 100)))))
とか
(hylol-expand
 (->> (iterate dec 100)
      (take-while (partial not= 0))
      (reduce + 0)))
みたいな書き方なら, 可読性に関しては問題ありません.

 というわけで上記のような書き方を維持したまま, Hylomorphismを再帰呼び出しに書き戻すマクロを作ってみました. 以下がそのマクロの実装. hylol-formで展開後の構造を定義し, hylol-expandで記法のパターンマッチを行い, それに対応するマクロフォームに展開します. 素朴な実装なので, 特に柔軟性などはありません.
(use '[clojure.core.match :only (match)])

(defn hylol-form
  "returns quoted hylol form"
  ([f-in-reduce init-in-reduce pred use-map-option f-in-map
   f-in-iterate init-in-iterate]
     `(letfn [(~'f [~'b]
                (if (~pred ~'b)
                  (~f-in-reduce
                   ~(if use-map-option (list f-in-map 'b) 'b)
                   (~'f (~f-in-iterate ~'b)))
                  ~init-in-reduce))]
        (~'f ~init-in-iterate))))

(defmacro hylol-expand
  "hylomorphism of lists without generating list"
  [hylol-exp]
  (match [hylol-exp]
    [(['reduce f-in-reduce init-in-reduce ;; no map & natural
       (['map f-in-map
         (['take-while pred
           (['iterate f-in-iterate init-in-iterate] :seq)]
            :seq)] :seq)] :seq)]
    (hylol-form f-in-reduce init-in-reduce pred true f-in-map
                f-in-iterate init-in-iterate)
    [(['reduce f-in-reduce init-in-reduce ;; no map & natural
       (['take-while pred
         (['iterate f-in-iterate init-in-iterate] :seq)]
            :seq)] :seq)]
    (hylol-form f-in-reduce init-in-reduce pred false nil
                f-in-iterate init-in-iterate)
    [(['->> (['iterate f-in-iterate init-in-iterate] :seq) ;; map & thread
       (['take-while pred] :seq)
       (['map f-in-map] :seq)
       (['reduce f-in-reduce init-in-reduce] :seq)] :seq)]
    (hylol-form f-in-reduce init-in-reduce pred true f-in-map
                f-in-iterate init-in-iterate)
    [(['->> (['iterate f-in-iterate init-in-iterate] :seq) ;; no map & thread
       (['take-while pred] :seq)
       (['reduce f-in-reduce init-in-reduce] :seq)] :seq)]
    (hylol-form f-in-reduce init-in-reduce pred false nil
                f-in-iterate init-in-iterate)
     [the-other-cases]
     (throw (Exception. (str "malformed hylol : " the-other-cases)))))
 上記のようなマクロ定義で, 次のような4通りの記述が可能になります.
(println (hylol-expand
          (reduce + 0
                  (map dec
                       (take-while (partial not= 0)
                                   (iterate dec 100))))))

(println (hylol-expand
          (reduce + 0
                  (take-while (partial not= 0) (iterate dec 100)))))

(println (hylol-expand
          (->> (iterate dec 100)
               (take-while (partial not= 0))
               (map inc)
               (reduce + 0))))

(println (hylol-expand
          (->> (iterate dec 100)
               (take-while (partial not= 0))
               (reduce + 0))))
 reduce, map,  take-while, iterateの位置は固定で, これ以外の書き方はできません. 引数となる「関数/(繰り返しの)初期値」のみが変更可能です. 上の二例は, 引数渡しで普通に書けるケース, 下の二例は, スレッディングマクロで書かれたものを再帰に書きなおすものです.

 簡単なベンチマークテストのため, 前の記事で作成した8queen問題でテストしてみました. 前回書いたのは, 次のような書き方(関数コール)でした.
(defn correct-answer?-v2 [arrangement]
  (hylol andf true #(not (first %)) not-conflict? rest arrangement))
 hylolの変換マクロの場合, 同じ意味のプログラムが,
(defn correct-answer?-mbt [arrangement]
  (hylol-expand ;; = identify
   (->> (iterate rest arrangement)
        (take-while first)
        (map not-conflict?)
        (reduce andf true))))
で書けます. 見た目は, 大分改善されました.

 以下が簡単なベンチマーク結果. correct-answers-with-hylol-macroがhylolの変換のマクロ実装, correct-answers-with-hylol-functionは, 前に書いた記事のcorrect-answers-v2, correct-answersは, ナイーブな(hylolの変換が入らない)実装でこれも前回書いた記事と同じ.
user> (time (count correct-answers-with-hylol-macro))
"Elapsed time: 590.56785 msecs"
92
user> (time (count correct-answers-with-hylol-function))
"Elapsed time: 594.688247 msecs"
92
user> (time (count correct-answers))
"Elapsed time: 739.69738 msecs"
92
 これで, 可読性を維持したまま, Hylomorphismのマクロ展開により高速化が可能になりました.

2015/01/05

Hy(lang), Lisp風味のPythonを使ってみた

 hy(lang)は, Lispです.

 公式にあるように, pipから簡単にトライできます.


 以下の記事は, hyのversion 0.10.1についての内容です.

 シンタックスは, 見た目, ほぼClojureにそっくりですが, cond, let式などをはじめとして, 微妙に異なる部分があるのと(どちらかといえばSchemeやRacketに近い), Python風の構文がいくつか含まれているなど, yet-another Clojureだと思ってプログラムを書こうとすると, 結構嵌まりました.

 ClojureからNumpyとか使ってみたい気もしますが, ベースがPythonであることもあり, hylangは, Clojureとは別の道を歩もうとしているようです.

 何回も使いまわしていますが, 8Queen問題の解法のプログラムを, Clojureで,書くと以下のような感じになるところを,
;; slove the 8 queen problem
(defn conflict? [x y others]
  (and (not (empty? others))
       (let [x1 (ffirst others) y1 (second (first others))]
         (or (= x x1) (= y y1)
             (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
             (conflict? x y (rest others))))))

(defn put-a-queen [x y others]
  (cond
   (< 7 x) false
   (not (conflict? x y others)) [x y]
   :else (put-a-queen (inc x) y others)))

(defn solve [x1 y1 answer1]
  (loop [x x1 y y1 answer answer1]
    (let [rests (rest answer)]
      (cond
       (and (< 7 x) (= 0 y))
       nil
       (< 7 y)
       (cons answer (solve (inc (ffirst answer)) (dec y) rests))
       :else
       (if-let [xy (put-a-queen x y answer)]
         (recur 0 (inc y) (cons xy answer))
         (recur (inc (ffirst answer)) (dec y) rests))))))

;; make the list of solutions
(def solutions (solve 0 0 []))
 hyで書くと, 次のようになりました.
;; slove the 8 queen problem
(require hy.contrib.loop)
(require hy.contrib.anaphoric)

(defn conflict? [x y others]
  (and (not (empty? others))
       (let [[x1 (car (car others))] [y1 (car (cdr (car others)))]]
          (or (= x x1) (= y y1)
              (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
              (conflict? x y (cdr others))))))

(defn put-a-queen [x y others]
  (cond
   [(< 7 x) false]
   [(not (conflict? x y others)) [x y]]
   [:else (put-a-queen (inc x) y others)]))

(defn solve [x1 y1 answer1]
  (loop [[x x1] [y y1] [answer answer1]]
    (let [[rests (cdr answer)]]
      (cond
        [(and (< 7 x) (= 0 y))
         nil]
        [(< 7 y)
         (cons answer (solve (inc (car (car answer))) (dec y) rests))]
        [:else
         (ap-if (put-a-queen x y answer)
           (recur 0 (inc y) (cons it answer))
           (recur (inc (car (car answer))) (dec y) rests))]))))

;; make the list of solutions
(def solutions (solve 0 0 []))
 ぱっと見は, Clojureとそっくりに書けることがわかります. もちろん, この書き方がhyの標準的なスタイルかどうかは分かりませんが. def/defnの記法は, Clojureと同じで, 大括弧([])を多様する書き方が, 全体をClojureっぽく見せているのだと思われます.

 condとlet式の部分は, 要素を偶数個並べる書き方ではありません. condは, 条件式とそれに対応する節のペアを括弧で囲います. letも, 変数を表すシンボルと, 割り当てる値を計算する式をリストで組にしたものを並べます(この辺は, Clojure感覚で書いていると, エラーが続出して, 結構嵌まりました).
 true/falseも, #t/#fではなく, true/falseのキーワードで表します. (Schemeと混同してました. 2015/02/02)
(defn put-a-queen [x y others]
  (cond
   [(< 7 x) false]
   [(not (conflict? x y others)) [x y]]
   [:else (put-a-queen (inc x) y others)]))
 さらに, car/cdrが復活しています(ただし, first/restも使えます).  loop/recurスペシャルフォームが使えますが, デフォルトでは使えません. contribからロードする必要があります.
(require hy.contrib.loop)
 こんな感じで, 割と表記上の問題は解決出来たのですが, リスト操作が不可解で, 結構難しかった印象です.

 一つは, empty?の特殊さで, これはリストの長さを計るのですが, (= (len ls) 0)の結果を返します. リストにrestをかけるとitertools.isliceというオブジェクトが生成されますが, このitertools.isliceオブジェクト, countableではないようで, (empty? (rest [1 2]))などと書くとエラーが出ます. そもそもempty?は, リストの長さを数える必要がないのですが, この辺はまだ, 実装途中といった感じなのかもしれません.
=> (rest [1 2])
<itertools.islice object at 0x271d208>
=> (empty? (rest [1 2]))
Traceback (most recent call last):
  File "<input>", line 1, in <module>
  File "/home/uks/Dropbox/langs/lisps/hy/example/env/local/lib/python2.7/site-packages/hy/core/language.hy", line 124, in is_empty
    (= 0 (len coll)))
TypeError: object of type 'itertools.islice' has no len()
=> (cdr [1 2])
[2L]
 ちなみにcdrが返すのはitertools.isliceではないようです.

 さらに, (憶測ですが)nil = Noneだったり, car ≠ first, cdr ≠ restだったり, 各関数がどのような内部クラスやオブジェクトの操作に対応しているのか知らないと, 嵌まるポイントがいくつかありました.
=> (first (rest (cons 1 None)))
=> (car (cdr (cons 1 None)))
Traceback (most recent call last):
  File "<input>", line 1, in <module>
  File "/home/uks/Dropbox/langs/lisps/hy/example/env/local/lib/python2.7/site-packages/hy/models/list.py", line 43, in __getitem__
    ret = super(HyList, self).__getitem__(item)
IndexError: list index out of range
 ネガティブなコメントが多くなってしまいましたが, 個人的には, Syntaxの観点から見ると, Clojureの書きにくかった部分が書きやすくなってるなーという印象です. Clojureは括弧の数を減らそうとしている箇所(cond, letなど)が多数見受けられますが, 逆にそこが仇となっている感じでしたがhylangでは元に戻っていました. リスト内包記法なんかも, Clojureのforとは比べ物にならないほど読みやすいです. リーダマクロも使い放題ですし.

 同じ機能を持つ関数やスペシャルフォームが, 複数名前があることが多いです. 例えば, 前述したcar/firstやdefn/defun, do/prognなどがあります.

 アナフォリックマクロが大量に定義されていて, contribをロードすると, 使えるようになります. anaphoricなのでapが頭につくみたいですね. ap-ifで, itに条件式の結果をbindします.
=> (require hy.contrib.anaphoric)
=> (ap-if true it false)
True

2014/12/31

ClojureでunfoldとHylomorphism

unfold

 unfoldは, fold(reduce)の双対として定義される関数で, リストを生成する一種のジェネレータのような働きをするものです. 畳み込み関数に対応する, 要素を展開する関数とみなすことができます. Clojureだとiterateが一番近い関数でしょう.
user> (take 10 (iterate (partial + 2) 0))
(0 2 4 6 8 10 12 14 16 18)
 Haskellでは, foldが二種類あり, foldrとfoldlで, 右から畳み込みと左から畳み込みに対応しています. Clojureのreduceは, foldlに相当します. そして, foldr/foldlそれぞれにunfoldr/unfoldlが定義できますが, 以下の文章では, foldlを前提に話を進めます. (Haskellのfoldとunfoldrについてはここで書いています.)

 unfoldlをClojureで書くとしたら以下のような感じになると思います.
(defn unfoldl [pred g h start]
   (map g (take-while #(not (pred %)) (iterate h start))))
 計算を始めるオブジェクトと繰り返し適用するh, 生成したリストにmapをかけるためのgと, リストを終わらせる条件式predからなります. map gがtake-whileよりも後の処理になるのも重要な点です.

Hylomorphism

 Hylomorphismとは, (代数的データ型へ)一般化されたfoldとunfoldの合成のことで, リストにおけるfoldlとunfoldlについて,

hylol f e p g h = foldl f e . unfoldl p g h

と書ける関数です. (太字部分 2015/01/08追記) unfoldlで生成したリストをfoldlで畳み込むような計算になります. map/reduceならぬ, generate(リスト生成)/map/reduceの処理が一つにまとまりました. Clojureだと次のようになります.
(defn hylol1
  "hylol f e p g h = foldl f e . unfoldl p g h"
  [f init pred g h start]
  (reduce f init (unfoldl pred g h start)))
 これだけだと, 抽象的な関数を組み合わせたまた別の抽象的なだけの関数といった印象しか残りません. しかし, Hylomorphismは, これを別のリストを使わないコードへ書き直すことができるのです.
(defn hylol2
  [f e p g h b]
  (if (p b)
    e
    (f (g b) (hylol2 f e p g h (h b)))))
 これが, HylomorphismLの別の実装です.

 foldlとunfoldlを組み合わせると当然, unfoldlで生成されたリストが, foldlにおいて, 畳み込まれてしまうため, 結果的に, 最終的な計算結果(戻り値)に不要なリストを計算途中で生成する必要が出てきてしまいます. しかし, 上記の2番目の実装では, リストを生成する様子がありません.

 Hylomorphismの変換では, foldとunfoldの合成関数を, これと同等の意味を持つ「リストを生成しないプログラム」へ書き換えることでプログラムを高速化します. この辺はmap分配則と同じような感じですね.

 例えば, 1〜100の和を計算するようなプログラムについて, foldl/unfoldlを使って,
(defn sum-from1to [n]
  (reduce + 0 (unfoldl (partial = 0) identity dec n)))
 と書けるわけですが, これをHylomorphismで書きなおしてみると, hylol2の実装を使って,
user> (hylol2 + 0 (partial = 0) identity dec 10)
55
と書けます. これをhylol2の実装へ展開すると,
(defn hylol2-sum
  [b]
  (if ((partial = 0) b)
    0
    (+ (identity b) (hylol2-sum (dec b)))))
 のように書きなおすことができて, foldl/unfoldlを使った場合に比べて素直な書き方になっていることがわかるかと思います.

 ある意味では, Hylomorphismの変換とは, リストを使って抽象化した処理を, 素朴な再帰関数に書き戻す手法だとみなすことができます.

Hylomorphismの変換例

 さて, Hylomorphismの変換に関する一番の関心事は, 本当に高速化するのかという点と, 具体的にプログラムへ適用できるのかという点です. というわけで, 以下は, 8Queen問題のプログラムでHylomorphismを使ってみたケースです.

 前に書いた記事の8Queen問題の解法では, バックトラックにより計算していましたが, 今回は, 素朴な総当り法を使います.

 8Queen問題の解とは, 究極的には, 1〜8の数字の並び, だとみなすことができます. 例えば, x座標を固定した場合, 鳩の巣論法的に, 各x座標(= 1, 2, ... 8)には必ず一つQueenが入っている必要があるからです. というわけで, x座標の情報は不要になり, 順序を持ったy座標列が, 解となります.

 というわけで, このプログラムでは, y座標のpermutationを与え, そこから, xy座標の組を計算し, その座標列が正しいかどうかを判定し, 正しければ解を返します. 以下がコードです.
(use 'clojure.math.combinatorics)

;; unfoldl & hylomorphism
(defn unfoldl [pred g h start]
   (map g (take-while #(not (pred %)) (iterate h start))))

(defn hylol2
  [f e p g h b]
  (if (p b)
    e
    (f (g b) (hylol2 f e p g h (h b)))))

;; 8 queen
(defn conflict? [x y others]
  (and (not (empty? others))
       (let [x1 (ffirst others) y1 (second (first others))]
         (or (= x x1) (= y y1)
             (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
             (conflict? x y (rest others))))))

(defn not-conflict? [ls]
  (let [xy (first ls) others (rest ls)]
    (not (conflict? (first xy) (second xy) others))))

(defn andf
  ([a] a)
  ([a b] (and a b)))

(defn correct-answer? [arrangement]
  (reduce andf
    (map not-conflict?
      (take-while first (iterate rest arrangement)))))

(defn correct-answer?-v2 [arrangement]
  (hylol2 andf true #(not (first %)) not-conflict? rest arrangement))

(defn check-and-cons [checker yss]
  (let [arrangement (map list (range 8) yss)]
    (if (checker arrangement) arrangement [])))

(defn get-correct-answers [permutations checker]
  (filter first (map (partial check-and-cons checker) permutations)))

(def perm (doall (permutations (range 8))))

(def correct-answers
  (get-correct-answers perm correct-answer?))

(def correct-answers-v2
  (get-correct-answers perm correct-answer?-v2))
 実行時間を計測してみると, 確かに高速化されていることがわかります. correct-answersの方が, foldl/unfoldl(に相当するもの)を使った場合で, correct-answers-v2がhylol2によりプログラム変換を行ったケースです.
user> (time (count correct-answers))
"Elapsed time: 733.504269 msecs"
92
user> (time (count correct-answers-v2))
"Elapsed time: 592.678338 msecs"
92
 上記の結果を見た場合, それ以外の部分でボトルネックになっている部分もありそうですが, Hylomorphismの変換により, 一応, 高速化ができていることが観察できました.

 さて, 問題のプログラム変換は以下の部分で行っています. correct-answer?が, 素朴なfoldl/unfoldlで, correct-answer?-v2がリストを生成しないHylomorphismを使ったコードになります. correct-answer?の方にunfoldlというキーワードは見当たりませんが, map/take-while/iterateの組み合わせがそれに相当します.
(defn correct-answer? [arrangement]
  (reduce andf
    (map not-conflict?
      (take-while first (iterate rest arrangement)))))

(defn correct-answer?-v2 [arrangement]
  (hylol2 andf true #(not (first %)) not-conflict? rest arrangement))
 ここでは, [[1 2] [3 4] ...]のようなQueenの位置を表すリスト(arrangement)を受け取り, そこから, 部分リストを生成し(iterate/take-while), 各部分リストの「先頭の要素」と「他の要素」が衝突しないか(互いが取り合える位置にいないか)をチェックして(map not-conflict?), 矛盾しているケースがないかどうかをandf(andの関数版)で確認し(reduce), その答えの正解/不正解をboolで返すというものです.

 例えば, 座標のリスト[p1 p2 ... p8]があるときに互いに衝突していないかを判定するためには, p1と[p2 ... p8], p2と[p3 ... p8], p3と[p4 ... p8]と判定していくため, 上記のようなrestをiterateする実装になっています.

 reduce, map. take-while, iterateが一堂に会しているので, 図らずともHylomorphismの変換が簡単にできました.

 Hylomorphismの変換から得られる教訓(?)は, プログラム中に, ジェネレータによるリスト生成を行う部分があり, その先で, reduce(畳み込み関数)がそのリストを畳もうと待ち構えているとき, そのコードは, リストを使わないコードへ書き換えることができるかもしれない, ということです. そして, 書き換えたコードは, 余分な(本来の計算結果に不要な)データ構造の生成が不要になることで, 高速化できる筈だという結論です.

参考文献
  • 関数プログラミングの楽しみ, Jeremy Gibbons & Oege de Moor(編集), 山下 伸夫 (翻訳), オーム社, 2010/6/23
    • ifphの続編(?), この記事の内容は本書のhylomorphismのセクションを元にかかれています.
  • 構成的アルゴリズム論
    • hyloだけでなく, map分配則などプログラム運算の様々な規則が紹介されています. チュートリアル.
  • Anamorphic Adventure in Clojure - Matlux
    • Clojureで, Anamorphism(unfold相当)を定義する話. 

2014/12/12

Clojureで8Queen問題

8Queen問題とは, 有名ですが, 以下のような問題です.


 チェスのクイーンの動きは, 飛車 + 角行で, 縦横の重複(飛車の動きの判定)は容易ですが, (X軸かY軸が重複していればいいだけなので) ナナメの判定にはどう実装しようか戸惑います. 斜めにコマを取られるケースの実装が厄介に感じられますが, 実際は結構で, 斜め筋が重複している場合の判定は, 2つのクイーンQ1(x1, y1), Q2(x2, y2)について, 次のようになります. どちらか一つの式が成立したら斜めで重複していることになります.

(x1 - x2) = (y1 - y2)
(x1 - x2) = (y2 - y1)

 上の式は, 右上から左下への斜め筋が, (1,1), (2,2), (3,3) ... とかなので. 下の式は, 左上から右下へがその逆なので,  y1とy2が反転します.

 これをClojureで, 実装するとこんな感じになりました. 実際に問題を解いているのは28行目までで, 他は文字列の出力関係です.

 conflict?ですでに置いたクイーンとの衝突を判定します. put-a-queenは, 次に置く一手を決めます. 引数の(x, y)以上の位置から探索を始めて, others(他のクイーンの座標[x y]のリスト)と重複しないような位置を返します. そのような場所がない場合は, falseを返します.

 solveは, バックトラックによって探索します. solveは, (x, y) = (0, 0), others = []から始めて, 可能な解をすべて計算します. 1行あたり1クイーンなので, 上から順に各行にQueenをputしていきます. xの初期位置が7を超えたら探索終わり. 左上から探索を始めてput-a-queenを何度も呼び出して, 矛盾しない解を探し続ける(solve関数内の末尾のrecur2つ). 解が見つかればputが成功したのだと考えて, その次の行の値を探しに行く. 解が見つからない場合, 前回putが失敗だったと考え, 一つ前の行のputを取り消して, そこから右へ向かって検索を行う.
 一つ解を求めたら, その解が失敗だったものと見なしてバックトラックを行い, solveを再び始めます(solve関数内のconsのあたり) .
(use '[leiningen.exec :only (deps)]) ; lein exec

;; slove the 8 queen problem
(defn conflict? [x y others]
  (and (not (empty? others))
       (let [x1 (ffirst others) y1 (second (first others))]
         (or (= x x1) (= y y1)
             (= (- x x1) (- y y1)) (= (- x x1) (- y1 y))
             (conflict? x y (rest others))))))

(defn put-a-queen [x y others]
  (cond
   (< 7 x) false
   (not (conflict? x y others)) [x y]
   :else (put-a-queen (inc x) y others)))

(defn solve [x1 y1 answer1]
  (loop [x x1 y y1 answer answer1]
    (let [rests (rest answer)]
      (cond
       (and (< 7 x) (= 0 y))
       nil
       (< 7 y)
       (cons answer (solve (inc (ffirst answer)) (dec y) rests))
       :else
       (if-let [xy (put-a-queen x y answer)]
         (recur 0 (inc y) (cons xy answer))
         (recur (inc (ffirst answer)) (dec y) rests))))))

;; make the list of solutions
(def solutions (solve 0 0 []))

;; show the results
(defn queen-str [xs]
  (let [dots #(take % (cycle "."))
        astr (partial apply str)]
    (map (fn [i] (astr (astr (dots i)) "Q" (dots (- 7 i))))
         (map second (sort xs)))))

(defn add-left [xs ys]
  (map str xs ys))

(defn spaces [width] ;; the list of space
  (cycle (apply str (take width (cycle " ")))))

(defn add-leftside-margin [width xs]
  (let [height (count xs)]
    (add-left (take height (spaces width)) xs)))

(defn gen-string [n xs]
  (->> (range n)
       (map (fn [x ns] (add-leftside-margin 10 x)) xs)
       (reduce add-left)))

(defn display-1-line [xs]
  (doall (map println xs))
  (println ""))

(defn display-all [given-list per]
  (loop [xs (partition-all per given-list)]
    (if (not (empty? xs))
      (do (display-1-line (gen-string per (map queen-str (first xs))))
          (recur (rest xs))))))

(display-all solutions 8)
 display-allで, 1列あたり8つの解を表示しています. 8-Queenの解の総数は, 92個あるそうですが, 次のような感じになりました.
u@mint ~/Dropbox/clj/8queen $ lein exec 8queen.clj
 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...
 .......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.....

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

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

 ......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
 .......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.......
んー.