今回は簡単な例題として、「順列 (permutation)」と「組み合わせ (combination)」を生成するプログラムを作りましょう。
たとえば 4 つの整数 1, 2, 3, 4 の順列は次に示すように 24 通りあります。
1 2 3 4, 1 2 4 3, 1 3 2 4, 1 3 4 2, 1 4 2 3, 1 4 3 2 2 1 3 4, 2 1 4 3, 2 3 1 4, 2 3 4 1, 2 4 1 3, 2 4 3 1 3 1 2 4, 3 1 4 2, 3 2 1 4, 3 2 4 1, 3 4 1 2, 3 4 2 1 4 1 2 3, 4 1 3 2, 4 2 1 3, 4 2 3 1, 4 3 1 2, 4 3 2 1
一般に、異なる n 個の順列の総数は、n の階乗 (n!) 通りだけあります。この順列をすべて求めるプログラムを考えてみましょう。このときよく使われる方法に「バックトラック法 (backtracking)」があります。
たとえば、簡単な例として迷路を考えてみましょう。ある地点 A で道が左右に分かれているとします。ここで、左の道を選んで先へ進むと、行き止まりになってしまいました。この場合は A 地点まで戻って右の道へ進まないといけませんね。つまり、失敗したら後戻りして別の道を選ぶ、という試行錯誤をゴールに行き着くまで繰り返すわけです。これがバックトラック法の基本的な考え方です。
バックトラック法は迷路を解くだけではなく、いろいろな問題に応用できる方法です。特に、すべての解を求める場合、バックトラック法が適しています。すべての解をもれなく見つけることができます。
順列は次のような図を書くと簡単に求めることができます。
START ──１─┬─２─┬─３──４ ──→ 1 2 3 4
│ │
│ └─４──３ ──→ 1 2 4 3
│
├─３─┬─２──４ ──→ 1 3 2 4
│ │
│ └─４──２ ──→ 1 3 4 2
│
└─４─┬─２──３ ──→ 1 4 2 3
│
└─３──２ ──→ 1 4 3 2
図 : 順列の生成
上図は 1 から始まる場合です。同様に 2, 3, 4 から始まる図があります。最初が 1 であれば、次の数は 2, 3, 4 の中から選ばれますね。したがって、1 から 2, 3, 4 へと枝分かれします。1 - 2 と選んだ場合、次は 3, 4 の中から数を選びます。今度は 2 から 3, 4 へと枝分かれします。1 - 2 - 3 と選んだ場合は、残った数は 1 つしかありませんね。その数 4 を選んで 1 - 2 - 3 - 4 という並べ方が完成します。
ほかの並べ方を求めるには、今まで通った道を戻って別の道を探します。まず、1 - 2 - 3 - 4 から 1 - 2 - 3 まで後戻りします。この地点では 4 以外の道はないので、もうひとつ戻らなくてはいけません。1 - 2 まで戻ると、道は 2 つに枝分かれしています。3 はすでに通った道ですから、今度は 4 を選ぶことになります。この道を進んでいくと、1 - 2 - 4 - 3 という並べ方を求めることができます。
再度 1 - 2 まで後戻りします。2 つの道ともすでに通ったことがあるので、1 の位置まで後戻りします。この地点は 3 つに枝分かれしていますが、2 の道は通ったので今度は 3 を選んで 1 - 3 へ進みます。このように、通ったことがない道を選んでいき、1 から枝分かれする道をすべて通ったならば、START まで戻って 1 以外の道を選ぶことになります。あとは同様に道をたどっていけば、すべての並べ方を求めることができます。
それでは、プログラムを作ってみます。ここまでの説明で、バックトラック法の実現は難しいのではないか、と思った方はいませんか。「進む」ことと「戻る」ことをどのようにプログラムしたらよいのか、見当もつかないという人もいるかもしれません。ところがバックトラック法は、今までに何回も使ってきた「再帰呼び出し」を利用すると、とても簡単に実現できるのです。
まず、「進む」場合を再帰呼び出しに対応させます。そうすると、ひとつ手前の位置に戻ることは、呼び出し元の関数に戻ることに対応させることができるのです。つまり、関数の評価を終了すれば、元の位置に「バックトラック」できるわけです。
具体的に説明しましょう。まず、順列を生成する関数 permutation を次のように定義します。
permutation xs a
permutation の引数 xs には選択していない数を格納したリストを渡し、引数 a には選んだ数を格納するリストを渡します。最初に呼び出すときは (permutation '(1 2 3 4) '()) とします。まだ数を選択していないので、xs は (1 2 3 4) となり、a は () となります。数は xs の中から選びます。再帰呼び出しする場合、選んだ数をリストから削除するとともに a へ追加します。次の図を見てください。
perm xs a
----------------------------------
│ (1 2 3 4) ()
│ ^
再 ↓
帰 │ (2 3 4) (1)
呼 │ ^
び ↓
出 │ (3 4) (2 1)
し │ ^
↓
│ (4) (3 2 1)
│ ^
↓
() (4 3 2 1) 並べ方完成
図 : 関数 permutation の動作 (その１)
最初は (1 2 3 4) の中から数を選びます。このとき、リストの先頭から順番に数を選んでいきます。最初は 1 を選びますが、バックトラックしたときは、次の 2 を選ぶようにします。再帰呼び出しするときは、第 1 引数のリストから 1 を削除し、それを第 2 引数のリストに追加します。数はリストの先頭へ追加していくので、並べ方が逆になることに注意してください。
このように、再帰呼び出しを続けていくと、第 1 引数は空リストになります。ここが、再帰呼び出しの停止条件となり、第 2 引数には数の並びが逆順にセットされています。これを出力すればいいわけです。
次に、新しい組み合わせを探すため、バックトラックを行います。次の図を見てください。
バックトラックすると xs が (4) で a が (3 2 1) の状態に戻ります。ここで次の数を選ぶのですが、もうリストには数がありません。そこで、再度バックトラックします。すると、xs が (3 4) で a が (2 1) の状態に戻ります。このときは、3 の次である 4 を選びます。第 1 引数 (3 4) から 4 を取り除いた (3) と、第 2 引数 (2 1) に 4 を追加した (4 2 1) を与えて再帰呼び出しします。あとは、同じことを繰り返すことで、順列をすべて求めることができるわけです。
perm xs a
-----------------------------------
│ () (4 3 2 1)
バック │
トラック↓
│ (4) (3 2 1)
バック │ X
トラック↓
│ (3 4) (2 1)
再帰 │ X ^
↓
│ (3) (4 2 1)
再帰 │ ^
↓
() (3 4 2 1) 組み合わせ完成
図 : 関数 permutation の動作 (その２)
それではプログラムを作りましょう。今回はプログラムを簡単にするため、引数のリストの中には重複要素が無いことを前提とします。次のリストを見てください。
リスト : 順列の生成
(defn permutation
([xs] (permutation xs '()))
([xs a]
(if-not (seq xs)
(println (reverse a))
(doseq [x xs]
(permutation (remove #(= x %) xs) (cons x a))))))
permutation の引数 xs が空リストの場合、順列がひとつ完成したので println で画面へ出力します。reverse でリストを反転していることに注意してください。そうでなければ、リスト xs から要素を順番に選んでいきます。これは doseq を使えば簡単ですね。doseq の中で permutation を再帰呼び出しするとき、remove で xs から x を削除し、cons で x を引数 a のリストに追加します。
それでは実行してみましょう。
user=> (permutation '(1 2 3)) (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1) nil user=> (permutation '(1 2 3 4)) (1 2 3 4) (1 2 4 3) (1 3 2 4) (1 3 4 2) (1 4 2 3) (1 4 3 2) (2 1 3 4) (2 1 4 3) (2 3 1 4) (2 3 4 1) (2 4 1 3) (2 4 3 1) (3 1 2 4) (3 1 4 2) (3 2 1 4) (3 2 4 1) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 1 3 2) (4 2 1 3) (4 2 3 1) (4 3 1 2) (4 3 2 1) nil
正常に動作していますね。
ところで、関数 permutation は順列を画面へ出力しましたが、高階関数にしたほうが便利でしょう。プログラムは次のようになります。
リスト : 順列の生成 (高階関数版)
(defn permutation
([func xs] (permutation func xs '()))
([func xs a]
(if-not (seq xs)
(func (reverse a))
(doseq [x xs]
(permutation func (remove #(= x %) xs) (cons x a))))))
関数 permutation の引数 func が関数です。あとは、順列を表示する処理を関数 func の呼び出しに変えただけです。とても簡単ですね。たとえば、func に println を渡せば、順列をすべて表示することができます。
生成した順列をリストに格納して返す場合は、reduce を使うと簡単です。プログラムは次のようになります。
リスト : 順列の生成 (2)
(defn permutations
([xs] (permutations xs '() '()))
([xs a b]
(if-not (seq xs)
(cons a b)
(reduce (fn [c x] (permutations (remove #(= % x) xs) (cons x a) c)) b xs))))
関数 permutations は生成した順列を第 3 引数 b のリストに格納します。xs が空リストの場合、順列を一つ生成したので、cons で a を引数 b に格納して返します。そうでなければ、xs の要素を順番に選んで permutations を再帰呼び出しして順列を生成します。ここで reduce を使います。
reduce の初期値 (第 2 引数) に引数 b を渡すことで、匿名関数の第 1 引数 c に順列を格納するリストを渡します。あとは permutations を再帰呼び出しすると、その返り値は次に無名関数を呼び出すときの引数 c に渡されるので、順列を格納したリストを permutations に渡していくことができます。
それでは実行結果を示します。
user=> (permutations '(1 2 3)) ((1 2 3) (2 1 3) (1 3 2) (3 1 2) (2 3 1) (3 2 1)) user=> (permutations '(1 2 3 4)) ((1 2 3 4) (2 1 3 4) (1 3 2 4) (3 1 2 4) (2 3 1 4) (3 2 1 4) (1 2 4 3) (2 1 4 3) (1 4 2 3) (4 1 2 3) (2 4 1 3) (4 2 1 3) (1 3 4 2) (3 1 4 2) (1 4 3 2) (4 1 3 2) (3 4 1 2) (4 3 1 2) (2 3 4 1) (3 2 4 1) (2 4 3 1) (4 2 3 1) (3 4 2 1) (4 3 2 1))
次は reduce を使わないでプログラムを作ってみましょう。最初に、リストから要素を一つ選んで、選んだ要素と残りの要素を返す関数 selects を考えます。selects の動作例を示します。
user=> (selects '(1 2)) ((1 (2)) (2 (1))) user=> (selects '(1 2 3)) ((1 (2 3)) (2 (1 3)) (3 (1 2))) user=> (selects '(1 2 3 4)) ((1 (2 3 4)) (2 (1 3 4)) (3 (1 2 4)) (4 (1 2 3)))
selects の返り値はリストで、その要素はリスト (選択した要素 (残りの要素 ...)) です。最後の例のように、リスト (1 2 3 4) を selects に渡せば、((1 ...) (2 ...) (3 ...) (4 ...)) というリストを返します。... は残りの要素を格納したリストです。
リストに重複要素がないことを前提にすると、selects はとても簡単です。
リスト : 要素の選択 (defn selects [xs] (map (fn [x] (list x (remove #(= x %) xs))) xs))
map で要素 x を順番に取り出します。あとは無名関数で、x と (remove #(= % x) xs) をリストに格納して返すだけです。
selects を使うと順列の生成は簡単です。(selects xs) でリスト xs の要素を選択します。次に、残りの要素で順列を生成します。そして、選んだ要素を順列 (リスト) の先頭に追加すれば、その要素から始まる順列を生成することができます。あとは選んだ要素に対してこの処理を繰り返し適用して、順列をひとつのリストにまとめればいいわけです。
このような処理はマッピングを二重に使うと簡単に実現できます。次の例を見てください。
user=> (map (fn [x] (cons 5 x)) '((1) (2) (3) (4) (5))) ((5 1) (5 2) (5 3) (5 4) (5 5)) user=> (map (fn [y] (map (fn [x] (cons y x)) '((1) (2) (3) (4) (5)))) '(5 6)) (((5 1) (5 2) (5 3) (5 4) (5 5)) ((6 1) (6 2) (6 3) (6 4) (6 5)))
リストの各要素に 5 を追加したい場合、map を使うと簡単ですね。次は、リスト (5 6) の各要素を追加したリストを求めることを考えます。map を二重にして、(5 6) の要素を匿名関数の引数 y に渡します。次の map で y をリストに追加します。すると、返り値のリストには 5 を追加したリストと 6 を追加したリストが格納されます。map を二重にしているので、リストの階層が 1 段深くなるわけです。
そこで、リストを一段階だけ平坦化する関数 mapcat を使います。
user=> (mapcat (fn [y] (map (fn [x] (cons y x)) '((1) (2) (3) (4) (5)))) '(5 6)) ((5 1) (5 2) (5 3) (5 4) (5 5) (6 1) (6 2) (6 3) (6 4) (6 5))
このように、先頭に 5 を追加したリストと 6 を追加したリストを一つのリストに格納することができます。
プログラムは次のようになります。
リスト : 順列の生成 (3)
(defn permutations [xs]
(if-not (seq xs)
'(())
(mapcat (fn [[y ys]]
(map (fn [zs] (cons y zs)) (permutations ys)))
(selects xs))))
引数 xs が空リストならば空リストを格納したリスト (()) を返します。これが再帰呼び出しの停止条件になります。そうでなければ、(selects xs) で要素を選択して mapcat に渡します。次に、その無名関数の中で permutations に残りの要素のリスト ys を渡して順列を生成します。あとは map で生成した順列の先頭に選択した要素 y を追加するだけです。
それでは実行してみましょう。
user=> (permutations '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) user=> (permutations '(1 2 3 4)) ((1 2 3 4) (1 2 4 3) (1 3 2 4) (1 3 4 2) (1 4 2 3) (1 4 3 2) (2 1 3 4) (2 1 4 3) (2 3 1 4) (2 3 4 1) (2 4 1 3) (2 4 3 1) (3 1 2 4) (3 1 4 2) (3 2 1 4) (3 2 4 1) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 1 3 2) (4 2 1 3) (4 2 3 1) (4 3 1 2) (4 3 2 1))
正常に動作していますね。
今回はリストに重複要素がないことが前提なので、実をいうと selects を使わなくても簡単にプログラムすることができます。次のリストを見てください。
リスト : 順列の生成 (4)
(defn permutations' [xs]
(if-not (seq xs)
'(())
(mapcat (fn [x]
(map (fn [ys] (cons x ys))
(permutations' (remove #(= x %) xs))))
xs)))
引数 xs をそのまま mapcat に渡します。mapcat の無名関数の引数 x が選んだ要素になります。そして、permutations' を再帰呼び出しするとき、remove で xs から x を取り除いたリストを渡します。あとは selects を使った場合と同じです。
今度は \({}_n \mathrm{C}_r\) 個の組み合わせを全て生成するプログラムを作ってみましょう。たとえば、1 から 5 までの数字の中から 3 個を選ぶ組み合わせは次のようになります。
1 2 3, 1 2 4, 1 2 5, 1 3 4, 1 3 5, 1 4 5, 2 3 4, 2 3 5, 2 4 5, 3 4 5
最初に 1 を選択した場合、次は (2 3 4 5) の中から 2 個を選べばいいですね。2 番目に 2 を選択したら、次は (3 4 5) の中から 1 個を選べばいいわけです。これで、(1 2 3), (1 2 4), (1 2 5) が生成されます。(2 3 4 5) の中から 2 個選ぶとき、2 を選ばない場合があります。この場合は (3 4 5) の中から 2 個を選べばいいわけです。ここで 3 を選ぶと (1 3 4), (1 3 5) が生成できます。同様に、3 を除いた (4 5) の中から 2 個を選ぶと (1 4 5) を生成することができます。
これで 1 を含む組み合わせを生成したので、次は 1 を含まない組み合わせ、つまり (2 3 4 5) から 3 個を選ぶ組み合わせを生成すればいいわけです。けっきょく、この処理の考え方は次に示す組み合わせの公式と同じです。
プログラムは次のようになります。
リスト : 組み合わせの生成
(defn combination
([func xs r] (combination func xs r '()))
([func [y & ys :as xs] r a]
(cond
(zero? r) (func (reverse a))
(not (seq xs)) nil
:else (do
(combination func ys (dec r) (cons y a))
(combination func ys r a)))))
関数 combination は引数 xs のリストから r 個を選ぶ組み合わせを生成して関数 func を適用します。選んだ数字は引数 a に格納します。r が 0 になったら組み合わせを一つ生成できたので、a を reverse で逆順にして関数 func を呼び出します。xs が空リストならば何もしないで nil を返します。この 2 つの条件が再帰呼び出しの停止条件になります。
最後の節は xs が空リストでない場合です。ここで combination を再帰呼び出しします。do は引数の S 式を順番に実行し、 最後に評価した結果を返します。Common Lisp の progn や Scheme の begin と同じ働きをします。最初の呼び出しは先頭の要素 y を選択する場合です。y を a に追加して、残りのリスト ys の中から r - 1 個を選びます。最後の呼び出しが先頭の要素を選ばない場合です。リスト ys の中から r 個を選びます。
プログラムはこれで完成です。簡単な実行例を示しましょう。
user=> (combination println '(1 2 3 4 5) 2) (1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5) nil user=> (combination println '(1 2 3 4 5) 3) (1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5) nil
正常に動作していますね。
次は生成した組み合わせをリストに格納して返すプログラムを作ります。次のリストを見てください。
リスト ; 組み合わせの生成 (2)
(defn combinations [[y & ys :as xs] r]
(cond
(zero? r) '(())
(not (seq xs)) '()
:else (concat (map (fn [zs] (cons y zs))
(combinations ys (dec r)))
(combinations ys r))))
関数 combinations は xs の中から r 個を選ぶ組み合わせを生成します。cond の最初の節で、r が 0 ならば要素を選び終わったので、空リストを格納したリストを返します。2 番目の節で、xs が空リストならば () を返します。この 2 つが再帰呼び出しの停止条件になります。
最後の節で combinations を再帰呼び出しします。最初の呼び出しでは先頭要素 y を選びます。残りのリスト ys から r - 1 個を選ぶ組み合わせを生成して、その先頭に選んだ要素 y を追加します。2 番目の呼び出しでは、ys から r 個を選ぶ組み合わせを求めます。あとは 2 つのリストを関数 concat で連結するだけです。
このプログラムのポイントは引数 xs が空リストになったら、空リスト () を返すところです。concat でリスト xs と () を連結すると xs になるので、空リストを返しても正常に動作するわけです。
それでは実行してみましょう。
user=> (combinations '(1 2 3 4 5) 2) ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5)) user=> (combinations '(1 2 3 4 5) 3) ((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5)) user=> (combinations '(1 2 3 4 5) 4) ((1 2 3 4) (1 2 3 5) (1 2 4 5) (1 3 4 5) (2 3 4 5))
正常に動作していますね。
もうひとつ、組み合わせをリストに格納して返すプログラムを紹介します。
リスト : 組み合わせの生成 (3)
(defn combinations'
([xs r] (combinations' xs r '() '()))
([[y & ys :as xs] r a b]
(cond
(zero? r) (cons (reverse a) b)
(not (seq xs)) b
:else (combinations' ys (dec r) (cons y a) (combinations' ys r a b)))))
関数 combinations' は生成した組み合わせ (引数 a) を引数 b のリストに格納し、それをそのまま返します。combinations' を呼び出す場合、この返り値を引数 b に渡すことで、生成した組み合わせを格納していくことができます。
具体的には、combinations' を再帰呼び出しするところで、1 回目の呼び出しの返り値を 2 回目の呼び出しの第 4 引数に渡します。それから、引数 xs が空リストのときは引数 b をそのまま返します。これで生成した組み合わせをリストに格納することができます。
それでは実行してみましょう。
user=> (combinations' '(1 2 3 4 5) 2) ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5)) user=> (combinations' '(1 2 3 4 5) 3) ((1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5)) user=> (combinations' '(1 2 3 4 5) 4) ((1 2 3 4) (1 2 3 5) (1 2 4 5) (1 3 4 5) (2 3 4 5))
実行結果は当然ですが同じです。これでも生成した組み合わせをリストに格納して返すことができます。
次に示す関数を定義してください。
リスト : xs の中から n 個を選ぶ順列
(defn permutations [n xs]
(if (zero? n)
'(())
(mapcat (fn [x]
(map (fn [ys] (cons x ys))
(permutations (dec n) (remove #(= x %) xs))))
xs)))
関数 permutations は再帰呼び出しの停止条件を (zero? n) に変更するだけです。
user=> (permutations 1 '(a b c d)) ((a) (b) (c) (d)) user=> (permutations 2 '(a b c d)) ((a b) (a c) (a d) (b a) (b c) (b d) (c a) (c b) (c d) (d a) (d b) (d c)) user=> (permutations 3 '(a b c d)) ((a b c) (a b d) (a c b) (a c d) (a d b) (a d c) (b a c) (b a d) (b c a) (b c d) (b d a) (b d c) (c a b) (c a d) (c b a) (c b d) (c d a) (c d b) (d a b) (d a c) (d b a) (d b c) (d c a) (d c b)) user=> (permutations 4 '(a b c d)) ((a b c d) (a b d c) (a c b d) (a c d b) (a d b c) (a d c b) (b a c d) (b a d c) (b c a d) (b c d a) (b d a c) (b d c a) (c a b d) (c a d b) (c b a d) (c b d a) (c d a b) (c d b a) (d a b c) (d a c b) (d b a c) (d b c a) (d c a b) (d c b a))
リスト : 重複順列
(defn repeat-perm [n xs]
(if (zero? n)
'(())
(mapcat (fn [x]
(map (fn [ys] (cons x ys))
(repeat-perm (dec n) xs)))
xs)))
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat-perm を再帰呼び出しするとき、リスト xs をそのまま渡すだけです。
user=> (repeat-perm 2 '(a b c)) ((a a) (a b) (a c) (b a) (b b) (b c) (c a) (c b) (c c)) user=> (repeat-perm 3 '(a b c)) ((a a a) (a a b) (a a c) (a b a) (a b b) (a b c) (a c a) (a c b) (a c c) (b a a) (b a b) (b a c) (b b a) (b b b) (b b c) (b c a) (b c b) (b c c) (c a a) (c a b) (c a c) (c b a) (c b b) (c b c) (c c a) (c c b) (c c c))
リスト : 重複組み合わせ
(defn repeat-comb [[y & ys :as xs] r]
(cond
(zero? r) '(())
(not (seq xs)) '()
:else (concat (map (fn [zs] (cons y zs))
(repeat-comb xs (dec r)))
(repeat-comb ys r))))
重複組み合わせを求める repeat-comb も簡単です。最後の節で、先頭の要素を選んで repeat-comb を再帰呼び出しするとき、先頭要素を取り除かないで xs から r - 1 個の要素を選びます。
user=> (repeat-comb '(a b c d) 2) ((a a) (a b) (a c) (a d) (b b) (b c) (b d) (c c) (c d) (d d)) user=> (repeat-comb '(a b c d) 3) ((a a a) (a a b) (a a c) (a a d) (a b b) (a b c) (a b d) (a c c) (a c d) (a d d) (b b b) (b b c) (b b d) (b c c) (b c d) (b d d) (c c c) (c c d) (c d d) (d d d))
リスト : 完全順列
(defn derangement
([func m] (derangement func m 0 '()))
([func m n a]
(if (= n m)
(func (reverse a))
(dotimes [x m]
(when (and (not= x n)
(neg? (.indexOf a x)))
(derangement func m (inc n) (cons x a)))))))
引数 n が順番を、a が順列を表します。dotimes で 0 から m - 1 までの整数を生成して変数 x にセットします。数字 x が n と等しくなく、かつ a に含まれていない場合、その数字を選択することできます。n が m と等しくなったら順列がひとつ完成しました。reverse で a を反転して func を評価します。これで完全順列を生成することができます。
user=> (derangement println 3) (1 2 0) (2 0 1) nil user=> (derangement println 4) (1 0 3 2) (1 2 3 0) (1 3 0 2) (2 0 3 1) (2 3 0 1) (2 3 1 0) (3 0 1 2) (3 2 0 1) (3 2 1 0) nil
リスト : 要素の選択
(defn selects [[z & zs]]
(if-not (seq zs)
(list (list z '()))
(cons (list z zs)
(map (fn [[y ys]] (list y (cons z ys)))
(selects zs)))))
分配束縛で引数のリストを先頭要素 z と残りの要素 zs に分解します。次に、zs が空リストかチェックします。そうであれば (z ()) をリストに格納して返します。これが再帰呼び出しの停止条件です。
if の else 節で、先頭要素 z を選ぶ場合は (z zs) とします。先頭以外の要素を選択する場合は、zs に対して select を再帰呼び出しし、map に渡す無名関数の引数 ys に z を追加します。あとは、map の返り値に (z zs) を追加するだけです。
user=> (selects '(a b c)) ((a (b c)) (b (a c)) (c (a b))) user=> (selects '(a b c d)) ((a (b c d)) (b (a c d)) (c (a b d)) (d (a b c))) user=> (selects '(a b a c)) ((a (b a c)) (b (a a c)) (a (a b c)) (c (a b a)))
ところで、関数 permutation や permutations はリストに重複要素があると正常に動作しません。
user=> (permutations '(a b c d)) ((a b c d) (a b d c) (a c b d) (a c d b) (a d b c) (a d c b) (b a c d) (b a d c) (b c a d) (b c d a) (b d a c) (b d c a) (c a b d) (c a d b) (c b a d) (c b d a) (c d a b) (c d b a) (d a b c) (d a c b) (d b a c) (d b c a) (d c a b) (d c b a)) user=> (permutations '(a b a c)) ((a b c) (a c b) (b a c) (b a c) (b c a) (b c a) (a b c) (a c b) (c a b) (c b a) (c b a) (c a b))
問題 5 で作成した selects を使うと、リストに重複要素があっても順列を生成することができます。ただし、返り値のリストには同じ順列が含まれています。
useer=> (permutations '(a b a c)) ((a b a c) (a b c a) (a a b c) (a a c b) (a c b a) (a c a b) (b a a c) (b a c a) (b a a c) (b a c a) (b c a a) (b c a a) (a a b c) (a a c b) (a b a c) (a b c a) (a c a b) (a c b a) (c a b a) (c a a b) (c b a a) (c b a a) (c a a b) (c a b a)) user=> (distinct (permutations '(a b a c))) ((a b a c) (a b c a) (a a b c) (a a c b) (a c b a) (a c a b) (b a a c) (b a c a) (b c a a) (c a b a) (c a a b) (c b a a))
この場合、関数 distinct で重複要素を削除すれば正しい順列を求めることができます。
もう一つ簡単な方法があります。remove は条件を満たす要素をすべて削除します。このため、重複要素があると正常に動作しません。そこで、要素を一つだけ削除する関数 remove-one を作ります。
リスト : pred を満たす要素を一つだけ削除する
(defn remove-one [pred [y & ys :as xs]]
(cond
(not (seq xs)) '()
(pred y) ys
:else (cons y (remove-one pred ys))))
(pred y) が真を返す場合、残りのリスト ys をそのまま返すだけです。これで、最初に見つけた要素を一つだけ削除することができます。それでは実行してみましょう。
user=> (remove-one #(= 'b %) '(a b c d)) (a c d) user=> (remove-one #(= 'b %) '(a b c b d)) (a c b d) user=> (remove-one #(= 'b %) '(a c d e)) (a c d e)
remove のかわりに remove-one を呼び出すと、問題 5 で作成した selects を使わなくても順列を生成することができます。
リスト : 順列の生成
(defn permutations' [xs]
(if-not (seq xs)
'(())
(mapcat (fn [x]
(map (fn [ys] (cons x ys))
(permutations' (remove-one #(= x %) xs))))
xs)))
user=> (permutations' '(a b a c)) ((a b a c) (a b c a) (a a b c) (a a c b) (a c b a) (a c a b) (b a a c) (b a c a) (b a a c) (b a c a) (b c a a) (b c a a) (a b a c) (a b c a) (a a b c) (a a c b) (a c b a) (a c a b) (c a b a) (c a a b) (c b a a) (c b a a) (c a b a) (c a a b)) user=> (distinct (permutations' '(a b a c))) ((a b a c) (a b c a) (a a b c) (a a c b) (a c b a) (a c a b) (b a a c) (b a c a) (b c a a) (c a b a) (c a a b) (c b a a))