M.Hiroi's Home Page

OCaml Programming

Yet Another OCaml Problems

[ PrevPage | OCaml | NextPage ]

はじめに

今回はちょっと便利な関数を問題形式で紹介します。元ネタは P-99: Ninety-Nine Prolog Problems です。拙作のページ Prolog Programming Yet Another Prolog Problems と同じ問題ですが、あしからずご了承くださいませ。

●問題1

リストの要素がただひとつか調べる述語 single を定義してください。

val single : 'a list -> bool = <fun>
# single [1];;
- : bool = true
# single [1; 2];;
- : bool = false
# single [];;
- : bool = false

解答

●問題2

リストの要素がひとつ以上あるか調べる述語 pair を定義してください。

val pair : 'a list -> bool = <fun>
# pair [1];;
- : bool = true
# pair [1; 2];;
- : bool = true
# pair [];;
- : bool = false

解答

●問題3

リスト xs はリスト ys よりも長いか調べる述語 longer xs ys を定義してください。

val longer : 'a list -> 'b list -> bool = <fun>
# longer [1; 2; 3] [4; 5];;
- : bool = true
# longer [1; 2] [4; 5];;
- : bool = false
# longer [1] [4; 5];;
- : bool = false

解答

●問題4

リストの最後尾を求める関数 last と、最後尾の要素を取り除く関数 butlast を定義してください。

val last : 'a list -> 'a list = <fun>
val butlast : 'a list -> 'a list = <fun>
# last [1; 2; 3];;
- : int list = [3]
# last [1];;
- : int list = [1]
# last [];;
Exception: Empty_list.

# butlast [1; 2; 3];;
- : int list = [1; 2]
# butlast [1];;
- : int list = []
# butlast [];;
Exception: Empty_list.

解答

●問題5

リストの先頭から N 個の要素を取り出す関数 take を定義してください。

val take : 'a list -> int -> 'a list = <fun>
# take [1; 2; 3; 4; 5] 3;;
- : int list = [1; 2; 3]
# take [1; 2; 3; 4; 5] 6;;
- : int list = [1; 2; 3; 4; 5]

解答

●問題6

リストの先頭から N 個の要素を取り除く関数 drop を定義してください。

val drop : 'a list -> int -> 'a list = <fun>
# drop [1; 2; 3; 4; 5] 3;;
- : int list = [4; 5]
# drop [1; 2; 3; 4; 5] 5;;
- : int list = []
# drop [1; 2; 3; 4; 5] 6;;
- : int list = []

解答

●問題7

リストの n 番目から m - 1 番目の要素を部分リストとして取り出す関数 subseq n m を定義してください。なお、リストの要素は 0 から数え始めるものとします。

val subseq : 'a list -> int -> int -> 'a list = <fun>
# subseq [1; 2; 3; 4; 5] 0 5;;
- : int list = [1; 2; 3; 4; 5]
# subseq [1; 2; 3; 4; 5] 0 4;;
- : int list = [1; 2; 3; 4]
# subseq [1; 2; 3; 4; 5] 1 4;;
- : int list = [2; 3; 4]
# subseq [1; 2; 3; 4; 5] 3 3;;
- : int list = []

解答

●問題8

リストの末尾から n 個の要素を取り除く関数 butlastn を定義してください。

val butlastn : 'a list -> int -> 'a list = <fun>
# butlastn [1; 2; 3; 4; 5] 1;;
- : int list = [1; 2; 3; 4]
# butlastn [1; 2; 3; 4; 5] 2;;
- : int list = [1; 2; 3]
# butlastn [1; 2; 3; 4; 5] 5;;
- : int list = []

解答

●問題9

リストを長さ n の部分リストに分割する述語 group を定義してください。

val group : 'a list -> int -> 'a list list = <fun>
# 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]]

解答

●問題10

リストの中から述語 pred が真を返す最初の要素の位置を求める関数 position_if を定義してください。なお、リストの要素は 0 から数え始めるものとします。

val position_if : ('a -> bool) -> 'a list -> int option = <fun>
# position_if (fun x -> x = 3) [1; 2; 3; 4; 5; 6];;
- : int option = Some 2
# position_if (fun x -> x = 7) [1; 2; 3; 4; 5; 6];;
- : int option = None

解答

●問題11

リストから述語 pred が真を返す要素の個数を求める関数 count_if を定義してください。

val count_if : ('a -> bool) -> 'a list -> int = <fun>
# count_if (fun x -> x mod 2 = 0) [1; 2; 3; 4; 5; 6; 7];;
- : int = 3
# count_if (fun x -> x mod 2 = 1) [1; 2; 3; 4; 5; 6; 7];;
- : int = 4

解答

●問題12

リストの要素の合計値を求める述語 sum_list を定義してください。

val sum_list : int list -> int = <fun>
# sum_list [1; 2; 3; 4; 5; 6];;
- : int = 21
# sum_list [];;
- : int = 0

解答

●問題13

リストの中から最大値を求める関数 max_list と最小値を求める関数 min_list を定義してください。

val max_list : 'a list -> 'a = <fun>
val min_list : 'a list -> 'a = <fun>
# max_list [5; 6; 4; 3; 7; 8];;
- : int = 8
# max_list [];;
Exception: Empty_list.
# min_list [5; 6; 4; 3; 7; 8];;
- : int = 3
# min_list [];;
Exception: Empty_list.

解答

●問題14

要素 x の右隣に要素 y があるかチェックする関数 adjacent x y ls を定義してください。

val adjacent : 'a -> 'a -> 'a list -> bool = <fun>
# adjacent 1 2 [1; 2; 3; 4; 5];;
- : bool = true
# adjacent 1 2 [1; 0; 2; 3; 4; 5];;
- : bool = false

解答

●問題15

要素 x が 要素 y よりも前に出現しているか調べる関数 before x y ls を定義してください。

val before : 'a -> 'a -> 'a list -> bool = <fun>
# before 3 4 [1; 2; 3; 4; 5];;
- : bool = true
# before 4 3 [1; 2; 3; 4; 5];;
- : bool = false

解答

●問題16

整数 n から m までを格納したリストを作る関数 iota を定義してください。

val iota : int -> int -> int list = <fun>
# iota 1 5;;
- : int list = [1; 2; 3; 4; 5]
# iota 1 1;;
- : int list = [1]
# iota 1 0;;
- : int list = []

解答

●問題17

リストから重複要素を取り除いて集合を生成する関数 set_of_list を定義してください。

val set_of_list : 'a list -> 'a list = <fun>
# set_of_list [1; 2; 3; 1; 4; 5; 1; 6; 7];;
- : int list = [2; 3; 4; 5; 1; 6; 7]

解答

●問題18

2 つの集合の和を求める関数 union を定義してください。

val union : 'a list -> 'a list -> 'a list = <fun>
# union [1; 3; 5; 7] [2; 4; 6; 8];;
- : int list = [1; 3; 5; 7; 2; 4; 6; 8]
# union [1; 3; 5; 7] [2; 4; 5; 7];;
- : int list = [1; 3; 2; 4; 5; 7]
# union [2; 4; 5; 7] [2; 4; 5; 7];;
- : int list = [2; 4; 5; 7]

解答

●問題19

2 つの集合の積を求める関数 intersection を定義してください。

val intersection : 'a list -> 'a list -> 'a list = <fun>
# intersection [1; 2; 3; 4] [3; 4; 5; 6];;
- : int list = [3; 4]
# intersection [1; 2; 3; 4] [5; 6];;
- : int list = []

解答

●問題20

2 つの集合の差を求める関数 difference を定義してください。

val difference : 'a list -> 'a list -> 'a list = <fun>
# difference [1; 2; 3; 4] [3; 4; 5; 6];;
- : int list = [1; 2]
# difference [1; 2; 3; 4] [];;
- : int list = [1; 2; 3; 4]
# difference [] [3; 4; 5; 6];;
- : int list = []

解答

●問題21

2 つのソート済みのリストをひとつのソート済みのリストにまとめる関数 merge_list を定義してください。

val merge_list : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list = <fun>
# merge_list (<) [1; 3; 5; 7; 9] [2; 4; 6; 8; 10];;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]

解答

●問題22

関数 merge_list を使ってリストをソートする merge_sort を定義してください。

val merge_sort : ('a -> 'a -> bool) -> int -> 'a list -> 'a list = <fun>
# merge_sort (<) 9 [5; 6; 4; 7; 3; 8; 2; 9; 1];;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9]

解答

●問題23

リスト ps がリスト ls の「接頭辞 (prefix) 」か判定する述語 prefix ls ps を定義してください。接頭辞とは、列の先頭からある位置までの部分列のことです。たとえば、リスト [1; 2; 3; 4] の接頭辞は [ ], [1], [1; 2], [1; 2; 3], [1; 2; 3; 4] の 5 つになります。

val prefix : 'a list -> 'a list -> bool = <fun>
# prefix [1; 2; 3; 4; 5] [1; 2];;
- : bool = true
# prefix [1; 2; 3; 4; 5] [1; 2; 3];;
- : bool = true
# prefix [1; 2; 3; 4; 5] [1; 2; 3; 5];;
- : bool = false
# prefix [1; 2; 3; 4; 5] [];;
- : bool = true

解答

●問題24

リスト ss がリスト ls の「接尾辞 (suffix) 」か判定する述語 suffix ls ss を定義してください。接尾辞とは、列のある位置から末尾までの部分列のことです。たとえば、リスト [1; 2; 3; 4] の接尾辞は [1; 2; 3; 4], [2; 3; 4], [3; 4], [4], [ ] の 5 つになります。

val suffix : 'a list -> 'a list -> bool = <fun>
# suffix [1; 2; 3; 4; 5] [3; 4; 5];;
- : bool = true
# suffix [1; 2; 3; 4; 5] [3; 4];;
- : bool = false
# suffix [1; 2; 3; 4; 5] [];;
- : bool = true

解答

●問題25

リスト xs がリスト ls の部分リストか判定する述語 sublist xs ls を定義してください。

val sublist : 'a list -> 'a list -> bool = <fun>
# sublist [3; 4; 5] [1; 2; 3; 4; 5; 6];;
- : bool = true
# sublist [2; 3; 4; 5] [1; 2; 3; 4; 5; 6];;
- : bool = true
# sublist [2; 4; 5] [1; 2; 3; 4; 5; 6];;
- : bool = false

解答


●解答1

リスト:要素がただひとつか

let single = function
  [_] -> true
| _ -> false

OCaml の場合、引数のリストと [ _ ] がマッチングすれば、そのリストの要素は一つしかないことがわかります。length でリストの長さを求める必要はありません。

●解答2

リスト:要素がひとつ以上あるか

let pair = function
  _::_ -> true
| _ -> false

たとえば、リスト [1] と x::xs を照合すると、x = 1, xs = [ ] になります。したがって、引数のリストと _::_ がマッチングすれば、そのリストの要素は一つ以上あることがわかります。length でリストの長さを求める必要はありません。

なお、述語 pair の名前は Scheme の関数 pair? から拝借しました。

●解答3

リスト:リスト Xs は Ys よりも長いか

let rec longer xs ys =
  match (xs, ys) with
    ([], _) -> false
  | (_, []) -> true
  | (_::xs1, _::ys1) -> longer xs1 ys1

リストの先頭から順番にたどり、途中で ys が空リストになれば xs の方が長いことがわかります。length でリストの長さを求めて比較するよりも、このプログラムの方が効率的だと思います。

●解答4

リスト: リストの最後尾を求める

(* 例外の定義 *)
exception Empty_list

let rec last = function
  [] -> raise Empty_list
| [_] as xs -> xs
| x::xs -> last xs
リスト:最後尾の要素を取り除く

let rec butlast = function
  [] -> raise Empty_list
| [_] -> []
| x::xs -> x::butlast xs

どちらの関数も引数が空リストの場合はエラー Empty_list を送出します。last は単純な再帰定義でリストの最後尾を求めています。butlast の 2 番目の節は、要素がひとつしかないリストから最後尾の要素を取り除くと空リストになることを表しています。これが再帰の停止条件になります。あとは次の節で butlast を再帰呼び出しして、xs から最後尾の要素を取り除いたリストに、引数のリストの先頭要素 x を追加していくだけです。

●解答5

リスト:リストの先頭から n 個の要素を取り出す

let rec take xs n =
  match (n, xs) with
    (0, _) | (_, []) -> []
  | (_, y::ys) -> y :: take ys (n - 1)

n が 0 の場合は空リストを返します。途中でリスト xs が空になった場合も空リストを返します。最後の節で take を再帰呼び出しして、その先頭に要素 y を追加します。

●解答6

リスト:リストの先頭から n 個の要素を削除する

let rec drop xs n =
  match (n, xs) with
    (0, _) -> xs
  | (_, []) -> []
  | (_, _::ys) -> drop ys (n - 1)

最初の節で、削除する要素数が 0 であればリスト xs をそのまま返します。次の節で、xs が空リストの場合は空リストを返します。最後の節で drop を再帰呼び出しして、ys から n - 1 個の要素を取り除いたリストを求めます。

●解答7

リスト:部分リストを取り出す

let subseq xs s e =
  if s > e then []
  else take (drop xs s) (e - s)

subseq は drop と take を使うと簡単です。if 文で s と e の値をチェックして、s > e ならば空リストを返します。そうでなければ、drop で xs から s 個の要素を取り除き、そのリストから e - s 個の要素を take で取り出します。

●解答8

リスト:リストの末尾から n 個の要素を取り除く

let butlastn xs n =
  take xs ((List.length xs) - n)

リスト xs の長さを m とすると、リストの末尾から n 個の要素を取り除くことは、リストの先頭から m - n 個の要素を取り出すことと同じになります。butlastn は取り出す要素の個数を計算して take で取り出すだけです。

●解答9

リスト:リストの分割

let rec group xs n =
  if xs = [] then []
  else (take xs n) :: (group (drop xs n) n)

関数 group は take と drop を使うと簡単に定義できます。xs が空リストの場合は分割できないので空リストを返します。これが再帰の停止条件になります。xs が空リストでない場合、まず take で n 個の要素を格納したリストを求めます。次に、n 個の要素を取り除いたリストを drop で求め、group を再帰呼び出ししてそのリストを分割します。あとはその返り値に take で取り出したリストを追加するだけです。

●解答10

リスト:要素の位置を求める

let position_if pred xs =
  let rec iter i = function
    [] -> None
  | x::xs -> if pred x then Some i else iter (i + 1) xs
  in
    iter 0 xs

局所関数 iter で要素の位置 i を求めます。リストの先頭から順番に調べていき、pred の返り値が真であれば Some i を返します。pred が真となる要素が見つからない場合は None を返します。

●解答11

リスト:要素の個数を求める

let count_if pred xs =
  let rec iter a = function
    [] -> a
  | x::xs -> if pred x then iter (a + 1) xs else iter a xs
  in
    iter 0 xs

(* 別解 *)
let count_if pred xs =
  List.fold_left (fun a b -> if pred b then a + 1 else a) 0 xs

局所関数 iter で要素の個数をカウントします。引数 a を累積変数として使います。pred x が真の場合、a を +1 して iter を再帰呼び出しします。そうでなければ a の値をそのままにして iter を再帰呼び出しします。リストが空リストの場合は a を返します。別解は fold_left を使って書き直したものです。

●解答12

リスト:要素の合計値を求める

let sum_list xs =
  let rec iter a = function
    [] -> a
  | x::xs -> iter (a + x) xs
  in
    iter 0 xs

(* 別解 *)
let sum_list xs =
  List.fold_left (fun a b -> a + b) 0 xs

局所関数 iter で要素の合計値を求めます。引数 a を累積変数として使っていて、iter を再帰呼び出しするとき、a に x を加算します。リストが空リストの場合は a を返します。別解は fold_left を使って書き直したものです。

●解答13

リスト:リストから最大値と最小値を求める

let max_list xs =
  let rec iter a = function
    [] -> a
  | x::xs -> if x > a then iter x xs else iter a xs
  in
    match xs with
      [] -> raise Empty_list
    | y::ys -> iter y ys

let min_list xs =
  let rec iter a = function
    [] -> a
  | x::xs -> if x < a then iter x xs else iter a xs
  in
    match xs with
      [] -> raise Empty_list
    | y::ys -> iter y ys

(* 別解 *)
let max_list xs =
  match xs with
    [] -> raise Empty_list
  | y::ys -> List.fold_left (fun a b -> if a < b then b else a) y ys

let min_list xs =
  match xs with
    [] -> raise Empty_list
  | y::ys -> List.fold_left (fun a b -> if a > b then b else a) y ys

どちらの関数も局所変数 iter で最大値 (最小値) を求めます。引数 a を累積変数として使っていて、そこに最大値 (または最小値) を保持します。最初に呼び出すとき、リストの先頭要素をセットします。あとは残りの要素を順番に調べていき、リストの先頭要素 x が a よりも大きい (または小さい) 場合は、それを a に置き換えるだけです。別解は fold_left で書き直したものです。

●解答14

リスト:a と b は隣り合っているか

let rec adjacent a b = function
  [] | [_] -> false
| x::y::xs -> if a = x && b = y then true else adjacent a b (y::xs)

関数 adjacent の定義は簡単です。リストが x::y::xs とマッチングして、x = a && y = b を満たせば、a と b は隣り合っていることがわかります。そうでなければ、adjacent を再帰呼び出しして残りのリスト y::xs から探します。

●解答15

リスト:x は y よりも前に出現しているか

let rec members x = function
  [] -> []
| y::ys -> if x = y then ys else members x ys

let rec before a b xs =
  let ys = members a xs in
  if ys <> [] then List.mem b ys
  else false

関数 before は関数 members を定義すると簡単にプログラムすることができます。members x xs は x と等しい要素を見つけたとき、x を取り除いた残りのリストを返します。見つからない場合は空リストを返します。before は最初に members で a を探し、残りのリスト ys に b があるか List.mem で探します。

●解答16

リスト:数列の生成

let iota n m =
  let rec iter i a =
    if i < n then a
    else iter (i - 1) (i::a)
  in
    iter m []

局所関数 iter でリストを生成します。累積変数 a にリストを保持します。後ろ (m) から数値を生成してリストに格納していくことに注意してください。i < n になったら a を返します。

●解答17

リスト:集合の生成

let set_of_list xs =
  let rec iter a = function
    [] -> (List.rev a)
  | y::ys -> if List.mem y ys then iter a ys else iter (y::a) ys
  in
    iter [] xs

関数 set_of_list はリストから重複要素を取り除きます。実際の処理は局所関数 iter で行います。リストの先頭要素 y が残りのリスト ys に含まれているか List.mem でチェックします。同じ要素がない場合は累積変数 a に y を追加します。

●解答18

リスト:集合の和

let rec union xs ys =
  match xs with
    [] -> ys
  | z::zs -> if List.mem z ys then union zs ys
             else z :: union zs ys

(* 別解 *)
let union xs ys =
  List.fold_left (fun a b -> if List.mem b ys then a else (b::a)) ys xs

xs が空リストの場合は ys を返します。これは空集合 (空リスト) と集合 ys の和は ys であることを表しています。次の節で xs を z::zs に分解して、z が ys に含まれていなければ、z を集合に追加します。含まれている場合は集合に追加しません。別解は fold_left で書き直したものです。

●解答19

リスト:集合の積

let rec intersection xs ys =
  match xs with
    [] -> []
  | z::zs -> if List.mem z ys then z::intersection zs ys
             else intersection zs ys

(* 別解 *)
let intersection xs ys =
  List.fold_left (fun a b -> if List.mem b ys then (b::a) else a) [] xs

xs が空リストの場合は空リストを返します。これは空集合 (空リスト) と集合 ys の積は空リストであることを表しています。次の節で xs を z::zs に分解して、z が ys に含まれていれば z を集合に追加します。含まれていない場合は集合に追加しません。別解は fold_left で書き直したものです。

●解答20

リスト:集合の差

let rec difference xs ys =
  match xs with
    [] -> []
  | z::zs -> if List.mem z ys then difference zs ys
             else z::difference zs ys

(* 別解 *)
let difference xs ys =
  List.fold_left (fun a b -> if List.mem b ys then a else (b::a)) [] xs

xs が空リストの場合は空リストを返します。これは空集合 (空リスト) と集合 ys の差は空リストであることを表しています。次の節で xs を z::zs に分解して、z が ys に含まれていなければ z を集合に追加します。含まれている場合は集合に追加しません。別解は fold_left で書き直したものです。

●解答21

リスト:リストのマージ

let rec merge_list pred xs ys =
  match (xs, ys) with
    ([], _) -> ys
  | (_, []) -> xs
  | (x1::xs1, y1::ys1) when pred x1 y1 -> x1 :: merge_list pred xs1 ys
  | (_, y1::ys1) -> y1 :: merge_list pred xs ys1

要素の比較は述語 pred で行います。xs が空リストの場合は ys を返し、ys が空リストの場合は xs を返します。次に、xs と ys の先頭要素 x1 と y1 を pred で比較します。pred x1 y1 が真の場合は x1 をリストに追加します。そうでなければ y1 をリストに追加します。

●解答22

リスト:マージソート

let rec merge_sort pred n xs =
  match (n, xs) with
    (_, []) -> []
  | (1, x::xs) -> [x]
  | (2, x1::x2::xs) ->
    if pred x1 x2 then [x1; x2] else [x2; x1]
  | (_, _) ->
    let m = n / 2 in
    merge_list pred (merge_sort pred m xs) (merge_sort pred (n - m) (drop xs m))

要素の比較は述語 pred で行います。引数 n はリスト xs の長さを表します。要素が一つしかない場合は [x] を返します。2 つある場合は要素 x1 と x2 を pred で比較し、pred x1 x2 が真であれば [x1; x2] を、そうでなければ [x2; x1] を返します。それ以外の場合は、リスト xs を二分割して merge_sort を再帰呼び出しし、その結果を merge_list でマージします。

●解答23

リスト:接頭辞の判定

let rec prefix ls ks =
  match (ls, ks) with
    (_, []) -> true
  | ([], _) -> false
  | (x::xs, y::ys) -> if x = y then prefix xs ys else false

接頭辞の判定は簡単です。最初の節は、空リストは接頭辞であることを表しています。次の節で ls が空リストの場合、ks は接頭辞ではないので false を返します。それ以外の場合は、ls と ks の先頭要素を比較して、等しい場合は prefix を再帰呼び出しして次の要素を比較します。等しくない場合は接頭辞ではないので false を返します。

●解答24

リスト:接尾辞の判定

let rec suffix ls ks =
  let n1 = List.length ls and n2 = List.length ks in
  (drop ls (n1 - n2)) = ks

接尾辞の判定も簡単です。リスト ls と ks の長さを求め、ls の先頭から (n1 - n2) 個の要素を取り除きます。これで ls と ks の長さが等しくなるので、あとは単純に演算子 = で比較するだけです。

●解答25

リスト:部分リストの判定

let rec sublist ks ls =
  if prefix ls ks then true
  else if ls = [] then false
  else sublist ks (List.tl ls)

sublist は prefix を使うと簡単です。最初の if で ks が ls の接頭辞であれば部分リストなので true を返します。ls が空リストの場合、ks は部分リストではないので false を返します。それ以外の場合は ls の先頭要素を取り除いて、sublist を再帰呼び出しするだけです。


Copyright (C) 2009 Makoto Hiroi
All rights reserved.

[ PrevPage | OCaml | NextPage ]