今回は簡単な例題として、「順列 (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 &optional a
permutation の引数 XS には選択していない数を格納したリストを渡し、オプショナル引数 A には選んだ数を格納するリストを渡します。最初に呼び出すときは (permutation '(1 2 3 4)) とします。まだ数を選択していないので、XS は (1 2 3 4) となり、A は NIL となります。数は 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 の動作 (その２)
それではプログラムを作りましょう。今回はプログラムを簡単にするため、引数のリストの中には重複要素が無いことを前提とします。次のリストを見てください。
リスト : 順列の生成
(defun permutation (xs &optional a)
(if (null xs)
(print (reverse a))
(dolist (x xs)
(permutation (remove x xs) (cons x a)))))
permutation の引数 XS が空リストの場合、順列がひとつ完成したので print で画面へ出力します。reverse でリストを反転していることに注意してください。そうでなければ、リスト XS から要素を順番に選んでいきます。これは dolist を使えば簡単ですね。dolist の中で permutation を再帰呼び出しするとき、remove で XS から X を削除し、cons で X を引数 A のリストに追加します。
それでは実行してみましょう。
* (permutation '(1 2 3)) (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1) NIL * (permutation '(1 2 3 4)) (1 2 3 4) (1 2 4 3) (1 3 2 4) ・・省略・・ (4 2 3 1) (4 3 1 2) (4 3 2 1) NIL
正常に動作していますね。
ところで、関数 permutation は順列を画面へ出力しましたが、高階関数にしたほうが便利でしょう。プログラムは次のようになります。
リスト : 順列の生成 (高階関数版)
(defun permutation (fn xs &optional a)
(if (null xs)
(funcall fn (reverse a))
(dolist (x xs)
(permutation fn (remove x xs) (cons x a)))))
関数 permutation の引数 FN が関数です。あとは、順列を表示する処理を関数 FN の呼び出しに変えただけです。とても簡単ですね。たとえば、FN に #'print を渡せば、順列をすべて表示することができます。
次は生成した順列をリストに格納して返すプログラムを作ります。いろいろな方法が考えられますが、一番簡単なのは高階関数 permutation を使うことです。次のリストを見てください。
リスト : 順列の生成 (2)
(defun permutation-list (xs)
(let (zs)
(permutation (lambda (ys) (push ys zs)) xs)
(nreverse zs)))
* (permutation-list '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) * (permutation-list '(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))
permutation に渡すラムダ式の中で、順列 ys を局所変数 zs に追加するだけです。とても簡単ですね。
次は permutation を使わないでプログラムを作ってみましょう。最初に、リストから要素を一つ選んで、選んだ要素と残りの要素を返す関数 select を考えます。select の動作例を示します。
* (select '(1 2)) ((1 (2)) (2 (1))) * (select '(1 2 3)) ((1 (2 3)) (2 (1 3)) (3 (1 2))) * (select '(1 2 3 4)) ((1 (2 3 4)) (2 (1 3 4)) (3 (1 2 4)) (4 (1 2 3)))
select の返り値はリストで、その要素はリスト (選択した要素 (残りの要素 ...)) です。最後の例のように、リスト (1 2 3 4) を select に渡せば、((1 ...) (2 ...) (3 ...) (4 ...)) というリストを返します。... は残りの要素を格納したリストです。
リストに重複要素がないことを前提にすると、select はとても簡単です。
リスト : 要素の選択 (defun select (xs) (mapcar (lambda (x) (list x (remove x xs))) xs))
mapcar で要素 X を順番に取り出します。あとはラムダ式で、X と (remove x xs) をリストに格納して返すだけです。
select を使うと順列の生成は簡単です。(select xs) でリスト XS の要素を選択します。次に、残りの要素で順列を生成します。そして、選んだ要素を順列 (リスト) の先頭に追加すれば、その要素から始まる順列を生成することができます。あとは選んだ要素に対してこの処理を繰り返し適用して、順列をひとつのリストにまとめればいいわけです。
このような処理はマッピングを二重に使うと簡単に実現できます。次の例を見てください。
* (mapcar (lambda (x) (cons 5 x)) '((1) (2) (3) (4) (5))) ((5 1) (5 2) (5 3) (5 4) (5 5)) * (mapcar (lambda (y) (mapcar (lambda (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 を追加したい場合、mapcar を使うと簡単ですね。次は、リスト (5 6) の各要素を追加したリストを求めることを考えます。mapcar を二重にして、(5 6) の要素を匿名関数の引数 Y に渡します。次の mapcar で Y をリストに追加します。すると、返り値のリストには 5 を追加したリストと 6 を追加したリストが格納されます。mapcar を二重にしているので、リストの階層が 1 段深くなるわけです。
そこで、リストを一段階だけ平坦化 (リストを破壊的に連結) する関数 mapcan を使います。
* (mapcan (lambda (y) (mapcar (lambda (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)
(defun permutation-list (xs)
(if (null xs)
'(())
(mapcan (lambda (ys)
(mapcar (lambda (zs) (cons (car ys) zs))
(permutation-list (second ys))))
(select xs))))
引数 XS が空リストならば空リストを格納したリスト (()) を返します。これが再帰呼び出しの停止条件になります。そうでなければ、(select xs) で要素を選択して mapcan に渡します。次に、そのラムダ式の中で permutation-list に残りの要素のリスト (second ys) を渡して順列を生成します。あとは mapcar で生成した順列の先頭に選択した要素 (car ys) を追加するだけです。
それでは実行してみましょう。
* (permutation-list '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) * (permutation-list '(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))
正常に動作していますね。
今回はリストに重複要素がないことが前提なので、実をいうと select を使わなくても簡単にプログラムすることができます。次のリストを見てください。
リスト : 順列の生成 (4)
(defun permutation-list (xs)
(if (null xs)
'(())
(mapcan (lambda (x)
(mapcar (lambda (ys) (cons x ys))
(permutation-list (remove x xs))))
xs)))
引数 XS をそのまま mapcan に渡します。mapcan のラムダ式の引数 X が選んだ要素になります。そして、permutation-list を再帰呼び出しするとき、(remove x xs) で XS から X を取り除いたリストを渡します。あとは select を使った場合と同じです。
もうひとつ、順烈をリストに格納して返すプログラムを紹介します。
リスト : 順列の生成 (5)
(defun permutation-list (xs &optional a b)
(if (null xs)
(cons (reverse a) b)
(reduce (lambda (x ys)
(permutation-list (remove x xs) (cons x a) ys))
xs
:initial-value b
:from-end t)))
関数 permutation-list は、オプショナル引数 A に要素を追加していき、完成した順列をオプショナル引数 B に格納します。最初に、引数 XS が空リストになったかチェックします。そうであれば順列が一つ完成したので、reverse で A を反転してから B に追加して返します。permutation-list を呼び出す場合、この返り値を引数 B に渡すことで、生成した順列を格納していくことができます。
if の else 節で、reduce の初期値に B を指定することで、ラムダ式の引数 YS に順列を格納するリストを渡します。あとは permutation-list を再帰呼び出しすると、その返り値は次にラムダ式を呼び出すとき引数 YS に渡されるので、順列を格納したリストを permutation-list に渡していくことができます。
それでは実行してみましょう。
* (permutation-list '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) * (permutation-list '(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))
実行結果は当然ですが同じです。これでも生成した順列をリストに格納して返すことができます。
今度は \({}_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 個を選ぶ組み合わせを生成すればいいわけです。けっきょく、この処理の考え方は次に示す組み合わせの公式と同じです。
プログラムは次のようになります。
リスト : 組み合わせの生成
(defun combination (fn xs r &optional a)
(cond
((zerop r)
(funcall fn (reverse a)))
((null xs) nil)
(t
(combination fn (cdr xs) (1- r) (cons (car xs) a))
(combination fn (cdr xs) r a))))
関数 combination は引数 XS のリストから R 個を選ぶ組み合わせを生成して関数 FN を適用します。選んだ数字はオプショナル引数 A に格納します。R が 0 になったら組み合わせを一つ生成できたので、A を reverse で逆順にして関数 FN を呼び出します。XS が空リストならば何もしないで NIL を返します。この 2 つの条件が再帰呼び出しの停止条件になります。
最後の節は XS が空リストでない場合です。ここで combination を再帰呼び出しします。最初の呼び出しは先頭の要素を選択する場合です。先頭要素を A に追加して、リスト (cdr xs) の中から R - 1 個を選びます。最後の呼び出しが先頭の要素を選ばない場合です。リスト (cdr xs) の中から R 個を選びます。
プログラムはこれで完成です。簡単な実行例を示しましょう。
* (combination #'print '(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 * (combination #'print '(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
正常に動作していますね。
次は生成した組み合わせをリストに格納して返すプログラムを作ります。高階関数 combination を使わない場合、プログラムは次のようになります。
リスト ; 組み合わせの生成 (2)
(defun combination-list (xs r)
(cond
((zerop r) '(()))
((null xs) nil)
(t (append (mapcar (lambda (ys) (cons (car xs) ys))
(combination-list (cdr xs) (1- r)))
(combination-list (cdr xs) r)))))
関数 combination-list は XS の中から R 個を選ぶ組み合わせを生成します。cond の最初の節で、R が 0 ならば要素を選び終わったので、空リストを格納したリストを返します。2 番目の節で、XS が空リストならば NIL を返します。この 2 つが再帰呼び出しの停止条件になります。
最後の節で combination-list を再帰呼び出しします。最初の呼び出しでは先頭要素 (car xs) を選びます。残りのリスト (cdr xs) から R - 1 個を選ぶ組み合わせを生成して、その先頭に選んだ要素 (car xs) を追加します。2 番目の呼び出しでは、(cdr xs) から R 個を選ぶ組み合わせを求めます。あとは 2 つのリストを関数 append で連結するだけです。
このプログラムのポイントは引数 XS が空リストになったら、空リスト (NIL) を返すところです。append でリスト XS と NIL を連結すると XS になるので、空リストを返しても正常に動作するわけです。
それでは実行してみましょう。
* (combination-list '(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)) * (combination-list '(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)) * (combination-list '(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)
(defun combination-list (xs r &optional a b)
(cond
((zerop r)
(cons (reverse a) b))
((null xs) b)
(t
(combination-list
(cdr xs)
(1- r)
(cons (car xs) a)
(combination-list (cdr xs) r a b)))))
関数 combination-list は生成した組み合わせ (引数 A) を引数 B のリストに格納し、それをそのまま返します。combination-list を呼び出す場合、この返り値を引数 B に渡すことで、生成した組み合わせを格納していくことができます。
具体的には、combination-list を再帰呼び出しするところで、1 回目の呼び出しの返り値を 2 回目の呼び出しの第 4 引数に渡します。それから、引数 XS が空リストのときは引数 B をそのまま返します。これで生成した組み合わせをリストに格納することができます。
それでは実行してみましょう。
* (combination-list '(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)) * (combination-list '(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)) * (combination-list '(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 個を選ぶ順列
(defun permutations (n xs)
(if (zerop n)
'(())
(mapcan (lambda (x)
(mapcar (lambda (ys) (cons x ys))
(permutations (1- n) (remove x xs))))
xs)))
関数 permutations は再帰呼び出しの停止条件を (zerop n) に変更するだけです。
* (permutations 1 '(a b c d)) ((A) (B) (C) (D)) * (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)) * (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)) * (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))
リスト : 重複順列
(defun repeat-perm (n xs)
(if (zerop n)
'(())
(mapcan (lambda (x)
(mapcar (lambda (ys) (cons x ys))
(repeat-perm (1- n) xs)))
xs)))
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat-perm を再帰呼び出しするとき、リスト XS をそのまま渡すだけです。
* (repeat-perm 2 '(a b c)) ((A A) (A B) (A C) (B A) (B B) (B C) (C A) (C B) (C C)) * (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))
リスト : 重複組み合わせ
(defun repeat-comb (xs r)
(cond
((zerop r) '(()))
((null xs) nil)
(t (append (mapcar (lambda (ys) (cons (car xs) ys))
(repeat-comb xs (1- r)))
(repeat-comb (cdr xs) r)))))
重複組み合わせを求める repeat-comb も簡単です。最後の節で、先頭の要素を選んで repeat-comb を再帰呼び出しするとき、先頭要素を取り除かないで XS から R - 1 個の要素を選びます。
* (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)) * (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))
リスト : 完全順列
(defun derangement (fn m &optional (n 0) a)
(if (= n m)
(funcall fn (reverse a))
(dotimes (x m)
(when (and (/= x n)
(not (member x a)))
(derangement fn m (1+ n) (cons x a))))))
オプショナル引数 N が順番を、A が順列を表します。dotimes で 0 から M - 1 までの整数を生成して変数 X にセットします。数字 X が N と等しくなく、かつ A に含まれていない場合、その数字を選択することできます。N が M と等しくなったら順列がひとつ完成しました。reverse で A を反転して関数 FN を評価します。これで完全順列を生成することができます。
* (derangement #'print 3) (1 2 0) (2 0 1) NIL * (derangement #'print 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
リスト : 要素の選択
(defun select (xs)
(let ((z (car xs)) (zs (cdr xs)))
(if (null zs)
(list (list z nil))
(cons (list z zs)
(mapcar (lambda (ys)
(list (car ys) (cons z (second ys))))
(select zs))))))
最初に XS を先頭要素 Z と残りの要素 ZS に分解します。次に、ZS が空リストかチェックします。そうであれば (Z NIL) をリストに格納して返します。これが再帰呼び出しの停止条件です。
if の else 節で、先頭要素 Z を選ぶ場合は (Z ZS) とします。先頭以外の要素を選択する場合は、ZS に対して select を再帰呼び出しし、mapcar に渡すラムダ式の引数 YS の第 2 要素 (second ys) に Z を追加します。あとは、mapcar の返り値に (Z ZS) を追加するだけです。
* (select '(a b c)) ((A (B C)) (B (A C)) (C (A B))) * (select '(a b c d)) ((A (B C D)) (B (A C D)) (C (A B D)) (D (A B C))) * (select '(a b a c)) ((A (B A C)) (B (A A C)) (A (A B C)) (C (A B A)))
ところで、関数 permutation や permutation-list はリストに重複要素があると正常に動作しません。
* (permutation-list '(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)) * (permutation-list '(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 で作成した select を使うと、リストに重複要素があっても順列を生成することができます。ただし、返り値のリストには同じ順列が含まれています。
* (permutation-list '(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)) * (remove-duplicates (permutation-list '(a b a c)) :test #'equal) ((B A A C) (B A C 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 B A A) (C A A B) (C A B A))
この場合、remove-duplicates で重複要素を削除すれば正しい順列を求めることができます。
もう一つ簡単な方法があります。remove で要素を削除するときキーワード引数 :count に 1 を指定します。これで順列を生成することができますが、返り値のリストには同じ順列が含まれます。あとは、順列を一つ生成したら、同じ順列がないかチェックすればいいでしょう。プログラムは次のようになります。
リスト : 重複要素を含む順列の生成
(defun permutation-list (xs &optional a b)
(if (null xs)
(adjoin (reverse a) b :test #'equal)
(reduce (lambda (x ys)
(permutation-list (remove x xs :count 1) (cons x a) ys))
xs
:initial-value b
:from-end t)))
関数 adjoin は次の式と同じ動作をします。
(adjon x xs) ≡ (if (member x xs) xs (cons x xs))
adjoin はキーワード引数 :test, :test-not, :key を使用することができます。これで重複した順列を削除することができます。それでは実行してみましょう。
* (permutation-list '(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)) * (permutation-list '(a b a c)) ((B A A C) (B A C 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 B A A) (C A B A) (C A A B)) * (permutation-list1 '(a b a b)) ((A A B B) (A B A B) (A B B A) (B A A B) (B A B A) (B B A A))
正常に動作していますね。ただし、順列の総数が多くなると adjoin でのチェックに時間がかかるようになります。ご注意くださいませ。