今回は簡単な例題として、「順列 (permutation)」と「組み合わせ (combination)」を取り上げます。
異なる n 個の順列の総数は、n の階乗 (n!) だけあります。たとえば、3 つの整数 1, 2, 3 の順列は次に示すように 6 通りあります。
1 2 3, 1 3 2, 2 1 3, 2 3 1, 3 1 2, 3 2 1
順列を生成するプログラムは再帰定義で簡単に作ることができます。[1; 2; 3] の順列を生成する場合、最初に 1 で始まる順列を生成します。これは 1 を取り除いた数字 [2; 3] の順列を生成することで実現できます。次は 2 で始まる順列を生成します。同様に、2 を取り除いた数字 [1; 3] の順列を生成すればいいわけです。[2; 3] や [1; 3] の順列を生成する場合も同じように考えることができます。
ここでは、リストの中から n 個の要素を取り出す順列を求めます。プログラムは次のようになります。
リスト 3 : 順列の生成 (1)
(* int list の表示 *)
let print_intlist xs =
List.iter (fun x -> print_int x; print_string " ") xs;
print_newline ()
(* リストから要素を削除する *)
let rec remove x = function
[] -> []
| y :: ys -> if x = y then remove x ys else y :: remove x ys
(* 順列の生成 *)
let permutation n xs f =
let rec perm n xs a =
if n = 0 then f (List.rev a)
else List.iter (fun x -> perm (n - 1) (remove x xs) (x :: a)) xs
in
perm n xs []
関数 permutation は高階関数で、引数 n が選ぶ要素の個数、引数 xs がリスト、引数 f が生成した順列に適用する関数です。たとえば、順列が数字のリストであれば、int list を表示する関数 print_intlist を渡すことで、生成した順列を表示することができます。実際の処理は局所関数 perm で行います。
perm の引数 n が選ぶ要素の個数、引数 xs がリストです。引数 a は累積変数で、選んだ数字を格納するリストです。n が 0 の場合、順列がひとつ完成したので List.rev で a を逆順にして関数 f に渡します。選んだ数字は a の先頭に追加していくので、逆順になることに注意してください。
n が 0 でなければ、数字を一つ選んで perm を再帰呼び出しします。数字の選択はリストの先頭から順番に行えばいいので、高階関数 List.iter を使っています。iter の定義をリスト 4 に示します
リスト 4 : 高階関数 iter の定義 let rec iter f = function [] -> () | x :: xs -> f x; iter f xs
iter はリストの要素に関数 f を適用します。その結果は捨てられることに注意してください。つまり、副作用を目的とした関数なのです。iter の返り値は unit になります。
匿名関数でリストの要素 x を受け取り、この中で prem を再帰呼び出しします。perm の第 1 引数は n - 1、第 2 引数は xs から x を削除したリスト、第 3 引数は選択した数字のリスト a に x を追加したものです。これで数字 x を選択したことになります。x の削除は関数 remove で行います。
関数 remove はリストから x を探し、見つけた x をすべて削除します。List.filter を使う場合は、次のようになります。
リスト 5 : 要素の削除 let remove x xs = List.filter (fun y -> x <> y) xs
関数 print_intlist は int list を表示します。List.iter を使って print_int で要素を表示します。print_newline は改行を出力する関数です。
それでは、実際に試してみましょう。
# permutation 3 [1; 2; 3] print_intlist;; 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 - : unit = ()
正常に動作していますね。
生成した順列をリストに格納して返す場合は、List.fold_right を使うと簡単です。プログラムは次のようになります。
リスト 6 : 順列の生成 (2)
let permutation_list n xs =
let rec perm n xs a b =
if n = 0 then a::b
else List.fold_right (fun x y -> perm (n-1) (remove x xs) (x::a) y) xs b
in
perm n xs [] []
局所関数 perm は permutation の局所関数を改造したもので、生成した順列を第 4 引数 b のリストに格納します。perm は順列を格納したリスト (第 4 引数) をそのまま返します。perm を呼び出す場合、この返り値を第 4 引数に渡すことで、生成した順列を格納していくことができます。
List.fold_right の初期値 (第 3 引数) に引数 b を渡すことで、匿名関数の第 2 引数 y に順列を格納するリストを渡します。あとは perm を再帰呼び出しすると、その返り値は次に匿名関数を呼び出すときの引数 y に渡されるので、順列を格納したリストを perm に渡していくことができます。
それでは実行結果を示します。
val permutation_list : 'a list -> 'a list list = <fun>
# permutation_list 3 [1; 2; 3];; - : int list list = [[1; 2; 3]; [1; 3; 2]; [2; 1; 3]; [2; 3; 1]; [3; 1; 2]; [3; 2; 1]]
正常に動作していますね。
次は「組み合わせ (combination)」を生成するプログラムを作ってみましょう。たとえば、リスト [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
最初に 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 個を選ぶ組み合わせを生成すればいいわけです。けっきょく、この処理の考え方は次に示す組み合わせの公式と同じです。
これをプログラムすると次のようになります。
リスト 7 : 組み合わせの生成
let combination r xs f =
let rec comb r xs a =
match (r, xs) with
(0, _) -> f (List.rev a)
| (_, []) -> ()
| (_, y::ys) -> comb (r - 1) ys (y::a); comb r ys a
in
comb r xs []
val combination : int -> 'a list -> ('a list -> unit) -> unit = <fun>
局所関数 comb は引数 xs のリストから r 個を選ぶ組み合わせを生成します。選んだ数字は引数 a に格納します。r が 0 になったら組み合わせを一つ生成できたので、a を List.rev で逆順にして関数 f を呼び出します。xs が空リストならば何もしないで unit を返します。この 2 つの条件が再帰呼び出しの停止条件になります。
最後の節は xs が空リストでない場合です。ここで comb を再帰呼び出しします。最初の呼び出しは先頭の要素を選択する場合です。先頭要素を a に追加して、リスト ys の中から r - 1 個を選びます。最後の呼び出しが先頭の要素を選ばない場合です。リスト ys の中から r 個を選びます。
簡単な実行例を示します。
# combination 3 [1; 2; 3; 4; 5] print_intlist;; 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 - : unit = ()
正常に動作していますね。
生成した組み合わせをリストに格納して返す場合も簡単です。プログラムは次のようになります。
リスト 8 : 組み合わせの生成 (2)
let combination_list r xs =
let rec comb r xs a b =
match (r, xs) with
(0, _) -> (List.rev a) :: b
| (_, []) -> b
| (_, y::ys) -> comb (r - 1) ys (y::a) (comb r ys a b)
in
comb r xs [] []
val combination_list : int -> 'a list -> 'a list list = <fun>
局所関数 comb は生成した組み合わせ (引数 a) を引数 b のリストに格納し、それをそのまま返します。comb を呼び出す場合、この返り値を引数 b に渡すことで、生成した組み合わせを格納していくことができます。
具体的には、comb を再帰呼び出しするところで、1 回目の呼び出しの返り値を 2 回目の呼び出しの第 4 引数に渡します。それから、引数 xs が空リストのときは引数 b をそのまま返します。これで生成した組み合わせをリストに格納することができます。
それでは実行結果を示します。
# combination_list 3 [1; 2; 3; 4; 5];; - : int list list = [[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]]
正常に動作していますね。
次の関数を定義してください。
リスト : 解答例
let rec flatten = function
[] -> []
| x::xs -> x @ flatten xs
let flatmap f xs = flatten (List.map f xs)
(* 別解 *)
let rec flatmap1 f = function
[] -> []
| x::xs -> f x @ flatmap1 f xs
let rec select = function
[] -> []
| [x] -> [(x, [])]
| x::xs -> (x, xs) :: List.map (fun (y, ys) -> (y, x::ys)) (select xs)
let print_intlist xs =
List.iter (fun x -> print_int x; print_string " ") xs;
print_newline ()
let rec permutation_list n xs =
if n = 0 then [[]]
else flatmap
(fun (y, ys) -> List.map (fun zs -> y::zs) (permutation_list (n - 1) ys))
(select xs)
let rec remove x xs = List.filter (fun y -> x <> y) xs
let rec iota n m =
if n > m then []
else n :: iota (n + 1) m
let derangement fn m =
let rec perm n xs a =
if xs = [] then fn (List.rev a)
else List.iter (fun x -> if x = n then () else perm (n + 1) (remove x xs) (x::a)) xs
in perm 0 (iota 0 (m - 1)) []
# flatten [[1; 2; 3]; [4; 5; 6]; [7; 8; 9]];; - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9] # List.map (fun x -> [x;x;x]) [1; 2; 3; 4];; - : int list list = [[1; 1; 1]; [2; 2; 2]; [3; 3; 3]; [4; 4; 4]] # flatmap (fun x -> [x;x;x]) [1;2;3;4];; - : int list = [1; 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4] # select [1; 2; 3; 4];; - : (int * int list) list = [(1, [2; 3; 4]); (2, [1; 3; 4]); (3, [1; 2; 4]); (4, [1; 2; 3])] # permutation_list 4 [1; 2; 3; 4];; - : int list list = [[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]] # derangement print_intlist 3;; 1 2 0 2 0 1 - : unit = () # derangement print_intlist 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 - : unit = ()