今回は「順列 (permutation)」と「組み合わせ (combination)」を取り上げます。なお、Gauche には順列と組み合わせを求めるライブラリ (util.combinations) が用意されていますが、Scheme のお勉強ということで実際にプログラムを作ってみましょう。
たとえば 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 以外の道を選ぶことになります。あとは同様に道をたどっていけば、すべての並べ方を求めることができます。
それでは、プログラムを作ってみます。ここまでの説明で、バックトラック法の実現は難しいのではないか、と思った方はいませんか。「進む」ことと「戻る」ことをどのようにプログラムしたらよいのか、見当もつかないという人もいるかもしれません。ところがバックトラック法は、今までに何回も使ってきた「再帰呼び出し」を利用すると、とても簡単に実現できるのです。
まず、「進む」場合を再帰呼び出しに対応させます。そうすると、ひとつ手前の位置に戻ることは、呼び出し元の関数に戻ることに対応させることができるのです。つまり、関数の評価を終了すれば、元の位置に「バックトラック」できるわけです。
具体的に説明しましょう。まず、順列を生成する関数を perm と定義します。perm の第 1 引数には選択していない数を格納したリストを渡し、第 2 引数には選んだ数を格納するリストを渡します。最初に呼び出すときは、次のようになります。
(perm '(1 2 3 4) '())
まだ数を選択していないので、第 1 引数は (1 2 3 4) となり、第 2 引数は () となります。数は第 1 引数のリストの中から選びます。再帰呼び出しする場合、選んだ数をリストから削除するとともに、第 2 引数のリストへ追加します。次の図を見てください。
perm 第 1 引数 第 2 引数
----------------------------------
│ (1 2 3 4) ()
│ ^
再 ↓
帰 │ (2 3 4) (1)
呼 │ ^
び ↓
出 │ (3 4) (2 1)
し │ ^
↓
│ (4) (3 2 1)
│ ^
↓
() (4 3 2 1) 並べ方完成
図 : 関数 perm の動作 (その１)
最初は (1 2 3 4) の中から数を選びます。このとき、リストの先頭から順番に数を選んでいきます。最初は 1 を選びますが、バックトラックしたときは、次の 2 を選ぶようにします。再帰呼び出しするときは、第 1 引数のリストから 1 を削除し、それを第 2 引数のリストに追加します。数はリストの先頭へ追加していくので、並べ方が逆になることに注意してください。
このように、再帰呼び出しを続けていくと、第 1 引数は空リストになります。ここが、再帰呼び出しの停止条件となり、第 2 引数には数の並びが逆順にセットされています。これを出力すればいいわけです。
次に、新しい組み合わせを探すため、バックトラックを行います。次の図を見てください。
perm 第 1 引数 第 2 引数
-----------------------------------
│ nil (4 3 2 1)
バック │
トラック↓
│ (4) (3 2 1)
バック │ X
トラック↓
│ (3 4) (2 1)
再帰 │ X ^
↓
│ (3) (4 2 1)
再帰 │ ^
↓
() (3 4 2 1) 組み合わせ完成
図 : 関数 perm の動作 (その２)
バックトラックすると、第 1 引数が (4) で第 2 引数が (3 2 1) の状態に戻ります。ここで、次の数を選ぶのですが、もうリストには数がありません。そこで、再度バックトラックします。すると、第 1 引数が (3 4) で第 2 引数が (2 1) の状態に戻ります。このときは、3 の次である 4 を選びます。第 1 引数 (3 4) から 4 を取り除いた (3) と、第 2 引数 (2 1) に 4 を追加した (4 2 1) を与えて再帰呼び出しします。あとは、同じことを繰り返すことで、順列をすべて求めることができるわけです。
それでは、プログラムを示します。
リスト : 順列の生成
;;; x と等しい要素を削除する
(define (remove x ls)
(cond
((null? ls) '())
((equal? (car ls) x)
(remove x (cdr ls)))
(else
(cons (car ls) (remove x (cdr ls))))))
;;; 順列の生成
(define (perm ls a)
(cond
((null? ls)
(display (reverse a))
(newline))
(else
(for-each
(lambda (x)
(perm (remove x ls) (cons x a)))
ls))))
関数 remove はリスト ls から引数 x と等しい要素を削除します。等値の判定には equal? を使っているので、シンボルや数値だけではなく、文字列にも対応することができます。なお、SRFI-1 には remove が高階関数として定義されています。
remove pred ls
SRFI-1 の remove は述語 pred が真を返す要素をリスト ls から削除します。
順列を生成する関数 perm は簡単です。引数 ls が数字を格納するリストで、引数 a に選んだ数字が格納されます。ls が空リストの場合、順列がひとつ完成したので、display で画面へ出力します。reverse でリストを反転していることに注意してください。そうでなければ、第 1 引数のリストから数を順番に選んでいきます。この処理は for-each という高階関数を使うと簡単です。
for-each func list
for-each は R5RS, R7RS-small に定義されている関数で、引数のリストから順番に要素を取り出して、それを引数 func に渡して評価します。map と違って for-each は func を呼び出すだけであり、func の返り値は捨てられます。for-each は副作用を目的とした関数を呼び出すときに使います。Gauche の場合、for-each の返り値は #<undef> です。
簡単な例を示しましょう。
gosh[r7rs.user]> (define (foo x) (display x) (newline)) foo gosh[r7rs.user]> (for-each foo '(1 2 3 4 5)) 1 2 3 4 5 #<undef>
perm の説明に戻ります。for-each の繰り返しが終了すれば perm の評価も終了するので、選ぶ数がなくなったらバックトラックするという処理を実現することができます。
それでは実行してみましょう。
gosh[r7rs.user]> (perm '(1 2 3 4) '()) (1 2 3 4) ・・省略・・ (4 3 2 1) gosh[r7rs.user]> (perm '(1 2 3) '()) (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)
正常に動作していますね。
ところで、関数 perm は順列を画面へ出力しましたが、高階関数にしたほうが便利でしょう。プログラムは次のようになります。
リスト : 順列の生成 (高階関数版)
(define (permutations func ls)
(define (perm ls a)
(if (null? ls)
(func (reverse a))
(for-each
(lambda (n)
(perm (remove n ls) (cons n a)))
ls)))
(perm ls '()))
関数 permutations の引数 func が関数で、ls がリストです。局所関数 perm は順列を表示する処理を関数 func の呼び出しに変えただけです。あとは perm を呼び出すだけです。とても簡単ですね。たとえば、(lambda (x) (display x) (newline)) を渡せば、順列をすべて表示することができます。
gosh[r7rs.user]> (permutations (lambda (x) (display x) (newline)) '(1 2 3)) (1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1) #<undef>
生成した順列をリストに格納して返す場合は、畳み込み関数 foldr を使うと簡単です。プログラムは次のようになります。
リスト : 順列の生成 (2)
;;; 畳み込み
(define (foldr fn a xs)
(if (null? xs)
a
(fn (car xs) (foldr fn a (cdr xs)))))
(define (permutations-list ls)
(define (perm ls a b)
(if (null? ls)
(cons (reverse a) b)
(foldr
(lambda (x y)
(perm (remove x ls) (cons x a) y))
b
ls)))
(perm ls '() '()))
局所関数 perm は生成した順列を引数 b のリストに格納して、それをそのまま返します。perm を呼び出す場合、この返り値を引数 b に渡すことで、生成した順列を格納していくことができます。ここで foldr が役に立ちます。
foldr の初期値を perm の引数 b にすることで、ラムダ式 (lambda (x y) ...) の引数 y に順列を格納するリストを渡します。あとは perm を再帰呼び出しすると、その返り値は次にラムダ式 (lambda (x y) ...) を呼び出すときの引数 y に渡されるので、順列を格納したリストを perm に渡していくことができます。
それでは実行結果を示します。
gosh[r7rs.user]> (permutations-list '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
正常に動作していますね。
次は foldr を使わないでプログラムを作ってみましょう。最初に、リストから要素を一つ選んで、選んだ要素と残りの要素を返す関数 select を考えます。select の動作例を示します。
gosh[r7rs.user]> (select '(1 2)) ((1 (2)) (2 (1))) gosh[r7rs.user]> (select '(1 2 3)) ((1 (2 3)) (2 (1 3)) (3 (1 2))) gosh[r7rs.user]> (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 はとても簡単です。
リスト : 要素の選択 (define (select xs) (map (lambda (x) (list x (remove x xs))) xs))
map で要素 x を順番に取り出します。あとはラムダ式で、x と (remove x xs) をリストに格納して返すだけです。
select を使うと順列の生成は簡単です。(select xs) でリスト xs の要素を選択します。次に、残りの要素で順列を生成します。そして、選んだ要素を順列 (リスト) の先頭に追加すれば、その要素から始まる順列を生成することができます。あとは選んだ要素に対してこの処理を繰り返し適用して、順列をひとつのリストにまとめればいいわけです。
このような処理はマッピングを二重に使うと簡単に実現できます。次の例を見てください。
gosh[r7rs.user]> (map (lambda (x) (cons 5 x)) '((1) (2) (3) (4) (5))) ((5 1) (5 2) (5 3) (5 4) (5 5)) gosh[r7rs.user]> (map (lambda (y) (map (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 を追加したい場合、map を使うと簡単ですね。次は、リスト (5 6) の各要素を追加したリストを求めることを考えます。map を二重にして、(5 6) の要素をラムダ式の引数 y に渡します。次の map で y をリストに追加します。すると、返り値のリストには 5 を追加したリストと 6 を追加したリストが格納されます。map を二重にしているので、リストの階層が 1 段深くなるわけです。
そこで、リストを一段階だけ平坦化 (リストを破壊的に連結) する関数 flatmap を使います。
gosh[r7rs.user]> (define (flatmap fn xs) (apply append (map fn xs))) flatmap gosh[r7rs.user]> (flatmap (lambda (y) (map (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)
(define (permutation-list xs)
(if (null? xs)
'(())
(flatmap (lambda (ys)
(map (lambda (zs) (cons (car ys) zs))
(permutation-list (cadr ys))))
(select xs))))
引数 xs が空リストならば空リストを格納したリスト (()) を返します。これが再帰呼び出しの停止条件になります。そうでなければ、(select xs) で要素を選択して flatmap に渡します。次に、そのラムダ式の中で permutation-list に残りの要素のリスト (cadr ys) を渡して順列を生成します。あとは map で生成した順列の先頭に選択した要素 (car ys) を追加するだけです。
それでは実行してみましょう。
gosh[r7rs.user]> (permutation-list '(1 2 3)) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) gosh[r7rs.user]> (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)
(define (permutation-list xs)
(if (null? xs)
'(())
(flatmap (lambda (x)
(map (lambda (ys) (cons x ys))
(permutation-list (remove x xs))))
xs)))
引数 xs をそのまま flatmap に渡します。flatmap のラムダ式の引数 x が選んだ要素になります。そして、permutation-list を再帰呼び出しするとき、(remove x xs) で xs から x を取り除いたリストを渡します。あとは select を使った場合と同じです。
次は組み合わせの数を求めるプログラムを作ってみましょう。組み合わせの数 nＣr を求めるには、次の公式を使えば簡単です。
皆さんお馴染みの公式ですね。ところが、整数値の範囲が限られているプログラミング言語では、この公式を使うと乗算で「桁あふれ」を起こす恐れがあります。Scheme は多倍長演算をサポートしているので、桁あふれを心配する必要はありません。
この公式をそのままプログラムすることもできますが、次の式を使うともっと簡単にプログラムできます。
この式は \({}_n \mathrm{C}_r\) と \({}_n \mathrm{C}_{r-1}\) の関係を表しています。あとは階乗と同じように、再帰定義を使って簡単にプログラムできます。次のリストを見てください。
リスト : 組み合わせの数を求める
(define (comb-num n r)
(if (or (zero? n) (zero? r))
1
(/ (* (comb-num n (- r 1)) (+ (- n r) 1)) r)))
プログラムはとても簡単ですね。ところで、整数値の範囲が限られているプログラミング言語では、この方法でも桁あふれする場合があるので注意してください。
それでは、関数 comb-num を使って「パスカルの三角形」を作ってみましょう。次の図を見てください。
１ 0Ｃ0
／ ＼ ／ ＼
１ １ 1Ｃ0 1Ｃ1
／ ＼ ／ ＼ ／ ＼ ／ ＼
１ ２ １ 2Ｃ0 2Ｃ1 2Ｃ2
／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼
１ ３ ３ １ 3Ｃ0 3Ｃ1 3Ｃ2 3Ｃ3
／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼
１ ４ ６ ４ １ 4Ｃ0 4Ｃ1 4Ｃ2 4Ｃ3 4Ｃ4
図 : パスカルの三角形
パスカルの三角形は、左側の図のように両側がすべて 1 で、内側の数はその左上と右上の和になっています。これは式 \((a + b)^n\) を展開したときの各項の係数を表しています。そして、その値は右側の図のように組み合わせの数 \({}_n \mathrm{C}_r\) に対応しています。
きれいな三角形にはなりませんが、簡単なプログラムを示します。
リスト : パスカルの三角形
(define (pascal x)
(do ((n 0 (+ n 1)))
((> n x))
(do ((r 0 (+ r 1)))
((> r n))
(display (comb-num n r))
(display " "))
(newline)))
do で二重ループを構成しています。最初の do ループで変数 n の値を 0 から x まで +1 ずつ増やし、次の do ループで変数 r の値を 0 から n まで +1 ずつ増やします。あとは comb-num で nＣr の値を計算するだけです。
実行結果は次のようになります。
gosh[r7rs.user]> (pascal 10) 1 1 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1 1 6 15 20 15 6 1 1 7 21 35 35 21 7 1 1 8 28 56 70 56 28 8 1 1 9 36 84 126 126 84 36 9 1 1 10 45 120 210 252 210 120 45 10 1 #t
上図のように、きれいな三角形を出力するプログラムは、皆さんにお任せいたします。また、関数 comb-num を使わないでパスカルの三角形を出力するプログラムを作ってみるのもよいでしょう。
今度は \({}_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 個を選ぶ組み合わせを生成すればいいわけです。けっきょく、この処理の考え方は次に示す組み合わせの公式と同じです。
Scheme でプログラムを作ると次のようになります。
リスト : 組み合わせの生成
(define (combinations func n ls)
(define (comb n ls a)
(cond
((zero? n)
(func (reverse a)))
((pair? ls)
(comb (- n 1) (cdr ls) (cons (car ls) a))
(comb n (cdr ls) a))))
(comb n ls '()))
関数 combinations は、引数 ls のリストから n 個を選ぶ組み合わせを生成して関数 func を適用します。実際の処理は局所関数 comb で行います。選んだ数字は第 3 引数 a のリストに格納します。n が 0 になったら組み合わせを一つ生成できたので、a を reverse で逆順にして func を呼び出します。
次の節で、引数 ls に要素があるならば関数 comb を再帰呼び出しします。最初の呼び出しは先頭の要素を選択する場合です。先頭要素を a に追加して、リスト (cdr ls) の中から n - 1 個を選びます。最後の呼び出しが先頭の要素を選ばない場合です。リスト (cdr ls) の中から n 個を選びます。引数 ls が空リストの場合、処理は何も行われません。
プログラムはこれで完成です。簡単な実行例を示しましょう。
gosh[r7rs.user]> (combinations (lambda (x) (display x) (newline)) 3 '(1 2 3 4 5)) (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)
正常に動作していますね。
生成した組み合わせをリストに格納して返す場合も簡単です。プログラムは次のようになります。
リスト : 組み合わせの生成 (リストに格納)
(define (combinations-list n ls)
(define (comb n ls a b)
(cond
((zero? n)
(cons (reverse a) b))
((pair? ls)
(comb (- n 1)
(cdr ls)
(cons (car ls) a)
(comb n (cdr ls) a b)))
(else b)))
(comb n ls '() '()))
局所関数 comb は、生成した組み合わせを引数 b のリストに格納し、それをそのまま返します。comb を呼び出す場合、この返り値を引数 b に渡すことで、生成した組み合わせを格納していくことができます。具体的には、comb を再帰呼び出しするところで、1 回目の呼び出しの返り値を 2 回目の呼び出しの第 4 引数に渡します。引数 ls が空リストの場合は引数 b をそのまま返します。これで生成した組み合わせをリストに格納することができます。
それでは実行結果を示します。
gosh[r7rs.user]> (combinations-list 3 '(1 2 3 4 5)) ((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))
正常に動作していますね。
もうひとつ、組み合わせをリストに格納して返すプログラムを紹介します。
リスト : 組み合わせの生成 (リストに格納, その２)
(define (combination-list xs r)
(cond
((zero? r) '(()))
((null? xs) '())
(else
(append (map (lambda (ys) (cons (car xs) ys))
(combination-list (cdr xs) (- r 1)))
(combination-list (cdr xs) r)))))
関数 combination-list は xs の中から r 個を選ぶ組み合わせを生成します。cond の最初の節で、r が 0 ならば要素を選び終わったので、空リストを格納したリストを返します。2 番目の節で、xs が空リストならば空リストを返します。この 2 つが再帰呼び出しの停止条件になります。
最後の節で combination-list を再帰呼び出しします。最初の呼び出しでは先頭要素 (car xs) を選びます。残りのリスト (cdr xs) から r - 1 個を選ぶ組み合わせを生成して、その先頭に選んだ要素 (car xs) を追加します。2 番目の呼び出しでは、(cdr xs) から r 個を選ぶ組み合わせを求めます。あとは 2 つのリストを関数 append で連結するだけです。
このプログラムのポイントは引数 xs が空リストになったら、空リストを返すところです。append でリスト xs と空リストを連結すると xs になるので、空リストを返しても正常に動作するわけです。
それでは実行してみましょう。
gosh[r7rs.user]> (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)) gosh[r7rs.user]> (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)) gosh[r7rs.user]> (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))
正常に動作していますね。
次は n 個の中から r 個を選ぶ組み合わせをビットのオンオフで表してみましょう。たとえば、5 個の数字 (0 - 4) から 3 個を選ぶ場合、数字を 0 bit から 4 bit に対応させます。すると、1, 3, 4 という組み合わせは 11010 と表すことができます。これを Scheme でプログラムすると次のようになります。
リスト : 組み合わせの生成 (2)
(define (combinations1 func n r)
(define (comb n r a)
(cond
((zero? r) (func a))
((>= n r)
(comb (- n 1) r a)
(comb (- n 1) (- r 1) (+ (expt 2 (- n 1)) a)))))
(comb n r 0))
関数 combinations1 は n 個の中から r 個を選ぶ組み合わせを生成して出力します。実際の処理は局所関数 comb で行います。組み合わせは引数 a にセットします。r が 0 になったら、組み合わせがひとつできたので関数 func を呼び出します。
r が n 以下の場合は comb を再帰呼び出しします。最初の呼び出しは n 番目の要素を選ばない場合です。n - 1 個の中から r 個を選びます。次の呼び出しが n 番目の要素を選ぶ場合です。関数 expt で 2n-1 を計算して、それを a に加算します。これで、n - 1 番目のビットをオンにすることができます。そして、n - 1 個の中から r - 1 個を選びます。
それでは 5 個の中から 3 個を選ぶ combinations1 の実行例を示します。
gosh[r7rs.user]> (combinations1 (lambda (x) (display x) (newline)) 5 3) 7 11 13 14 19 21 22 25 26 28 #<undef>
7: 00111 11: 01011 13: 01101 14: 01110 19: 10011 21: 10101 22: 10110 25: 11001 26: 11010 28: 11100
この場合、最小値は 00111 (7) で最大値は 11100 (28) になります。このように、combinations1 は組み合わせを表す数を昇順で出力します。ところで、参考文献『Ｃ言語による最新アルゴリズム事典』の「組み合わせの生成」には、再帰呼び出しを使わずに同じ結果を得る方法が解説されてます。とても巧妙な方法なので、興味のある方は読んでみてください。
次に示す関数を定義してください。
リスト : xs の中から n 個を選ぶ順列
(define (permutations n xs)
(if (zero? n)
'(())
(flatmap (lambda (x)
(map (lambda (ys) (cons x ys))
(permutations (- n 1) (remove x xs))))
xs)))
関数 permutations は再帰呼び出しの停止条件を (zero? n) に変更するだけです。
gosh[r7rs.user]> (permutations 1 '(a b c d)) ((a) (b) (c) (d)) gosh[r7rs.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)) gosh[r7rs.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))
リスト : 重複順列
(define (repeat-perm n xs)
(if (zero? n)
'(())
(flatmap (lambda (x)
(map (lambda (ys) (cons x ys))
(repeat-perm (- n 1) xs)))
xs)))
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat-perm を再帰呼び出しするとき、リスト xs をそのまま渡すだけです。
gosh[r7rs.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)) gosh[r7rs.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))
リスト : 重複組み合わせ
(define (repeat-comb xs r)
(cond
((zero? r) '(()))
((null? xs) '())
(else
(append (map (lambda (ys) (cons (car xs) ys))
(repeat-comb xs (- r 1)))
(repeat-comb (cdr xs) r)))))
重複組み合わせを求める repeat-comb も簡単です。最後の節で、先頭の要素を選んで repeat-comb を再帰呼び出しするとき、先頭要素を取り除かないで xs から r - 1 個の要素を選びます。
gosh[r7rs.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)) gosh[r7rs.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))
リスト : 完全順列
(define (derangement fn m)
(let loop ((n 0) (a '()))
(if (= n m)
(fn (reverse a))
(do ((x 0 (+ x 1)))
((>= x m))
(when
(and (not (= x n))
(not (member x a)))
(loop (+ n 1) (cons x a)))))))
named-let の引数 n が順番を、a が順列を表します。do ループで 0 から m - 1 までの整数を生成して変数 x にセットします。数字 x が n と等しくなく、かつ a に含まれていない場合、その数字を選択することできます。n が m と等しくなったら順列がひとつ完成しました。reverse で a を反転して関数 fn を評価します。これで完全順列を生成することができます。
gosh[r7rs.user]> (derangement (lambda (x) (display x) (newline)) 3) (1 2 0) (2 0 1) #t gosh[r7rs.user]> (derangement (lambda (x) (display x) (newline)) 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) #t
リスト : 要素の選択
(define (select xs)
(let ((z (car xs)) (zs (cdr xs)))
(if (null? zs)
(list (list z '()))
(cons (list z zs)
(map (lambda (ys)
(list (car ys) (cons z (cadr ys))))
(select zs))))))
最初に xs を先頭要素 z と残りの要素 zs に分解します。次に、zs が空リストかチェックします。そうであれば (z ()) をリストに格納して返します。これが再帰呼び出しの停止条件です。
if の else 節で、先頭要素 z を選ぶ場合は (z zs) とします。先頭以外の要素を選択する場合は、zs に対して select を再帰呼び出しし、map に渡すラムダ式の引数 ys の第 2 要素 (cadr ys) に z を追加します。あとは、mapcar の返り値に (z zs) を追加するだけです。
gosh[r7rs.user]> (select '(a b c)) ((a (b c)) (b (a c)) (c (a b))) gosh[r7rs.user]> (select '(a b c d)) ((a (b c d)) (b (a c d)) (c (a b d)) (d (a b c))) gosh[r7rs.user]> (select '(a b c d e)) ((a (b c d e)) (b (a c d e)) (c (a b d e)) (d (a b c e)) (e (a b c d))) gosh[r7rs.user]> (select '(a b a b c)) ((a (b a b c)) (b (a a b c)) (a (a b b c)) (b (a b a c)) (c (a b a b)))