M.Hiroi's Home Page

Functional Programming

お気楽 OCaml プログラミング入門

[ PrevPage | OCaml | NextPage ]

便利なリスト操作関数

関数型言語の場合、リスト操作関数の多くは高階関数として定義されています。OCaml にも便利な高階関数がモジュール List に用意されています。今回は OCaml の勉強として、ちょっと便利なリスト操作関数や高階関数を実際に作ってみましょう。

●iota と tabulate

最初は数列を生成する関数 iota と tabulate を作りましょう。iota は n から始まり step ずつ増加していく数値を m 個リストに格納して返します。今まで作成してきた iota とは仕様が異なっていることに注意してください。プログラムは次のようになります。

リスト 1 : 数列の生成

let rec iota n ?(step=1) m =
  if m <= 0 then []
  else n :: iota (n + step) ~step (m - 1)
val iota : int -> ?step:int -> int -> int list = <fun>

引数 step はオプショナル引数としました。簡単な実行例を示します。

# iota 1 10;;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
# iota 1 10 ~step:2;;
- : int list = [1; 3; 5; 7; 9; 11; 13; 15; 17; 19]
# iota 10 10 ~step:(-1);;
- : int list = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1]

iota を末尾再帰と繰り返しに変換すると次のようになります。

リスト 2 : 数列の生成 (2)

let iota_i n ?(step=1) m =
  let rec iter n m a =
    if m <= 0 then List.rev a
    else iter (n + step) (m - 1) (n::a)
  in
    iter n m []

let iota_l n ?(step=1) m =
  let i = ref n and a = ref [] in
  for j = m downto 1 do
    a := (!i :: !a);
    i := !i + step
  done;
  List.rev !a

どちらの関数も累積変数 a に数値を格納し、List.rev でリストを反転して返します。とくに難しいところはないでしょう。

関数 tabulate は iota で生成した数列に関数 fn を適用した結果をリストに格納して返します。List.map fn (iota n m) と同じですが、この方法では iota で新しいリストを生成し、なおかつ map で新しいリストを生成することになります。tabulate は数列を生成しながら関数 fn を適用するので、無駄なリストを生成することがありません。プログラムは次のようになります。

リスト 3 : 数列の生成 (3)

let rec tabulate fn n ?(step=1) m =
  if m <= 0 then []
  else fn n :: tabulate fn (n + step) ~step (m - 1)
val tabulate : (int -> 'a) -> int -> ?step:int -> int -> 'a list = <fun>

tabulate は生成した数値 n に関数 fn を適用した結果をリストに格納するだけです。簡単な実行例を示します。

# tabulate (fun x -> x * x) 1 10;;
- : int list = [1; 4; 9; 16; 25; 36; 49; 64; 81; 100]
# tabulate (fun x -> x * x) 1 10 ~step:2;;
- : int list = [1; 9; 25; 49; 81; 121; 169; 225; 289; 361]

tabulate を末尾再帰と繰り返しに変換すると次のようになります。

リスト 4 : 数列の生成 (4)

let tabulate_i fn n ?(step=1) m =
  let rec iter n m a =
    if m <= 0 then List.rev a
    else iter (n + step) (m - 1) (fn n::a)
  in
    iter n m []

let tabulate_l fn n ?(step=1) m =
  let j = ref n and a = ref [] in
  for i = m downto 1 do
    a := (fn !j :: !a);
    j := !j + step
  done;
  List.rev !a

これらの関数も累積変数 a を使って結果をリストに格納し、それを List.rev で反転して返します。とくに難しいところはないと思います。

●リストの分割

次は一つのリストを長さ n の部分リストに分ける関数 group を作ってみましょう。この処理はリストの先頭から n 個の要素を取り出す関数 take と、先頭から n 個の要素を取り除く関数 drop を作ると簡単です。次のリストを見てください。

リスト 5 : リストの分割 (1)

let rec take ls n =
  if n <= 0 || ls = [] then []
  else List.hd ls :: take (List.tl ls) (n - 1)

let rec drop ls n =
  if n <= 0 || ls = [] then ls
  else drop (List.tl ls) (n - 1)

let rec group ls n =
  if ls = [] then []
  else take ls n :: group (drop ls n) n
val take : 'a list -> int -> 'a list = <fun>
val drop : 'a list -> int -> 'a list = <fun>
val group : 'a list -> int -> 'a list list = <fun>

関数 take はリスト ls の先頭から n 個の要素を取り出してリストに格納して返します。リストの長さが n 未満の場合は、リストをコピーして返すことになります。関数 drop はリスト ls の先頭から n 個の要素を取り除きます。これは Common Lisp の関数 nthcdr と同じ動作になります。

関数 group は take の返り値と group を再帰呼び出しした返り値を演算子 :: で連結するだけです。group を再帰呼び出しするときは、drop で先頭から n 個の要素を取り除くことに注意してください。

それでは実行例を示します。

# take [1; 2; 3; 4; 5; 6] 3;;
- : int list = [1; 2; 3]
# drop [1; 2; 3; 4; 5; 6] 3;;
- : int list = [4; 5; 6]
# group [1; 2; 3; 4; 5; 6] 3;;
- : int list list = [[1; 2; 3]; [4; 5; 6]]
# group [1; 2; 3; 4; 5; 6] 2;;
- : int list list = [[1; 2]; [3; 4]; [5; 6]]
# group [1; 2; 3; 4; 5; 6] 4;;
- : int list list = [[1; 2; 3; 4]; [5; 6]]

take と group を末尾再帰に変換すると次のようになります。

リスト 6 : リストの分割 (2)

let take_i ls n =
  let rec iter ls n a =
    if n <= 0 || ls = [] then List.rev a
    else iter (List.tl ls) (n - 1) (List.hd ls :: a)
  in
    iter ls n []

let group_i ls n =
  let rec iter ls a =
    if ls = [] then List.rev a
    else iter (drop ls n) (take ls n :: a)
  in
    iter ls []

次は、take と drop を合わせたような関数 split_nth を作りましょう。split_nth はリストを n 番目の要素で二分割します。プログラムは次のようになります。

リスト 7 : リストの分割 (3)

let rec split_nth ls n =
  if n <= 0 || ls = [] then ([], ls)
  else
    let (a, b) = split_nth (List.tl ls) (n - 1) in
    (List.hd ls :: a, b)

(* 末尾再帰バージョン *)
let split_nth_i ls n =
  let rec iter ls n a =
    if n <= 0 || ls = [] then (List.rev a, ls)
    else iter (List.tl ls) (n - 1) (List.hd ls :: a)
  in
    iter ls n []
val split_nth : 'a list -> int -> 'a list * 'a list = <fun>

split_nth はタプルを使って 2 つの値を返します。一つは取り出した要素を格納したリストで、もう一つが残りのリストです。末尾再帰版は累積変数 a に取り出す要素を格納し、最後に Liet.rev で反転して返しています。

簡単な実行例を示します。

# split_nth [1; 2; 3; 4; 5; 6] 3;;
- : int list * int list = ([1; 2; 3], [4; 5; 6])
# split_nth [1; 2; 3; 4; 5; 6] 0;;
- : int list * int list = ([], [1; 2; 3; 4; 5; 6])
# split_nth [1; 2; 3; 4; 5; 6] 6;;
- : int list * int list = ([1; 2; 3; 4; 5; 6], [])

split_nth を使うと、関数 group で drop を呼び出す必要がなくなります。

リスト 8 : リストの分割 (4)

let rec group_s ls n =
  if ls = [] then []
  else let (a, b) = split_nth ls n in
    a :: group_s b n

group_s では split_nth の返り値を局所変数 (a, b) で受け取ります。そして、リスト b に対して group_s を再帰呼び出しして、その返り値にリスト a を追加します。

もう一つ、リストを分割する関数を作りましょう。関数 partition は述語 pred の返り値 (true, false) でリストを二分割します。次のリストを見てください。

リスト 9 : リストの分割 (4)

let rec partition pred = function
  [] -> ([], [])
| x::xs -> let (a, b) = partition pred xs in
           if pred x then (x::a, b) else (a, x::b)

(* 末尾再帰バージョン *)
let partition_i pred ls =
  let rec iter a b = function
    [] -> (List.rev a, List.rev b)
  | x::xs -> if pred x then iter (x::a) b xs
             else iter a (x::b) xs
  in
    iter [] [] ls
val partition_i : ('a -> bool) -> 'a list -> 'a list * 'a list = <fun>

引数のリストが空リストの場合、タプルで空リストを 2 つ返します。次の節で、リストを x と xs に分解します。xs に対して partition を再帰呼び出しして、返り値を (a, b) で受け取ります。そして、pred x が真を返す場合は x を a に追加し、そうでなければ b に追加します。末尾再帰版の場合、pred x が真のときは累積変数 a に、偽のときは累積変数 b に要素 x を追加します。

簡単な実行例を示します。

# partition (fun x -> x mod 2 = 0) [1; 2; 3; 4; 5; 6];;
- : int list * int list = ([2; 4; 6], [1; 3; 5])
# partition (fun x -> x mod 3 = 0) [1; 2; 3; 4; 5; 6];;
- : int list * int list = ([3; 6], [1; 2; 4; 5])

●リストの置換

次はリストの要素を置換する関数を作ります。関数 substitute は y と等しいリストの要素を全て x に置換します。関数 substitute_if は述語 pred が真を返す要素を全て x に置換します。

リスト 10 : リストの置換

let rec substitute x y = function
  [] -> []
| z::zs -> if y = z then x :: substitute x y zs
           else z :: substitute x y zs

let rec substitute_if x pred = function
  [] -> []
| z::zs -> if pred z then x :: substitute_if x pred zs
           else z :: substitute_if x pred zs
val substitute : 'a -> 'a -> 'a list -> 'a list = <fun>
val substitute_if : 'a -> ('a -> bool) -> 'a list -> 'a list = <fun>

substitute はリストの要素 z が引数 y と等しい場合、その要素を引数 x に置き換えます。そうでなければ、要素 z をそのままリストに追加します。substitute_if は pred z が真を返す場合、その要素を引数 x に置き換えます。そうでなければ、要素 z をそのままリストに追加します。

簡単な実行例を示します。

# substitute 1 2 [1; 2; 3; 4; 1; 2; 3; 4];;
- : int list = [1; 1; 3; 4; 1; 1; 3; 4]
# substitute_if 2 (fun x -> x mod 2 = 1) [1; 2; 3; 4; 1; 2; 3; 4];;
- : int list = [2; 2; 2; 4; 2; 2; 2; 4]

●any と every

次はリストの要素に述語を適用する関数を作りましょう。関数 any はリストの要素に述語 pred を適用し、一つでも真を返す要素があれば真を返します。関数 every は一つでも偽を返す要素があれば偽を返します。つまり、全てが真の場合にかぎり真を返すことになります。

リスト 11 : any と every

let rec any pred = function
  [] -> false
| x::xs -> if pred x then true else any pred xs

let rec every pred = function
  [] -> true
| x::xs -> if pred x then every pred xs else false
val any : ('a -> bool) -> 'a list -> bool = <fun>
val every : ('a -> bool) -> 'a list -> bool = <fun>

any と every は簡単です。リストを x と xs に分解して、pred x が真を返す場合、any は true を返します。逆に偽を返す場合、every は false を返します。それ以外の場合は再帰呼び出しして次の要素をチェックします。引数のリストが空リストになった場合、any は false を返し、every は true を返します。

簡単な実行例を示します。

# any (fun x -> x mod 2 = 0) [1; 3; 5; 7; 9];;
- : bool = false
# any (fun x -> x mod 2 = 0) [1; 2; 3; 5; 7; 9];;
- : bool = true
# every (fun x -> x mod 2 = 0) [2; 4; 6; 8; 10];;
- : bool = true
# every (fun x -> x mod 2 = 0) [2; 4; 5; 6; 8; 10];;
- : bool = false

なお、OCaml の標準モジュール List には同等の働きをする関数 exists と for_all があります。

●マッピング

マップ関数 map fn xs はリスト xs の要素に関数 fn を適用します。これに対して、関数 maplist は関数 fn にリストそのものを渡します。ただし、繰り返すたびにリストの先頭要素は取り除かれていきます。この動作は Common Lisp の関数 maplist と同じです。プログラムは次のようになります。

リスト 12 : マップ関数 maplist

let rec maplist fn = function
  [] -> []
| _::xs as ls -> (fn ls) :: maplist fn xs
val maplist : ('a list -> 'b) -> 'a list -> 'b list = <fun>

maplist は簡単です。関数 fn に引数のリスト ls をそのまま渡すだけです。maplist を再帰呼び出しするときは、先頭の要素を取り除いたリスト xs を渡します。

簡単な実行例を示します。

# maplist (fun x -> x) [1; 2; 3; 4; 5];;
- : int list list = [[1; 2; 3; 4; 5]; [2; 3; 4; 5]; [3; 4; 5]; [4; 5]; [5]]
# maplist (fun x -> List.fold_left (fun a b -> a + b) 0 x) [1; 2; 3; 4; 5];;
- : int list = [15; 14; 12; 9; 5]

maplist を使うと map は次のように定義することができます。

リスト 13 : maplist を使った map の定義

let map fn ls = maplist (fun x -> fn (List.hd x)) ls

●リスト操作関数の一般化

ところで、今まで説明したリスト操作は次のように一般化することができます。

リスト 14 : リスト操作の一般化

let rec for_each_list fn comb term = function
  [] -> term
| x::xs -> comb (fn x) (for_each_list fn comb term xs)
val for_each_list : ('a -> 'b) -> ('b -> 'c -> 'c) -> 'c -> 'a list -> 'c = <fun>

関数 for_each_list の引数 fn はリストの要素に適用する関数、comb は fn の返り値と for_each_list の返り値を結合する関数、term はリストの終端で返す値です。プログラムは簡単で、引数のリストが空リストならば term を返します。そうでなければ、リストの要素 x に関数 fn を適用し、その返り値と for_each_list の返り値を関数 comb で結合します。

簡単な実行例を示しましょう。

# for_each_list (fun x -> x) (+) 0 [1; 2; 3; 4; 5];;
- : int = 15
# for_each_list (fun x -> x * x) (+) 0 [1; 2; 3; 4; 5];;
- : int = 55
# for_each_list (fun x -> x) (@) [] [[1; 2]; [3]; [4; 5; 6]];;
- : int list = [1; 2; 3; 4; 5; 6]

たとえば、map, filter, fold_right を for_each_list を使ってプログラムすると、次のようになります。

リスト 15 : for_each_list の使用例

let cons a b = a::b

let map fn ls = for_each_list fn cons [] ls

let filter fn ls =
  for_each_list (fun x -> if fn x then [x] else []) (@) [] ls

(* 別解 *)
let filter1 fn ls =
  for_each_list (fun x -> x) (fun x a -> if fn x then x::a else a) [] ls

let fold_right fn a ls =
  for_each_list (fun x -> x) (fun x y -> (fn x y)) a ls
val cons : 'a -> 'a list -> 'a list = <fun>
val map : ('a -> 'b) -> 'a list -> 'b list = <fun>
val filter : ('a -> bool) -> 'a list -> 'a list = <fun>
val filter1 : ('a -> bool) -> 'a list -> 'a list = <fun>
val fold_right : ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b = <fun>

演算子 :: は (::) で関数化することができないので、関数 cons を定義します。map は comb に cons を、term に [ ] を渡せば実現できます。filter はリストの要素 x に関数 fn を適用し、真を返す場合は [x] を返し、偽の場合は [ ] を返します。それを演算子 @ で連結すると、[ ] はリストの要素に含まれないので、フィルターとして動作します。

filter1 は filter の別解です。(fun x -> x) でリストの要素をそのまま返し、結合する関数 comb の中で引数の関数 fn を呼び出します。返り値が真であれば引数 x を引数 a に追加します。そうでなければ x を a に追加しません。fold_right も簡単です。(fun x -> x) でリストの要素をそのまま返し、要素を連結する関数の中で fn を呼び出します。

簡単な実行例を示します。

# map (fun x -> x) [1; 2; 3; 4; 5];;
- : int list = [1; 2; 3; 4; 5]
# filter (fun x -> x mod 2 = 0) [1;2; 3; 4; 5];;
- : int list = [2; 4]
# fold_right (+) 0 [1;2;3;4;5];;
- : int = 15

ところで、for_each_list を末尾再帰に変換すると次のようになります。

リスト 16 : リスト操作の一般化 (2)

let for_each_list_i fn comb term ls =
  let rec iter a = function
    [] -> a
  | x::xs -> iter (comb (fn x) a) xs
  in
    iter term ls

この場合、リストの先頭から関数 fn を適用していくので、map や filter を実現する場合は List.rev で返り値のリストを反転してください。また、fold_left は簡単に実現できますが、fold_right は引数のリスト ls を List.rev rev で反転する必要があります。ご注意くださいませ。

ところで、for_each_list は関数 fn にリストの要素を渡していますが、このままでは maplist を実現することができません。そこで、要素ではなくリストそのものを渡すことにします。このほうが便利な場合もあります。次のリストを見てください。

リスト 17 : リスト操作の一般化 (3)

let rec for_each_list1 fn comb term = function
  [] -> term
| (_::xs) as ls -> comb (fn ls) (for_each_list1 fn comb term xs)
val for_each_list1 : ('a list -> 'b) -> ('b -> 'c -> 'c) -> 'c -> 'a list -> 'c = <fun>

この場合、for_each_list1 の動作は次のようになります。

# for_each_list1 (fun x -> x) cons [] [1; 2; 3; 4; 5];;
- : int list list = [[1; 2; 3; 4; 5]; [2; 3; 4; 5]; [3; 4; 5]; [4; 5]; [5]]

このように、maplist の動作と同じになります。マップ関数、フィルター、畳み込みなどの高階関数は、for_each_list1 を使って次のように定義することができます。

リスト 18 : for_each_list1 の使用例

; マッピング
let map_1 fn ls =
  for_each_list1 (fun xs -> fn (List.hd xs)) cons [] ls

let maplist_1 fn ls =
  for_each_list1 fn cons [] ls

; フィルター
let filter_1 fn ls =
  for_each_list1 List.hd (fun x a -> if fn x then x::a else a) [] ls

; 畳み込み
let fold_right_1 fn a ls =
  for_each_list1 List.hd (fun x y -> fn x y) a ls
val map_1 : ('a -> 'b) -> 'a list -> 'b list = <fun>
val maplist_1 : ('a list -> 'b) -> 'a list -> 'b list = <fun>
val filter_1 : ('a -> bool) -> 'a list -> 'a list = <fun>
val fold_right_1 : ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b = <fun>

簡単な実行例を示しましょう。

# map_1 (fun x -> (x, x)) [1; 2; 3; 4; 5];;
- : (int * int) list = [(1, 1); (2, 2); (3, 3); (4, 4); (5, 5)]
# maplist_1 (fun x -> (List.hd x, List.length x)) [1; 2; 3; 4; 5];;
- : (int * int) list = [(1, 5); (2, 4); (3, 3); (4, 2); (5, 1)]
# filter_1 (fun x -> x mod 2 = 0) [1; 2; 3; 4; 5; 6];;
- : int list = [2; 4; 6]
# fold_right_1 (+) 0 [1; 2; 3; 4; 5; 6];;
- : int = 21

もう一つ簡単な例を示しましょう。リストから重複した要素を取り除く関数 remove_dup は、for_each_list1 を使って次のように定義することができます。

リスト 19 : 重複した要素を取り除く

let remove_dup ls =
  for_each_list1
    (fun x -> x)
    (fun (x::xs) a -> if List.mem x xs then a else x::a)
    []
    ls
val remove_dup : 'a list -> 'a list = <fun>

実行例を示します。

# remove_dup [1; 1; 2; 1; 2; 3; 1; 2; 3; 4; 1; 2; 3; 4; 5];;
- : int list = [1; 2; 3; 4; 5]

●解きほぐし (逆畳み込み)

ところで、iota や tabulate のようなリストを生成する関数は、次のように一般化することができます。

リスト 20 : 解きほぐし

let rec unfold p f g seed tail_gen =
  if p seed then tail_gen seed
  else f seed :: unfold p f g (g seed) tail_gen

let unfold_right p f g seed tail =
  let rec iter seed a =
    if p seed then a
    else iter (g seed) (f seed :: a)
  in
    iter seed tail
val unfold :
  ('a -> bool) ->
  ('a -> 'b) -> ('a -> 'a) -> 'a -> ('a -> 'b list) -> 'b list = <fun>
val unfold_right :
  ('a -> bool) -> ('a -> 'b) -> ('a -> 'a) -> 'a -> 'b list -> 'b list = <fun>

関数 unfold と unfold_right は畳み込みを行う fold_right とfold_left の逆変換に相当する処理で、「解きほぐし」とか「逆畳み込み」と呼ばれています。unfold と unfold_right の仕様は Scheme のライブラリ SRFI-1 を参考にしました。

unfold は値 seed に関数 f を適用し、その要素をリストに格納して返します。引数 p は終了条件を表す関数で、p が真を返すときリストの終端を関数 tail_gen で生成して返します。一般に、tail_gen は空リスト [ ] を返すのが普通です。関数 g は seed の値を更新するために使用します。したがって、生成されるリストの要素は次のようになります。

( (f (g seed))                   ; g を 1 回適用
  (f (g (g seed)))               ; g を 2 回適用
  (f (g (g (g seed))))           ; g を 3 回適用
  ...
  (f (g (g ... (g seed) ...))) ) ; g を n 回適用

リストの長さが n の場合、最後の要素は g を n 回適用し、その結果に f を適用することになります。unfold_right は生成されるリストの要素が unfold の逆になります。また、引数 tail は関数値ではなくリストの終端を表す値になります。

簡単な例を示しましょう。

# unfold (fun x -> x > 10) (fun x -> x) (fun x -> x + 1) 1 (fun _ -> []);;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
# unfold_right (fun x -> x > 10) (fun x -> x) (fun x -> x + 1) 1 [];;
- : int list = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1]

このように、unfold を使って iota を実現することができます。また、(fun x -> x) のかわりに他の関数を渡すことで、関数 tabulate と同じ動作を実現できます。

もう一つ簡単な例を示しましょう。start から始まって増分値が step で合計値が sum 以上になる数列で、要素が最小個数となるものを求めます。次のリストを見てください。

リスト 21 : 合計値が sum 以上になる数列を求める

let unfold_sum sum ?(step=1) start =
  unfold (fun (x, _) -> sum <= x)
         (fun (_, y) -> y)
         (fun (x, y) -> (x + y, y + step))
         (0, start)
         (fun _ -> [])
val unfold_sum : int -> ?step:int -> int -> int list = <fun>

関数名は unfold_sum としました。プログラムは簡単で、リストの要素を start から始めて step ずつ値を増やしていき、合計値が sum 以上になったらリストの生成を終了します。

リストの生成中には、要素の値とそれまでの合計値が必要になります。そこで、これらの値をタプル (x, y) にまとめて unfold の seed に渡すことにします。x が合計値で、y が要素の値です。したがって、終了条件は引数の x が sum 以上になったときで、seed の更新は "x + y" と "y + step" の値をタプルでまとめたものになります。

簡単な実行例を示します。

# fold_right (+) 0 [1; 2; 3; 4; 5];;
- : int = 15
# unfold_sum 15 1;;
- : int list = [1; 2; 3; 4; 5]
# unfold_sum 16 1;;
- : int list = [1; 2; 3; 4; 5; 6]
# fold_right (+) 0 [1; 3; 5; 7; 9];;
- : int = 25
# unfold_sum 25 1 ~step:2;;
- : int list = [1; 3; 5; 7; 9]
# unfold_sum 26 1 ~step:2;;
- : int list = [1; 3; 5; 7; 9; 11]

要素の合計値がちょうど sum にならない場合もありますが、合計値は sum 以上で要素の個数は最小になっています。なお、合計値が sum 以下で、できるだけ sum に近い数列を生成することもできます。興味のある方はプログラムを作ってみてください。

ところで、unfold と unfold_right の seed は、数値だけではなくリストを渡すこともできます。たとえば、畳み込みを行う fold_right に cons を渡すと copy_list を実現できますが、解きほぐしを行う unfold で List.hd と List.tl を渡しても copy_list を実現することができます。

# fold_right cons [] [1; 2; 3; 4; 5; 6];;
- : int list = [1; 2; 3; 4; 5; 6]
# unfold (fun x -> x = []) List.hd List.tl [1; 2; 3; 4; 5; 6] (fun _ -> []);;
- : int list = [1; 2; 3; 4; 5; 6]

また、unfold を使って関数 maplist を実現することもできます。次の例を見てください。

# maplist (fun x -> x) [1; 2; 3; 4; 5];;
- : int list list = [[1; 2; 3; 4; 5]; [2; 3; 4; 5]; [3; 4; 5]; [4; 5]; [5]]
# unfold (fun x -> x = []) (fun x -> x) List.tl [1; 2; 3; 4; 5] (fun _ -> []);;
- : int list list = [[1; 2; 3; 4; 5]; [2; 3; 4; 5]; [3; 4; 5]; [4; 5]; [5]]

unfold で (fun x -> x) のかわりに他の関数を渡すと、maplist と同じ動作になります。

●問題

次の関数を定義してください。

  1. リスト xs の接頭辞 (prefix) をすべて求める関数 inits xs
  2. リスト xs の接尾辞 (suffix) をすべて求める関数 tails xs
  3. リスト xs を前後で二分割したとき、二分割したリストをすべて求める関数 splits xs
  4. [([], [1; 2; 3]); ([1], [2; 3]); ([1; 2], [3]); ([1; 2; 3], [])]
    
  5. リスト xs を集合と考えて、集合 xs の分割の仕方を全て求める関数 partition_of_set xs
  6. 1 分割 : [[1; 2; 3]]
    2 分割 : [[1; 2]; [3]], [[1; 3]; [2]], [[1]; [2; 3]]
    3 分割 ; [[1; [2]; [3]]
    












●解答1

リスト : 接頭辞を求める

let rec inits ?(a = []) = function
    [] -> [a]
  | x::xs -> a :: inits ~a:(a @ [x]) xs

(* 別解 *)
let rec scan_left fn a = function
    [] -> [a]
  | x::xs -> a :: scan_left fn (fn a x) xs

let rec inits0 xs =
  scan_left (fun a x -> a @ [x]) [] xs
val inits0 : 'a list -> 'a list list = <fun>
val inits : ?a:'a list -> 'a list -> 'a list list = <fun>

関数 inits は累積変数 a を用意すると簡単です。リストの先頭要素 x を取り出して、変数 a の末尾に追加していきます。そして、inits を再帰呼び出ししたあと、その返り値 (リスト) の先頭に a を追加します。この動作は 高階関数 (2) の問題 6 で取り上げた高階関数 scan_left とほぼ同じです。scan_left を使うと、別解のように inits は簡単に定義することができます。

# inits [1; 2; 3];;
- : int list list = [[]; [1]; [1; 2]; [1; 2; 3]]
# inits [1; 2; 3; 4];;
- : int list list = [[]; [1]; [1; 2]; [1; 2; 3]; [1; 2; 3; 4]]

●解答2

リスト : 接尾辞を求める

let rec tails = function
    [] -> [[]]
  | _::xs as ys -> ys :: tails xs

(* 別解 *)
let rec scan_right fn a = function
    [] -> [a]
  | x::xs -> let ys = scan_right fn a xs in fn x (List.hd ys) :: ys

let tails0 xs =
  scan_right (fun x a -> x::a) [] xs
val tails0 : 'a list -> 'a list list = <fun>
val tails : 'a list -> 'a list list = <fun>

関数 tails は引数のリスト ys を先頭要素と残りのリスト xs に分解して、tails を再帰呼び出しして xs の接尾辞リストを求めます。あとは引数 ys を返り値のリストの先頭に追加するだけです。なお、高階関数 (2) の問題 7 で取り上げた高階関数 scan_right を使っても、tails は簡単に定義することができます。

# tails [1; 2; 3];;
- : int list list = [[1; 2; 3]; [2; 3]; [3]; []]
# tails [1; 2; 3; 4];;
- : int list list = [[1; 2; 3; 4]; [2; 3; 4]; [3; 4]; [4]; []]

●解答3

リスト : リストを前後で分割する

exception Empty

let rec splits = function
    [] -> raise Empty
  | [x] -> [([], [x]); ([x], [])]
  | x::xs as xs1 -> ([], xs1) :: List.map (fun (ys, zs) -> (x::ys, zs)) (splits xs)

(* 別解 *)
let splits0 xs = 
  if xs = [] then raise Empty
  else List.combine (inits xs) (tails xs)
val splits0 : 'a list -> ('a list * 'a list) list = <fun>
val splits : 'a list -> ('a list * 'a list) list = <fun>

最初の節で、引数が空リストの場合はリストを分割できないので例外を送出します。次の節で、要素が x しかない場合は空リストと [x] に分割します。最後の節で、空リストと xs1 に分割する場合は ([ ], xs1) をリストに格納するだけです。それ以外の場合は、xs1 を x と xs に分割し、xs に対して splits を再帰呼び出しします。そして、その返り値のタプルの第 1 要素 ys (前半のリスト) に x を追加します。

なお、別解のように inits と tails を使っても splits は簡単に定義することができます。

# splits [1];;
- : (int list * int list) list = [([], [1]); ([1], [])]
# splits [1; 2;];;
- : (int list * int list) list = [([], [1; 2]); ([1], [2]); ([1; 2], [])]
# splits [1; 2; 3];;
- : (int list * int list) list =
[([], [1; 2; 3]); ([1], [2; 3]); ([1; 2], [3]); ([1; 2; 3], [])]

●解答4

集合を分割するアルゴリズムは簡単です。たとえば、n -1 個の要素 x1, ..., xn-1 を持つ集合を分割したところ、i 個の部分集合 S1, ..., Si が生成されたとしましょう。ここに、n 番目の要素 xn を追加すると、要素が n 個の集合を分割することができます。

新しい要素を追加する場合は次に示す手順で行います。

  1. 部分集合 Sk (k = 1 から i まで) に要素 xn を追加する
  2. 新しい部分集合 Si+1 (要素が xn だけの集合) を生成する

簡単な例を示しましょう。次の図を見てください。

部分集合を格納するリストを用意します。最初、部分集合は空集合なので空リストに初期化します。次に、要素 1 を追加します。部分集合は空リストなので、手順 1 は適用できません。手順 2 を適用して新しい部分集合 (1) を追加します。

次に要素 2 を追加します。((1)) に 手順 1 を適用すると、部分集合 (1) に要素を追加して ((1 2)) になります。手順 2 を適用すると、新しい部分集合 (2) を追加して ((1) (2)) になります。最後に 3 を追加します。((1 2)) に手順 1 を適用すると ((1 2 3)) に、手順 2 を適用すると ((1 2) (3)) になります。((1) (2)) に手順 1 を適用すると ((1 3) (2)) と ((1) (2 3)) になり、手順 2 を適用すると ((1) (2) (3)) になります。

このように、簡単な方法で集合を分割することができます。実際にプログラムを作る場合、上図を木と考えて、深さ優先で木をたどると簡単です。次のリストを見てください。

リスト : 集合の分割

let remove x xs = List.filter (fun y -> y <> x) xs

let partition_of_set ls =
  let rec part_set ls a b =
    match ls with
      [] -> a :: b
    | x::xs -> List.fold_left
                 (fun b y -> part_set xs ((x::y)::(remove y a)) b)
                 (part_set xs ([x]::a) b)
                 a
  in
  part_set (List.rev ls) [] []
val partition_of_set : 'a list -> 'a list list list = <fun>

実際の処理は局所関数 part_set で行います。引数 a と b は累積変数です。a に分割中の集合を格納し、b には分割した集合を格納します。最初の節が再帰呼び出しの停止条件です。集合の分割がひとつ完成したので、a を b に追加します。次の節の List.fold_left で、部分集合に要素 x を追加します。匿名関数でリスト a から要素 y を順番に取り出し、a から y を取り除いたリストに x::y を追加します。

fold_left の初期値には、新しい部分集合 [x] を a に追加した結果を渡します。これで手順 1, 2 で分割した集合を変数 b に格納することができます。ただし、このままでは要素の並び方が逆順になるので、part_set を呼び出す前に List.rev でリスト ls を反転しています。これで集合の分割をすべて求めることができます。

# partition_of_set [1; 2; 3];;
- : int list list list =
[[[1; 2; 3]]; [[1]; [2; 3]]; [[1; 3]; [2]]; [[1; 2]; [3]]; [[1]; [2]; [3]]]

# partition_of_set [1; 2; 3; 4];;
- : int list list list =
[[[1; 2; 3; 4]]; [[1]; [2; 3; 4]]; [[1; 3; 4]; [2]]; [[1; 2]; [3; 4]];
 [[1]; [2]; [3; 4]]; [[1; 3]; [2; 4]]; [[1; 2; 4]; [3]]; [[1]; [2; 4]; [3]];
 [[1; 4]; [2; 3]]; [[1; 2; 3]; [4]]; [[1]; [2; 3]; [4]]; [[1; 4]; [2]; [3]];
 [[1; 3]; [2]; [4]]; [[1; 2]; [3]; [4]]; [[1]; [2]; [3]; [4]]]

初版 2009 年 11 月 23 日
改訂 2020 年 8 月 2 日

Copyright (C) 2009-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | OCaml | NextPage ]