n 個の要素 x を持つリストを生成する関数 make_list と、整数 n から m までの値に関数 fn を適用した結果をリストに格納して返す関数 tabulate を定義してください。
val make_list : 'a -> int -> 'a list = <fun> val tabulate : (int -> 'a) -> int -> int -> 'a list = <fun>
# make_list 1 10;; - : int list = [1; 1; 1; 1; 1; 1; 1; 1; 1; 1] # make_list "hello" 5;; - : string list = ["hello"; "hello"; "hello"; "hello"; "hello"] # tabulate (fun x -> x) 1 5;; - : int list = [1; 2; 3; 4; 5] # tabulate (fun x -> x * x) 1 5;; - : int list = [1; 4; 9; 16; 25]
リストから要素 x を削除する関数 remove と、述語 pred が真を返す要素を削除する関数 remove_if を定義してください。
val remove : 'a -> 'a list -> 'a list = <fun>
val remove_if : ('a -> bool) -> 'a list -> 'a list = <fun>
# remove 1 [1; 2; 3; 1; 2; 3; 1; 2; 3];; - : int list = [2; 3; 2; 3; 2; 3] # remove_if (fun x -> x mod 2 = 0) [1; 2; 3; 1; 2; 3; 1; 2; 3];; - : int list = [1; 3; 1; 3; 1; 3]
リストを平坦化する関数 flatten を定義してください。
val flatten : 'a list list -> 'a list = <fun>
# flatten [[1; 2; 3]; [4; 5]; [6]; [7; 8; 9; 10]];; - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] # flatten [[1; 2; 3]; [4; 5]; [6]; []; [7; 8; 9; 10]];; - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
リストから n 個の要素を選ぶ順列を求める関数 permutation を定義してください。なお、生成した順列はリストに格納して返すものとします。
val permutation : int -> 'a list -> 'a list list = <fun>
# permutation 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]]
リストから重複を許して n 個の要素を選ぶ順列を求める関数 repeat_perm を定義してください。なお、生成した順列はリストに格納して返すものとします。
val repeat_perm : int -> 'a list -> 'a list list = <fun>
# repeat_perm 2 [1; 2; 3];; - : int list list = [[1; 1]; [1; 2]; [1; 3]; [2; 1]; [2; 2]; [2; 3]; [3; 1]; [3; 2]; [3; 3]]
n 個の中から r 個を選ぶ組み合わせの数 nＣr を求める関数 comb_num を定義してください。
val comb_num : int -> int -> int = <fun>
# comb_num 5 3;; - : int = 10 # comb_num 10 5;; - : int = 252
リストから n 個の要素を選ぶ組み合わせを求める関数 combination を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
val combination : int -> 'a list -> 'a list list = <fun>
# combination 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]]
リストから重複を許して n 個の要素を選ぶ組み合わせを求める関数 repeat_comb を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
val repeat_comb : int -> 'a list -> 'a list list = <fun>
# repeat_comb 3 [1; 2; 3; 4];; - : int list list = [[1; 1; 1]; [1; 1; 2]; [1; 1; 3]; [1; 1; 4]; [1; 2; 2]; [1; 2; 3]; [1; 2; 4]; [1; 3; 3]; [1; 3; 4]; [1; 4; 4]; [2; 2; 2]; [2; 2; 3]; [2; 2; 4]; [2; 3; 3]; [2; 3; 4]; [2; 4; 4]; [3; 3; 3]; [3; 3; 4]; [3; 4; 4]; [4; 4; 4]]
リストを n 番目の要素で二分割する関数 split_nth を定義してください。
val split_nth : 'a list -> int -> 'a list * 'a list = <fun>
# split_nth [1; 2; 3; 4; 5; 6] 2;; - : int list * int list = ([1; 2], [3; 4; 5; 6])
リストを奇数番目の要素と偶数番目の要素に分ける関数 partition を定義してください。
val partition : 'a list -> 'a list * 'a list = <fun>
# partition [0; 1; 2; 3; 4; 5; 6; 7; 8];; - : int list * int list = ([0; 2; 4; 6; 8], [1; 3; 5; 7])
x と等しい要素の位置でリストを二分割する関数 split_find を定義してください。
val split_find : 'a -> 'a list -> 'a list * 'a list = <fun>
# split_find 3 [1; 2; 3; 4; 5; 6];; - : int list * int list = ([1; 2], [3; 4; 5; 6])
リストを x よりも大きい要素と x 以下の要素に分ける関数 split_ge を定義してください。
val split_ge : 'a -> 'a list -> 'a list * 'a list = <fun>
# split_ge 3 [1; 3; 5; 2; 4; 6];; - : int list * int list = ([1; 3; 2], [5; 4; 6])
リストの要素に述語 pred を適用し、一つでも真を返す要素があれば真を返す関数 any と、一つでも偽を返す要素があれば偽を返す (全てが真の場合に真を返す) 関数 every を定義してください。
val any : ('a -> bool) -> 'a list -> bool = <fun>
val every : ('a -> bool) -> 'a list -> bool = <fun>
# 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
y と等しいリストの要素を全て x に置換する関数 substitute x y ls と、述語 pred が真を返す要素を全て x に置換する関数 substitute_if x pred ls を定義してください。
val substitute : 'a -> 'a -> 'a list -> 'a list = <fun>
val substitute_if : 'a -> ('a -> bool) -> 'a list -> 'a list = <fun>
# 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]
map f xs はリスト xs の要素に関数 f を適用します。関数 maplist は関数 f にリストそのものを渡します。ただし、繰り返すたびにリストの先頭要素は取り除かれていきます。関数 maplist を定義してください。
val maplist : ('a list -> 'b) -> 'a list -> 'b list = <fun>
# 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]
リスト操作を一般化した関数 foreach_list fn comb term xs を定義してください。ここで、fn はリストの要素に適用する関数、comb は関数の返り値を結合する関数、term は終端の値、xs がリストです。
val foreach_list : ('a -> 'b) -> ('b -> 'c -> 'c) -> 'c -> 'a list -> 'c = <fun>
# foreach_list (fun x -> x) (+) 0 [1; 2; 3; 4; 5];; - : int = 15 # foreach_list (fun x -> x * x) (+) 0 [1; 2; 3; 4; 5];; - : int = 55 # foreach_list (fun x -> x) (@) [] [[1; 2]; [3]; [4; 5; 6]];; - : int list = [1; 2; 3; 4; 5; 6]
foreach_list を使ってマッピング、フィルター、畳み込みを行う関数を定義してください。
リスト xs の中で連続した等しい記号を部分リストにまとめる関数 pack を定義してください。
val pack : 'a list -> 'a list list = <fun>
# pack [1; 1; 1; 2; 2; 2; 2; 3; 3; 4; 5; 5];; - : int list list = [[1; 1; 1]; [2; 2; 2; 2]; [3; 3]; [4]; [5; 5]]
整列済みの整数を表すリストで、連続している部分列を (start, end) に置き換える関数 pack_num_list を定義してください。start は部分列の始点、end は部分列の終点を表します。
val pack_num_list : int list -> (int * int) list = <fun>
# pack_num_list [1; 2; 3; 5; 7; 8; 9; 10];; - : (int * int) list = [(1, 3); (5, 5); (7, 10)]
なお、この問題は下記サイトを参考にさせていただきました。関係各位に感謝いたします。
問題 44 の逆変換を行う関数 expand_num_list を定義してください。
val expand_num_list : (int * int) list -> int list = <fun>
# expand_num_list [(1, 3); (4, 5); (6, 6); (7, 10)];; - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
連続している同じ記号を (code, num) に変換する関数 encode を定義してください。code は記号、num は個数を表します。このような変換を「ランレングス符号化」といいます。
val encode : 'a list -> ('a * int) list = <fun>
# encode [1; 1; 1; 2; 2; 2; 2; 3; 4; 4; 5; 5; 5; 5; 5; 5];; - : (int * int) list = [(1, 3); (2, 4); (3, 1); (4, 2); (5, 6)]
問題 46 の逆変換を行う関数 decode を定義してください。
val decode : ('a * int) list -> 'a list = <fun>
# decode [(1, 3); (2, 4); (3, 1); (4, 5)];; - : int list = [1; 1; 1; 2; 2; 2; 2; 3; 4; 4; 4; 4; 4]
3 行 3 列の変形魔方陣を解くプログラムを作ってください。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│ 式
├─┼─┼─┤ A + B + C = N
│Ｄ│ │Ｅ│ A + D + F = N
├─┼─┼─┤ C + E + H = N
│Ｆ│Ｇ│Ｈ│ F + G + H = N
└─┴─┴─┘
図 : 変形魔方陣
上図の A から H の場所に 1 から 8 までの数字をひとつずつ配置します。四辺の合計が等しくなるように数字を配置してください。
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。覆面算 WRONG * M = RIGHT を解くプログラムを作ってください。なお、今回は使用する数字を 1 から 9 までとします。
W R O N G * M ------------ R I G H T 図 : 小町覆面算
自然数 n 以下の素数をすべて求める関数 sieve を作ってください。
val sieve : int -> int list = <fun>
# sieve 100;; - : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29; 31; 37; 41; 43; 47; 53; 59; 61; 67; 71; 73; 79; 83; 89; 97]
リスト : リストの生成
let make_list x n =
let rec iter n a =
if n = 0 then a
else iter (n - 1) (x::a)
in
iter n []
let tabulate fn n m =
let rec iter m a =
if n < m then a
else iter (m - 1) ((fn m)::a)
in
iter m []
make_list と tabulate は局所関数 iter でリストを生成します。どちらの場合も累積変数 a を使用します。make_list は n 個の要素をリスト a に格納して返します。tabulate は m, m - 1, m - 2, ..., n + 1, n までの整数値に関数 fn を適用し、その結果をリスト a に格納して返します。
リスト : リストの要素を削除する
let rec remove x = function
[] -> []
| y::ys -> if x = y then remove x ys
else y :: remove x ys
let rec remove_if pred = function
[] -> []
| x::xs -> if pred x then remove_if pred xs
else x :: remove_if pred xs
remove と remove_if も簡単です。remove は引数 x と等しい要素を、remove_if は述語 pred が真となる要素をリストに追加しません。そのほかの要素をリストに追加します。
リスト : リストの平坦化 let rec flatten = function [] -> [] | x::xs -> x @ (flatten xs)
flatten は簡単です。リストの先頭要素 x を取り出して、x と次の要素を @ で結合すればいいわけです。なお、OCaml の標準ライブラリ List にも flatten が用意されています。
リスト : 順列の生成
(* map の結果を平坦化する *)
let flatmap func ls = flatten (List.map func ls)
(* 順列の生成 *)
let rec permutation n ls =
if n = 0 then [[]]
else flatmap (fun x -> List.map (fun y -> x :: y)
(permutation (n - 1) (remove x ls)))
ls
関数 permutation は引数のリスト ls から n 個を選ぶ順列を生成し、それをリストに格納して返します。n = 0 が再帰の停止条件で、空リストを格納したリストを返します。このリストに対して要素を追加します。この処理は map を二重に使うと簡単に実現できます。このとき、flatten を使ってリストを平坦化します。これを関数 flatmap で行っています。
あとは匿名関数の中で permutation を再帰呼び出しをして、n - 1 個を選ぶ順列を生成します。そして、その返り値にリスト ls の要素 x を追加すれば、n 個を選ぶ順列を生成することができます。
リスト : 重複順列
let rec repeat_perm n ls =
if n = 0 then [[]]
else flatmap (fun x -> List.map (fun y -> x :: y)
(repeat_perm (n - 1) ls))
ls
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat_perm を再帰呼び出しするとき、リスト ls をそのまま渡すだけです。
組み合わせの数を nＣr と表記します。nＣr を求めるには、次の公式を使えば簡単です。
nＣr = n * (n - 1) * (n - 2) * ... * (n - r + 1) / (1 * 2 * 3 * ... * r)
皆さんお馴染みの公式ですね。この公式をそのままプログラムすることもできますが、次の式を使うともっと簡単にプログラムできます。
nＣ0 = nＣn = 1 nＣr = nＣr-1 * (n - r + 1) / r
この式は nＣr と nＣr-1 の関係を表しています。あとは再帰定義を使って簡単にプログラムできます。
リスト : 組み合わせの数 let rec comb_num n r = if n = r || r = 0 then 1 else (comb_num n (r - 1)) * (n - r + 1) / r
組み合わせの生成は、次に示す組み合わせの公式と同じ考え方でプログラムすることができます。
nＣ0 = nＣn = 1 nＣr = n-1Ｃr-1 + n-1Ｃr
プログラムは次のようになります。
リスト : 組み合わせの生成
exception Combination
let rec combination n xs =
match (n, xs) with
(0, _) -> [[]]
| (_, []) -> raise Combination
| (_, y::ys) ->
if List.length xs = n then [xs]
else
(List.map (fun x -> y::x)
(combination (n - 1) ys))
@ (combination n ys)
最初の節は個数 n が 0 の場合です。選択する要素がないので空リストを格納したリストを返します。次の節で、選ぶ要素がなくなった場合はエラーを送出します。最後の節で、n と xs の要素数が同じ場合は、その要素を全て選択するのでリスト [xs] を返します。
そうでなければ、先頭要素 y を選びます。残りのリスト ys から n - 1 個を選ぶ組み合わせを生成して、その先頭に y を追加します。あとは、ys から n 個を選ぶ組み合わせを combination で求めて、演算子 @ で連結するだけです。
リスト : 重複組み合わせ
let rec repeat_comb n xs =
match (n, xs) with
(0, _) -> [[]]
| (_, []) -> raise Combination
| (_, [y]) -> [make_list y n]
| (_, y::ys) ->
(List.map (fun x -> y::x)
(repeat_comb (n - 1) xs))
@ (repeat_comb n ys)
重複組み合わせを求める repeat_comb も簡単です。3 番目の節で、リスト xs に要素が一つしかない場合は、その要素 y を n 個選びます。make_list で y を n 個格納したリストを生成します。最後の節では、先頭要素 y を選んだあと、それを取り除かないで xs から n - 1 個の要素を選びます。
リスト : n 番目の要素で分割する let split_nth ls n = (take ls n, drop ls n)
split_nth は take と drop を使うと簡単です。take で先頭から n 個の要素を取り出し、drop で先頭から n 個の要素を取り除くだけです。
リスト : リストの要素を偶数番目と奇数番目で分ける
let partition ls =
let rec odd_part = function
[] -> ([], [])
| x::xs -> let (ys, zs) = even_part xs in (ys, x::zs)
and even_part = function
[] -> ([], [])
| x::xs -> let (ys, zs) = odd_part xs in (x::ys, zs)
in
even_part ls
(* 別解 *)
let partition ls =
let rec iter n ls xs ys =
match ls with
[] -> (List.rev xs, List.rev ys)
| z::zs -> if n = 0 then iter 1 zs (z::xs) ys
else iter 0 zs xs (z::ys)
in
iter 0 ls [] []
奇数番目の要素は局所関数 odd_part で、偶数番目の要素は局所関数 even_part で取り出すと簡単です。この場合、odd_part と even_part は相互再帰になります。別解は末尾再帰でプログラムしたもので、局所関数 iter の第 1 引数で奇数番目と偶数番目を判別しています。
リスト : x と等しい要素の位置で分割
let rec split_find x = function
[] -> ([], [])
| y::ys as ls -> if x = y then ([], ls)
else let (a, b) = split_find x ys in (y::a, b)
(* 別解 *)
let split_find x ls =
let rec iter ls a =
match ls with
[] -> (List.rev a, [])
| y::ys as ls -> if x = y then (List.rev a, ls)
else iter ys (y::a)
in
iter ls []
引数のリストが空リストの場合は x と等しい要素が見つからなかったので ([], []) を返します。次の節で、x と y が等しい場合、空リストと x を含むリスト ls を返します。そうでなければ、split_find を再帰呼び出しして次の要素を調べます。返り値は局所変数 (a, b) で受け取り、y を a のリストに追加して返します。
別解は末尾再帰でプログラムしたものです。実際の処理は局所関数 iter で行います。引数 a に x と等しくない要素を格納します。ls が空リストの場合、x と等しい要素は見つからなかったので (List.rev a, []) を返します。次の節で x と等しい要素が見つかった場合、List.rev a と x を含むリスト ls を返します。そうでなければ、iter を再帰呼び出しして次の要素を調べます。このとき、要素 y をリスト a に格納します。
リスト : リストを x よりも大きい要素と x 以下の要素に分ける
let rec split_ge x = function
[] -> ([], [])
| y::ys -> let (a, b) = split_ge x ys in
if x > y then (a, y::b) else (y::a, b)
(* 別解 *)
let split_ge x ls =
let rec iter ls xs ys =
match ls with
[] -> (List.rev xs, List.rev ys)
| z::zs -> if z < x then iter zs xs (z::ys)
else iter zs (z::xs) ys
in
iter ls [] []
引数のリストが空リストの場合は ([], []) を返します。次の節で、リストを y と ys に分解して split_ge を再帰呼び出しします。返り値を局所変数 (a, b) で受け取り、y が x よりも小さい場合はリスト b に追加し、そうでない場合は a に追加して返します。
別解は末尾再帰でプログラムしたものです。実際の処理は局所関数 iter で行います。x 以下の要素を引数 xs に、x よりも大きい要素を引数 ys に格納します。ls が空リストになったら、xs と ys を反転して返します。
リスト : 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
any と every は簡単です。リストを x と xs に分解して、pred x が真を返す場合、any は true を返します。逆に偽を返す場合、every は false を返します。それ以外の場合は再帰呼び出しして次の要素をチェックします。引数のリストが空リストになった場合、any は false を返し、every は true を返します。
なお、OCaml の標準ライブラリ List には同等の働きをする関数 exists と for_all があります。
リスト : リストの置換
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
substitute はリストの要素 z が引数 y と等しい場合、その要素を引数 x に置き換えます。substitute_if は pred z が真を返す場合、その要素を引数 x に置き換えます。そうでなければ、要素 z をそのままリストに追加します。
リスト : maplist let rec maplist fn = function [] -> [] | _::xs as ls -> (fn ls) :: maplist fn xs
maplist は簡単です。関数 fn に引数のリスト ls をそのまま渡すだけです。maplist を再帰呼び出しするときは、先頭の要素を取り除いたリスト xs を渡します。maplist を使うと map は次のように定義することができます。
リスト : map の定義 let map fn ls = maplist (fun x -> fn (List.hd x)) ls
リスト : リスト操作の一般化 let rec foreach_list fn comb term = function [] -> term | x::xs -> comb (fn x) (foreach_list fn comb term xs)
関数 foreach_list の引数 fn はリストの要素に適用する関数、comb は fn の返り値と foreach_list の返り値を結合する関数、term はリストの終端で返す値です。プログラムは簡単で、引数のリストが空リストならば term を返します。そうでなければ、リストの要素 x に関数 fn を適用し、その返り値と for_each_list の返り値を関数 comb で結合します。
リスト : マッピング、フィルター、畳み込み let cons a b = a::b let map fn ls = foreach_list fn cons [] ls let filter fn ls = foreach_list (fun x -> if fn x then [x] else []) (@) [] ls let fold_right fn a ls = foreach_list (fun x -> x) (fun x y -> (fn x y)) a ls
演算子 :: は (::) で関数化することができないので、関数 cons を定義します。map は comb に cons を、term に [ ] を渡せば実現できます。filter はリストの要素 x に関数 fn を適用し、真を返す場合は [x] を返し、偽の場合は [ ] を返します。それを演算子 @ で連結すると、[ ] はリストの要素に含まれないので、フィルターとして動作します。fold-right も簡単です。(fun x -> x) でリストの要素をそのまま返し、要素を連結する関数の中で fn を呼び出します。
リスト : 連続した同じ記号を部分リストにまとめる
let pack ls =
let rec iter ls a b =
match (ls, a) with
([], _) -> List.rev (a::b)
| (_, []) -> raise Empty_list
| (x::xs, y::ys) ->
if x = y then iter xs (y::a) b
else iter xs [x] (a::b)
in
match ls with
[] -> raise Empty_list
| y::ys -> iter ys [y] []
実際の処理は局所関数 iter で行います。引数 a と b は累積変数です。a は連続した記号を格納するリストで、そのリストを b に格納します。最初の節で、引数のリストが空リストの場合は a を b に格納し、そのリストを List.rev で反転して返します。次の節はエラーチェックです。a が空リストの場合はエラーを送出します。
最後の節で、ls を x と xs に、a を y と ys に分解します。x と y が等しい場合は同じ記号が続いているので y を a に追加します。そうでなければ、iter を再帰呼び出しして次の記号を調べます。このとき、a を b に追加して、x をリストに格納して引数 a に渡します。
リスト : 連続している数列を (s, e) で表す
let pack_num_list ls =
let rec iter ls a =
match (ls, a) with
([], _) -> List.rev a
| (_, []) -> raise Empty_list
| (x::xs, (s,e)::ys) ->
if x = e + 1 then iter xs ((s,x)::ys)
else iter xs ((x,x)::a)
in
match ls with
[] -> raise Empty_list
| x::xs -> iter xs [(x,x)]
実際の処理は局所関数 iter で行います。引数 a を累積変数として使います。最初の節で ls が空リストの場合は a を反転して返します。次の節はエラーチェックで、a が空リストの場合はエラーを送出します。最後の節で、ls を x と xs に、a を (s, e) と ys に分解します。x = e + 1 ならば x は連続した数字です。リスト a の (s, e) を (s, x) に置き換えます。そうでなければ、x は連続していないので、リスト a に (x, x) を追加します。あとは iter を再帰呼び出しして次の数字を調べます。
連続していない数字 x をタプル (x, x) ではなく数字だけで表す場合は、次のようにデータ型を定義する必要があります。
リスト : 別解
type pack_num = Int of int | Pack of int * int
let pack_num_list1 ls =
let push_num s e a =
if s = e then (Int s) :: a else (Pack (s, e)) :: a
in let rec iter ls s e a =
match ls with
[] -> List.rev (push_num s e a)
| x::xs -> if x = e + 1 then iter xs s x a
else iter xs x x (push_num s e a)
in
match ls with
[] -> raise Empty_list
| x::xs -> iter xs x x []
pack_num はタプルと数値を表すデータ型です。pack_num_list1 は pack_num list を返します。
リスト : (s, e) を数列に戻す let rec expand_num_list = function [] -> [] | (s, e)::xs -> (iota s e) @ (expand_num_list xs) (* 別解 *) let rec expand_num_list1 = function [] -> [] | (Int x)::xs -> x :: expand_num_list1 xs | (Pack (s, e))::xs -> (iota s e) @ (expand_num_list1 xs)
expand_num_list は iota を使うと簡単です。最初の節が再帰の停止条件です。次の節で、(s, e) を iota で数列に変換します。expand_num_list を再帰呼び出しして残りのリスト xs を数列に戻し、その返り値に iota で変換したリストを演算子 @ で連結します。別解の expand_num_list1 は pack_num list を int list に変換します。
リスト : ランレングス符号化
let rec drop_same_code x ls n =
match ls with
[] -> (n, [])
| y::ys -> if x = y
then drop_same_code x ys (n + 1)
else (n, ls)
let rec encode ls =
match ls with
[] -> []
| x::xs -> let (n, ys) = drop_same_code x xs 1 in
(x, n) :: encode ys
リストの先頭から連続している記号を関数 drop_same_code で取り除きます。このとき、その個数もカウントします。引数 n が累積変数です、ls が空リストの場合は n と空リストを返します。そうでなければ、ls を y と ys に分解して x と y を比較します。x と y が等しい場合は drop_same_code を再帰呼び出しして同じ記号を数えます。そうでなければ、個数 n とリスト ls を返します。
関数 encode は drop_same_code を呼び出して x と等しい記号の個数 n と、x を取り除いたリスト ys を求めます。あとは ys を encode で符号化して、その結果に (x, n) を追加するだけです。
リスト : ランレングス復号 let rec decode = function [] -> [] | (x, n)::xs -> (make_list x n) @ (decode xs)
関数 decode は make_list を使うと簡単です。(x, n) を make_list でリストに展開して、その結果と decode xs の返り値を演算子 @ で連結するだけです。
リスト : 魔方陣
exception Solve_err
let solve1 () =
List.iter
(fun nums ->
match nums with
a::b::c::d::e::f::g::h::[] ->
let n1 = a + b + c and
n2 = a + d + f and
n3 = c + e + h and
n4 = f + g + h
in
if n1 = n2 && n2 = n3 && n3 = n4 then (
List.iter (fun x -> print_int x; print_string " ") nums;
print_int n1; print_newline ()
) else ()
| _ -> raise Solve_err)
(permutation 8 (iota 1 8))
単純な生成検定法です。実行結果は次のようになります。
# solve1 ();; 1 4 8 7 3 5 6 2 13 1 5 6 8 4 3 7 2 12 1 5 8 6 2 7 3 4 14 1 6 7 5 3 8 2 4 14 1 7 5 4 6 8 3 2 13 1 7 5 8 2 4 3 6 13 1 8 3 5 7 6 4 2 12 1 8 4 7 3 5 2 6 13 2 3 8 6 4 5 7 1 13 2 4 6 7 5 3 8 1 12 2 6 5 3 7 8 4 1 13 2 7 3 4 8 6 5 1 12 3 4 8 5 1 7 2 6 15 3 5 7 4 2 8 1 6 15 3 6 5 7 1 4 2 8 14 3 7 2 8 4 1 5 6 12 3 7 4 6 2 5 1 8 14 3 8 1 7 5 2 4 6 12 4 2 8 3 5 7 6 1 14 4 2 8 7 1 3 6 5 14 4 3 6 8 2 1 7 5 13 4 3 7 2 6 8 5 1 14 4 7 3 2 6 8 1 5 14 4 8 1 3 7 6 2 5 13 5 1 8 6 2 3 7 4 14 5 2 6 7 3 1 8 4 13 5 6 2 7 3 1 4 8 13 5 6 3 1 7 8 2 4 14 5 7 1 2 8 6 3 4 13 5 7 1 6 4 2 3 8 13 6 1 8 2 4 7 5 3 15 6 2 5 3 7 4 8 1 13 6 2 7 1 5 8 4 3 15 6 3 4 2 8 5 7 1 13 6 4 2 5 7 1 8 3 12 6 5 1 4 8 2 7 3 12 7 2 6 5 1 3 4 8 15 7 3 4 6 2 1 5 8 14 7 5 3 2 4 6 1 8 15 7 6 1 3 5 4 2 8 14 8 1 5 2 6 4 7 3 14 8 1 6 4 2 3 5 7 15 8 2 4 1 7 5 6 3 14 8 2 4 5 3 1 6 7 14 8 3 2 4 6 1 7 5 13 8 4 1 3 7 2 6 5 13 8 4 3 1 5 6 2 7 15 8 5 1 2 6 4 3 7 14 - : unit = ()
解は 48 通り出力されましたが、重複解を取り除くと解は次に示す 6 通りしかありません。
1 6 7 5 3 8 2 4 14 1 7 5 4 6 8 3 2 13 1 8 3 5 7 6 4 2 12 1 8 4 7 3 5 2 6 13 3 5 7 4 2 8 1 6 15 3 7 4 6 2 5 1 8 14
重複解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│
├─┼─┼─┤ A < C < F
│Ｄ│ │Ｅ│
├─┼─┼─┤ A < H
│Ｆ│Ｇ│Ｈ│
└─┴─┴─┘
図 : 対称解のチェック
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、順列を生成するとき、重複解のチェックを入れると枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。
リスト : 小町覆面算
let solve2 () =
List.iter
(fun nums ->
match nums with
w::r::o::n::g::m::i::h::t::[] ->
let n1 = w * 10000 + r * 1000 + o * 100 + n * 10 + g and
n2 = r * 10000 + i * 1000 + g * 100 + h * 10 + t
in
if n1 * m = n2 then (
print_int n1; print_string " * ";
print_int m; print_string " = ";
print_int n2; print_newline ()
) else ()
| _ -> raise Solve_err)
(permutation 9 (iota 1 9))
単純な生成検定法です。実行結果は次のようになります。
# solve2 ();; 16958 * 4 = 67832 - : unit = ()
素数を求める基本的な考え方は簡単です。最初に、2 から n までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい) 」といいます。
プログラムは次のようになります。
リスト : 素数 (エラトステネスの篩)
let sieve n =
let rec iter ls a =
match ls with
[] -> List.rev a
| x::xs -> iter (remove_if (fun y -> y mod x = 0) xs) (x::a)
in
iter (iota 2 n) []
実際の処理は局所関数 iter で行います。引数 a は素数を格納するリストです。iota で 2 から n までの整数列を生成し、それを iter に渡します。iter はリストの先頭要素 x で割り切れる要素を remove_if で取り除き、iter を再帰呼び出しします。このとき、累積変数 a に素数 x を追加します。ls が空リストになった場合、累積変数には素数が逆順にセットされているので、List.rev で反転して返します。
関数 sieve には無駄な処理があります。リストの先頭要素 x が √n よりも大きい場合、リストには素数しか残っていません。つまり、ふるいにかけるのは x <= √n まででいいのです。これをプログラムすると次のようになります。
リスト : 別解
let sieve1 n =
let rec iter ls a =
match ls with
[] -> List.rev a
| x::xs ->
if x * x > n then List.rev_append a ls
else iter (remove_if (fun y -> y mod x = 0) xs) (x::a)
in
iter (iota 2 n) []
局所関数 iter で、リストの先頭要素 x が x * x > n ならば、累積変数 a とリスト ls を rev_append で連結して返します。これで sieve よりも速く素数を求めることができます。
ところで、「エラトステネスの篩」は配列を使ってプログラムしたほうが高速になります。次のリストを見てください。
リスト : 配列版
let sieve2 n =
let p = Array.make (n / 2 + 1) true in
let rec iter0(i, j) =
if j < n / 2 + 1 then (
p.(j) <- false;
iter0(i, j + i)
) else ()
in
let rec iter1(i, j, a) =
if i > n then List.rev a
else iter1(i + 2, j + 1, if p.(j) then i::a else a)
in
let rec iter2(i, j, a) =
if i * i > n then iter1(i, j, a)
else if p.(j) then (
iter0(i, j + i);
iter2(i + 2, j + 1, i::a)
) else iter2(i + 2, j + 1, a)
in
iter2(3, 1, [2])
bool 型の配列 p で奇数列 (1, 3, 5, 7, ... ) を表します。true で素数を表し、素数でない場合は false に書き換えます。配列 p は true で初期化されるので、最初はすべての数が素数ということになります。
プログラムでは、奇数を変数 i で、それに対応する配列 p の添字を変数 j で表します。変数 i は 3, 5, 7, 9, ... に、それに対応する変数 j は 1, 2, 3, 4, ... になります。この場合、i の倍数に対応する j の値は j + i, j + i * 2, j + i * 3, ... になります。たとえば、3, 5, 7 の倍数は次のようになります。
i | 3 5 7 9 11 13 15 17 19 21 23 25 j | 1 2 3 4 5 6 7 8 9 10 11 12 --+------------------------------------- 3 | O 0 O 0 5 | 0 0 0 7 | 0 0
プログラムは簡単です。局所関数 iter0 で i の倍数を false に書き換えます。局所関数 iter1 は配列 p に残された素数を累積変数 a に格納して返します。iter2 は i * i が n 以下であれば iter0 を呼び出して素数 i の倍数を削除し、そうでなければ iter1 を呼び出します。