●問題26
n 個の要素 x を持つリストを生成する関数 make_list と、整数 n から m までの値に関数 f を適用した結果をリストに格納して返す関数 tabulate を定義してください。
val make_list = fn : 'a * int -> 'a list val tabulate = fn : (int -> 'a) -> int -> int -> 'a list
- make_list(1, 10);
val it = [1,1,1,1,1,1,1,1,1,1] : int list
- make_list("a", 8);
val it = ["a","a","a","a","a","a","a","a"] : string list
- make_list([2], 6);
val it = [[2],[2],[2],[2],[2],[2]] : int list list
- tabulate (fn(x) => x) 1 5;
val it = [1,2,3,4,5] : int list
- tabulate (fn(x) => x * x) 1 5;
val it = [1,4,9,16,25] : int list
- tabulate (fn(x) => [x * x]) 1 5;
val it = [[1],[4],[9],[16],[25]] : int list list
●問題27
リストから要素 x を削除する関数 remove と、述語 pred が真を返す要素を削除する関数 remove_if を定義してください。
val remove = fn : ''a * ''a list -> ''a list
val remove_if = fn : ('a -> bool) -> 'a list -> 'a list
- remove(1, [1,2,3,1,2,3,1,2,3]); val it = [2,3,2,3,2,3] : int list - remove_if (fn(x) => x mod 2 = 0) [1,2,3,4,5,6,7,8]; val it = [1,3,5,7] : int list - remove_if (fn(x) => x mod 2 <> 0) [1,2,3,4,5,6,7,8]; val it = [2,4,6,8] : int list
●問題28
リストを平坦化する関数 flatten を定義してください。
val flatten = fn : 'a list list -> 'a list
- flatten([[1,2],[3,4,5],[6],[7,8,9,10]]); val it = [1,2,3,4,5,6,7,8,9,10] : int list - flatten([[1,2],[3,4,5],[],[6],[7,8,9,10]]); val it = [1,2,3,4,5,6,7,8,9,10] : int list
●問題29
リスト xs に格納されたリストに関数 f を適用し、その結果を連結する関数 flatmap(F, Xs) を定義してください。
val flatmap = fn : ('a -> 'b list) * 'a list -> 'b list
- flatmap(fn(x) => 10::x, [[1,2,3],[4,5],[6]]); val it = [10,1,2,3,10,4,5,10,6] : int list
●問題30
リストから n 個の要素を選ぶ順列を求める関数 permutation を定義してください。なお、生成した順列はリストに格納して返すものとします。
val permutation = fn : int * ''a list -> ''a list list
- permutation(3, [1,2,3]); val it = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]] : int list list - permutation(4, [1,2,3,4]); val it = [[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],...] : int list list
●問題31
リストから重複を許して n 個の要素を選ぶ順列を求める関数 repeat_perm を定義してください。なお、生成した順列はリストに格納して返すものとします。
val repeat_perm = fn : int * 'a list -> 'a list list
- repeat_perm(2, [1,2,3]); val it = [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]] : int list list - repeat_perm(3, [1,2,3]); val it = [[1,1,1],[1,1,2],[1,1,3],[1,2,1],[1,2,2],[1,2,3],[1,3,1],[1,3,2],[1,3,3], [2,1,1],[2,1,2],[2,1,3],...] : int list list
●問題32
n 個の中から r 個を選ぶ組み合わせの数 nＣr を求める関数 comb_num を定義してください。
val comb_num = fn : IntInf.int * IntInf.int -> IntInf.int
- comb_num(5, 3); val it = 10 : IntInf.int - comb_num(10, 5); val it = 252 : IntInf.int - comb_num(30, 15); val it = 155117520 : IntInf.int - comb_num(50, 25); val it = 126410606437752 : IntInf.int
●問題33
リストから n 個の要素を選ぶ組み合わせを求める関数 combination を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
val combination = fn : int * 'a list -> 'a list list
- combination(3, [1,2,3,4,5]); val it = [[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]] : int list list
●問題34
リストから重複を許して n 個の要素を選ぶ組み合わせを求める関数 repeat_comb を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
val repeat_comb = fn : int * 'a list -> 'a list list
- repeat_comb(2, [1,2,3]); val it = [[1,1],[1,2],[1,3],[2,2],[2,3],[3,3]] : int list list - repeat_comb(2, [1,2,3,4]); val it = [[1,1],[1,2],[1,3],[1,4],[2,2],[2,3],[2,4],[3,3],[3,4],[4,4]] : int list list
●問題35
リストを n 番目の要素で二分割する関数 split_nth を定義してください。
val split_nth = fn : 'a list * int -> 'a list * 'a list
- split_nth([1,2,3,4,5,6], 2); val it = ([1,2],[3,4,5,6]) : int list * int list - split_nth([1,2,3,4,5,6], 0); val it = ([],[1,2,3,4,5,6]) : int list * int list - split_nth([1,2,3,4,5,6], 6); val it = ([1,2,3,4,5,6],[]) : int list * int list
●問題36
リスト xs を述語 pred が真を返すものと偽を返すものの 2 つに分ける関数 partition pred xs を定義してください。分割したリストはタプルに格納して返すものとします。
val partition = fn : ('a -> bool) -> 'a list -> 'a list * 'a list
- partition (fn(x) => x mod 2 = 0) [1,2,3,4,5,6,7,8]; val it = ([2,4,6,8],[1,3,5,7]) : int list * int list - partition (fn(x) => x mod 2 <> 0) [1,2,3,4,5,6,7,8]; val it = ([1,3,5,7],[2,4,6,8]) : int list * int list - partition (fn(x) => x mod 3 = 0) [1,2,3,4,5,6,7,8]; val it = ([3,6],[1,2,4,5,7,8]) : int list * int list
●問題37
2 つのリスト xs, ys の要素 x, y を取り出し、タプル (x, y) にまとめてリストに格納して返す関数 zip(xs, ys) を定義してください。リストは短いほうに合わせるものとします。
val zip = fn : 'a list * 'b list -> ('a * 'b) list
- zip([1,2,3,4],[5,6,7,8]); val it = [(1,5),(2,6),(3,7),(4,8)] : (int * int) list - zip([1,2,3,4],[5,6,7,8,9]); val it = [(1,5),(2,6),(3,7),(4,8)] : (int * int) list - zip([1,2,3,4],[5,6,7]); val it = [(1,5),(2,6),(3,7)] : (int * int) list
●問題38
リストの要素に述語 pred を適用し、一つでも真を返す要素があれば真を返す関数 any と、一つでも偽を返す要素があれば偽を返す (全てが真の場合に真を返す) 関数 every を定義してください。
val any = fn : ('a -> bool) -> 'a list -> bool
val every = fn : ('a -> bool) -> 'a list -> bool
- any (fn x => x mod 2 = 0) [1,3,5,7,9]; val it = false : bool - any (fn x => x mod 2 = 0) [1,3,5,7,9,10]; val it = true : bool - every (fn x => x mod 2 = 0) [2,4,6,8,10]; val it = true : bool - every (fn x => x mod 2 = 0) [2,4,6,8,9,10]; val it = false : bool
●問題39
y と等しいリストの要素を全て x に置換する関数 substitute(x, y, ls) と、述語 pred が真を返す要素を全て x に置換する関数 substitute_if pred x ls を定義してください。
val substitute = fn : ''a * ''a * ''a list -> ''a list
val substitute_if = fn : ('a -> bool) -> 'a -> 'a list -> 'a list
- substitute(1, 2, [1,2,3,1,2,3,4,1,2,3,4,5]); val it = [1,1,3,1,1,3,4,1,1,3,4,5] : int list - substitute_if (fn x => x mod 2 = 0) ~1 [1,2,3,4,5,6,7,8]; val it = [1,~1,3,~1,5,~1,7,~1] : int list
●問題40
map f xs はリスト xs の要素に関数 f を適用します。関数 maplist は関数 f にリストそのものを渡します。ただし、繰り返すたびにリストの先頭要素は取り除かれていきます。関数 maplist を定義してください。
val maplist = fn : ('a list -> 'b) -> 'a list -> 'b list
- maplist (fn x => x) [1,2,3,4,5]; val it = [[1,2,3,4,5],[2,3,4,5],[3,4,5],[4,5],[5]] : int list list - maplist (fn x => foldl (fn(y, a) => a + y) 0 x) [1,2,3,4,5]; val it = [15,14,12,9,5] : int list
●問題41
リスト操作を一般化した関数 for_each_list f comb term xs を定義してください。ここで、f はリストの要素に適用する関数、comb は関数の返り値を結合する関数、term は終端の値、xs がリストです。
val for_each_list = fn : ('a -> 'b) -> ('b * 'c -> 'c) -> 'c -> 'a list -> 'c
- for_each_list (fn x => x) (op +) 0 [1,2,3,4,5]; val it = 15 : int - for_each_list (fn x => x * x) (op +) 0 [1,2,3,4,5]; val it = 55 : int - for_each_list (fn x => x) (op @) [] [[1,2],[3,4,5],[6]]; val it = [1,2,3,4,5,6] : int list
●問題42
for_each_list を使ってマッピング、フィルター、畳み込みを行う関数を定義してください。
val my_map = fn : ('a -> 'b) -> 'a list -> 'b list
val my_filter = fn : ('a -> bool) -> 'a list -> 'a list
val my_foldr = fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
- my_map (fn x => x * x) [1,2,3,4,5]; val it = [1,4,9,16,25] : int list - my_filter (fn x => x mod 2 = 0) [1,2,3,4,5,6]; val it = [2,4,6] : int list - my_foldr (fn(x, a) => x + a) 0 [1,2,3,4,5,6]; val it = 21 : int
●問題43
リスト xs の中で連続した等しい記号を部分リストにまとめる関数 pack を定義してください。
val pack = fn : ''a list -> ''a list list
- pack([1,1,1,2,2,3,4,4,4,4,4,5,5,5]); val it = [[1,1,1],[2,2],[3],[4,4,4,4,4],[5,5,5]] : int list list
●問題44
整列済みの整数を表すリストで、連続している部分列を (start, end) に置き換える関数 pack_num_list を定義してください。start は部分列の始点、end は部分列の終点を表します。
val pack_num_list = fn : int list -> (int * int) list
- pack_num_list([1,2,3,5,7,8,9,10]); val it = [(1,3),(5,5),(7,10)] : (int * int) list
なお、この問題は下記サイトを参考にさせていただきました。関係各位に感謝いたします。
●問題45
問題 44 の逆変換を行う関数 expand_num_list を定義してください。
val expand_num_list = fn : (int * int) list -> int list
- expand_num_list([(1,3),(5,5),(7,10)]); val it = [1,2,3,5,7,8,9,10] : int list
●問題46
連続している同じ記号を (code, num) に変換する関数 encode を定義してください。code は記号、num は個数を表します。このような変換を「ランレングス符号化」といいます。
val encode = fn : ''a list -> (''a * int) list
- encode([9,8,8,7,7,7,6,6,6,6,1,1,1,1,1]); val it = [(9,1),(8,2),(7,3),(6,4),(1,5)] : (int * int) list
●問題47
問題 46 の逆変換を行う関数 decode を定義してください。
val decode = fn : ('a * int) list -> 'a list
- decode([(9,1),(8,2),(7,3),(6,4)]); val it = [9,8,8,7,7,7,6,6,6,6] : int list
●問題48
3 行 3 列の変形魔方陣を解くプログラムを作ってください。
上図の A から H の場所に 1 から 8 までの数字をひとつずつ配置します。四辺の合計が等しくなるように数字を配置してください。
●問題49
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。
覆面算 SEND + MORE = MONEY を解くプログラムを作ってください。
S E N D
+ M O R E
-------------
M O N E Y
図 : 覆面算
問題はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
●問題50
自然数 n 以下の素数をすべて求める関数 sieve を作ってください。
val sieve = fn : int -> int list
- sieve(100); val it = [2,3,5,7,11,13,17,19,23,29,31,37,...] : int list - print_intlist(sieve(100)); 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 val it = () : unit
●解答26
リスト : リストの生成
fun make_list(x, n) =
let
fun iter(0, a) = a
| iter(n, a) = iter(n - 1, x::a)
in
iter(n, [])
end
fun tabulate f n m =
let
fun iter m a =
if n > m then a else iter (m - 1) ((f m)::a)
in
iter m []
end
make_list と tabulate は局所関数 iter でリストを生成します。どちらの場合も累積変数 a を使用します。make_list は n 個の要素をリスト a に格納して返します。tabulate は m, m - 1, m - 2, ..., n + 1, n までの整数値に関数 fn を適用し、その結果をリスト a に格納して返します。
●解答27
リスト : リストの要素を削除する
fun remove(x, []) = []
| remove(x, y::ys) =
if x = y then remove(x, ys) else y :: remove(x, ys)
fun remove_if f [] = []
| remove_if f (x::xs) =
if f x then remove_if f xs else x :: (remove_if f xs)
remove と remove_if も簡単です。remove は引数 x と等しい要素を、remove_if は述語 pred が真となる要素をリストに追加しません。そのほかの要素をリストに追加します。
●解答28
リスト : リストの平坦化
fun flatten([]) = []
| flatten(x::xs) = x @ flatten(xs)
(* 別解 *)
fun flatten1(xs) =
let
fun iter([], a) = rev a
| iter(x::xs, a) = iter(xs, List.revAppend(x, a))
in
iter(xs, [])
end
flatten は簡単です。リストの先頭要素 x を取り出して、x と次の要素を @ で結合すればいいわけです。別解は演算子 @ を使わないで実装したものです。関数 revAppend は第 1 引数のリストを反転して第 2 引数のリストと連結します。動作は (rev x) @ a と同じですが、演算子 @ を使わないで簡単に実装することができます。リスト x を反転して累積変数 a に連結するので、リスト a には要素が逆順にセットされます。最後に rev で a を反転して返します。
ご参考までに関数 revAppend の実装例を示します。
リスト : リストを反転して連結する fun revAppend([], a) = a | revAppend(x::xs, a) = revAppend(xs, x::a)
●解答29
リスト : マッピングしてから平坦化する fun flatmap(_, []) = [] | flatmap(f, x::xs) = f(x) @ flatmap(f, xs) (* 別解 *) fun flatmap1(f, ls) = flatten(List.map f ls)
flatmap はリストの要素 x に関数 f を適用するだけで、あとは flatten と同じです。別解でも同じ動作になりますが、List.map で余分なリストを生成するので、少し効率が悪くなります。
●解答30
リスト : 順列の生成
fun permutation(0, _) = [[]]
| permutation(n, ls) =
flatmap(fn(x) => List.map (fn(y) => x::y) (permutation(n - 1, remove(x, ls))), ls)
関数 permutation は引数のリスト ls から n 個を選ぶ順列を生成し、それをリストに格納して返します。n = 0 が再帰の停止条件で、空リストを格納したリストを返します。このリストに対して要素を追加します。この処理は map を二重に使うと簡単に実現できます。このとき、flatten を使ってリストを平坦化します。これを関数 flatmap で行っています。
あとは匿名関数の中で permutation を再帰呼び出しをして、n - 1 個を選ぶ順列を生成します。そして、その返り値にリスト ls の要素 x を追加すれば、n 個を選ぶ順列を生成することができます。
●解答31
リスト : 重複順列
fun repeat_perm(0, _) = [[]]
| repeat_perm(n, xs) =
flatmap(fn(x) => List.map (fn(y) => x :: y) (repeat_perm(n - 1, xs)), xs)
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat_perm を再帰呼び出しするとき、リスト xs をそのまま渡すだけです。
●解答32
組み合わせの数を 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 の関係を表しています。あとは再帰定義を使って簡単にプログラムできます。
リスト : 組み合わせの数
fun comb_num(n : IntInf.int, r) =
if n = r orelse r = 0 then 1
else comb_num(n, r - 1) * (n - r + 1) div r
SML の場合、IntInf モジュールを使うと多倍長整数で計算することができます。
●解答33
組み合わせの生成は、次に示す組み合わせの公式と同じ考え方でプログラムすることができます。
nＣ0 = nＣn = 1 nＣr = n-1Ｃr-1 + n-1Ｃr
プログラムは次のようになります。
リスト : 組み合わせの生成
exception Combination
fun combination(0, _) = [[]]
| combination(_, []) = raise Combination
| combination(n, x0 as x::xs) =
if length(x0) = n then [x0]
else (List.map (fn(y) => x::y) (combination(n - 1, xs))) @ combination(n, xs)
最初の節は個数 n が 0 の場合です。選択する要素がないので空リストを格納したリストを返します。次の節で、選ぶ要素がなくなった場合はエラーを送出します。最後の節で、n と x0 の要素数が同じ場合は、その要素を全て選択するのでリスト [x0] を返します。
そうでなければ、先頭要素 x を選びます。残りのリスト xs から n - 1 個を選ぶ組み合わせを生成して、その先頭に x を追加します。あとは、xs から n 個を選ぶ組み合わせを combination で求めて、演算子 @ で連結するだけです。
●解答34
リスト : 重複組み合わせ
fun repeat_comb(0, _) = [[]]
| repeat_comb(_, []) = raise Combination
| repeat_comb(n, [y]) = [make_list(y, n)]
| repeat_comb(n, xs as y::ys) =
(List.map (fn(x) => y::x) (repeat_comb(n - 1, xs))) @ repeat_comb(n, ys)
重複組み合わせを求める repeat_comb も簡単です。3 番目の節で、リストに要素が一つしかない場合は、その要素 y を n 個選びます。make_list で y を n 個格納したリストを生成します。最後の節では、先頭要素 y を選んだあと、それを取り除かないで xs から n - 1 個の要素を選びます。
●解答35
リスト : n 番目の要素で分割する let split_nth ls nfun split_nth(ls, n) = (List.take(ls, n), List.drop(ls, n))
split_nth は take と drop を使うと簡単です。take で先頭から n 個の要素を取り出し、drop で先頭から n 個の要素を取り除くだけです。
●解答36
リスト : リストの分割
fun partition _ [] = ([], [])
| partition pred (x::xs) =
let
val (a, b) = partition pred xs
in
if pred(x) then (x::a, b) else (a, x::b)
end
(* 別解 *)
fun partition1 pred xs =
let
fun iter [] a b = (rev a, rev b)
| iter (x::xs) a b =
if pred(x) then iter xs (x::a) b
else iter xs a (x::b)
in
iter xs [] []
end
最初の節で、リストが空リストならば、空リストを 2 つ格納したタプルを返します。次の節で、partition を再帰呼び出しして、その返り値と (a, b) をマッチングさせます。そして、pred(x) が真ならば x を a に追加し、そうでなければ b に追加します。別解は末尾再帰でプログラムしたものです。
●解答37
リスト : zip fun zip(_, []) = [] | zip([], _) = [] | zip(x::xs, y::ys) = (x, y) :: zip(xs, ys)
zip はリストの要素 x, y を取り出してタプルにまとめ、それをリスト追加していくだけです。なお、SML/NJ の ListPair モジュールには同等の機能を持つ関数 zip が用意されています。
●解答38
リスト : any と every fun any _ [] = false | any pred (x::xs) = if pred(x) then true else any pred xs fun every _ [] = true | every pred (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 を返します。
なお、SML/NJ のモジュール List には同等の働きをする関数 exists と all があります。
●解答39
リスト : リストの置換
fun substitute(_, _, []) = []
| substitute(x, y, z::zs) =
if y = z then x :: substitute(x, y, zs)
else z :: substitute(x, y, zs)
fun substitute_if _ _ [] = []
| substitute_if pred x (y::ys) =
if pred(y) then x :: (substitute_if pred x ys)
else y :: (substitute_if pred x ys)
substitute はリストの要素 z が引数 y と等しい場合、その要素を引数 x に置き換えます。substitute_if は pred(y) が真を返す場合、その要素を引数 x に置き換えます。そうでなければ、要素 y をそのままリストに追加します。
●解答40
リスト : maplist fun maplist _ [] = [] | maplist f (l as _::xs) = (f l) :: (maplist f xs)
maplist は簡単です。関数 f に引数のリスト l をそのまま渡すだけです。maplist を再帰呼び出しするときは、先頭の要素を取り除いたリスト xs を渡します。maplist を使うと map は次のように定義することができます。
リスト : map の定義 fun my_map1 f ls = maplist (fn xs => f (hd xs)) ls
●解答41
リスト : リスト操作の一般化 fun for_each_list _ _ term [] = term | for_each_list f comb term (x::xs) = comb(f x, for_each_list f comb term xs)
関数 for_each_list の引数 f はリストの要素に適用する関数、comb は f の返り値と for_each_list の返り値を結合する関数、term はリストの終端で返す値です。プログラムは簡単で、引数のリストが空リストならば term を返します。そうでなければ、リストの要素 x に関数 f を適用し、その返り値と for_each_list の返り値を関数 comb で結合します。
●解答42
リスト : マッピング、フィルター、畳み込み
fun my_map f xs = for_each_list f (op ::) [] xs
fun my_filter f xs =
for_each_list (fn x => if f x then [x] else []) (op @) [] xs
fun my_foldr f a xs =
for_each_list (fn x => x) (fn(x, y) => f(x, y)) a xs
my_map は comb に (op ::) を、term に [ ] を渡せば実現できます。my_filter はリストの要素 x に関数 f を適用し、真を返す場合は [x] を返し、偽の場合は [ ] を返します。それを演算子 @ で連結すると、[ ] はリストの要素に含まれないので、フィルターとして動作します。my_foldr も簡単です。(fn x => x) でリストの要素をそのまま返し、要素を連結する関数の中で f を呼び出します。
●解答43
リスト : 連続した同じ記号を部分リストにまとめる
exception Empty_list
fun pack([]) = raise Empty_list
| pack(x::xs) =
let
fun iter([], a, b) = rev (a::b)
| iter(_, [], _) = raise Empty_list
| iter(x::xs, a as y::ys, b) =
if x = y then iter(xs, y::a, b)
else iter(xs, [x], a::b)
in
iter(xs, [x], [])
end
実際の処理は局所関数 iter で行います。引数 a と b は累積変数です。a は連続した記号を格納するリストで、そのリストを b に格納します。最初の節で、引数のリストが空リストの場合は a を b に格納し、そのリストを rev で反転して返します。次の節はエラーチェックです。a が空リストの場合はエラーを送出します。
最後の節で、リストを x と xs に、a を y と ys に分解します。x と y が等しい場合は同じ記号が続いているので y を a に追加します。そうでなければ、iter を再帰呼び出しして次の記号を調べます。このとき、a を b に追加して、x をリストに格納して引数 a に渡します。
●解答44
リスト : 連続している数列を (s, e) で表す
fun pack_num_list([]) = raise Empty_list
| pack_num_list(x::xs) =
let
fun iter([], a) = rev a
| iter(_, []) = raise Empty_list
| iter(x::xs, a as (s, e)::ys) =
if x = e + 1 then iter(xs, (s,x)::ys)
else iter(xs, (x,x)::a)
in
iter(xs, [(x,x)])
end
実際の処理は局所関数 iter で行います。引数 a を累積変数として使います。最初の節で ls が空リストの場合は a を反転して返します。次の節はエラーチェックで、a が空リストの場合はエラーを送出します。最後の節で、リストを x と xs に、a を (s, e) と ys に分解します。x = e + 1 ならば x は連続した数字です。リスト a の (s, e) を (s, x) に置き換えます。そうでなければ、x は連続していないので、リスト a に (x, x) を追加します。あとは iter を再帰呼び出しして次の数字を調べます。
連続していない数字 x をタプル (x, x) ではなく数字だけで表す場合は、次のようにデータ型を定義する必要があります。
リスト : 別解
datatype pack_num = Int of int | Pack of int * int
fun pack_num_list1([]) = raise Empty_list
| pack_num_list1(x::xs) =
let
fun push_num(s, e, a) =
if s = e then (Int s) :: a else (Pack (s, e)) :: a
fun iter([], s, e, a) = rev (push_num(s, e, a))
| iter(x::xs, s, e, a) =
if x = e + 1 then iter(xs, s, x, a)
else iter(xs, x, x, push_num(s, e, a))
in
iter(xs, x, x, [])
end
datatype pack_num = Int of int | Pack of int * int val pack_num_list1 = fn : int list -> pack_num list
pack_num はタプルと数値を表すデータ型です。pack_num_list1 は pack_num list を返します。実行例を示します。
- pack_num_list1([1,2,3,5,7,9,10]); val it = [Pack (1,3),Int 5,Int 7,Pack (9,10)] : pack_num list
●解答45
リスト : (s, e) を数列に戻す fun expand_num_list([]) = [] | expand_num_list((s, e)::xs) = iota(s, e) @ expand_num_list(xs) (* 別解 *) fun expand_num_list1([]) = [] | expand_num_list1((Int x)::xs) = x :: expand_num_list1(xs) | expand_num_list1((Pack (s, e))::xs) = iota(s, e) @ expand_num_list1(xs)
val expand_num_list1 = fn : pack_num list -> int list
expand_num_list は iota を使うと簡単です。最初の節が再帰の停止条件です。次の節で、(s, e) を iota で数列に変換します。expand_num_list を再帰呼び出しして残りのリスト xs を数列に戻し、その返り値に iota で変換したリストを演算子 @ で連結します。
別解の expand_num_list1 は pack_num list を int list に変換します。実行例を示します。
- expand_num_list1([Pack (1, 3), Int 5, Int 7, Pack (9, 10)]); val it = [1,2,3,5,7,9,10] : int list
●解答46
リスト : ランレングス符号化
fun drop_same_code(_, [], n) = (n, [])
| drop_same_code(x, ls as y::ys, n) =
if x <> y then (n, ls) else drop_same_code(x, ys, n + 1)
fun encode([]) = []
| encode(x::xs) =
let
val (n, ys) = drop_same_code(x, xs, 1)
in
(x, n) :: encode(ys)
end
リストの先頭から連続している記号を関数 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) を追加するだけです。
●解答47
リスト : ランレングス復号 fun decode([]) = [] | decode((x, n) :: xs) = make_list(x, n) @ decode(xs)
関数 decode は make_list を使うと簡単です。(x, n) を make_list でリストに展開して、その結果と decode xs の返り値を演算子 @ で連結するだけです。
●解答48
リスト : 魔方陣
(* 表示処理 *)
fun print_int(x) = print(Int.toString(x))
fun print_newline() = print("\n")
fun print_space() = print(" ")
(* int list の表示 *)
fun print_intlist(nil) = ()
| print_intlist(x::xs) = (print_int(x); print_space(); print_intlist(xs))
exception Magic_err
fun magic_solve () =
List.app
(fn (xs as a::b::c::d::e::f::g::h::[]) =>
let
val n1 = a + b + c
val n2 = a + d + f
val n3 = c + e + h
val n4 = f + g + h
in
if n1 = n2 andalso n2 = n3 andalso n3 = n4
then (print_intlist(xs); print_space(); print_int(n1); print_newline())
else ()
end
| (_) => raise Magic_err)
(permutation(8, iota(1, 8)))
単純な生成検定法です。実行結果は次のようになります。
- magic_solve (); 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 val it = () : 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
重複解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、順列を生成するとき、重複解のチェックを入れると枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。
●解答49
式 SEND + MORE = MONEY は足し算なので、M が 1 であることはすぐにわかります。ここでは、それ以外の数字を求めるプログラムを作ります。単純な生成検定法でプログラムを作ると、次のようになります。
リスト：覆面算
exception Puzzle_err
fun solve49() =
List.app
(fn (s::e::n::d::o_::r::y::[]) =>
let
val send = s * 1000 + e * 100 + n * 10 + d
val more = 1000 + o_ * 100 + r * 10 + e
val money = 10000 + o_ * 1000 + n * 100 + e * 10 + y
in
if send + more = money then (
print_int(send);
print(" + ");
print_int(more);
print(" = ");
print_int(money);
print_newline()
) else ()
end
| (_) => raise Puzzle_err)
(permutation(7,[0,2,3,4,5,6,7,8,9]))
1 を除いた 9 個の数字の中から 7 個の数字を選ぶ順列を permutation で生成し、匿名関数の中で式 SEND + MORE = MONEY を満たしているかチェックします。とても簡単なプログラムですね。さっそく実行してみましょう。
- solve49(); 9567 + 1085 = 10652 val it = () : unit
答えは 9567 + 1085 = 10652 の 1 通りしかありません。
●解答50
素数を求める基本的な考え方は簡単です。最初に、2 から n までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい) 」といいます。
プログラムは次のようになります。
リスト : 素数 (エラトステネスの篩)
fun sieve(n) =
let
fun iter([], a) = rev a
| iter(x::xs, a) = iter(remove_if (fn(y) => y mod x = 0) xs, x::a)
in
iter(iota(2, n), [])
end
実際の処理は局所関数 iter で行います。引数 a は素数を格納するリストです。iota で 2 から n までの整数列を生成し、それを iter に渡します。iter はリストの先頭要素 x で割り切れる要素を remove_if で取り除き、iter を再帰呼び出しします。このとき、累積変数 a に素数 x を追加します。ls が空リストになった場合、累積変数には素数が逆順にセットされているので、rev で反転して返します。
●別解 (2012/10/08)
関数 sieve には無駄な処理があります。リストの先頭要素 x が √n よりも大きい場合、リストには素数しか残っていません。つまり、ふるいにかけるのは x <= √n まででいいのです。これをプログラムすると次のようになります。
リスト : 別解
fun sieve1(n) =
let
fun iter([], a) = List.rev a
| iter(ls as x::xs, a) =
if x * x > n then List.revAppend(a, ls)
else iter(remove_if (fn(y) => y mod x = 0) xs, x::a)
in
iter(iota(2, n), [])
end
局所関数 iter で、リストの先頭要素 x が x * x > n ならば、累積変数 a とリスト ls を revAppend で連結して返します。これで sieve よりも速く素数を求めることができます。
ところで、「エラトステネスの篩」は配列を使ってプログラムしたほうが高速になります。次のリストを見てください。
リスト : 配列版
fun sieve2(n) =
let
val p = Array.array(n div 2 + 1, true)
fun iter0(i, j) =
if j < n div 2 + 1 then (
Array.update(p, j, false);
iter0(i, j + i)
) else ()
fun iter1(i, j, a) =
if i > n then rev a
else iter1(i + 2, j + 1, if Array.sub(p, j) then i::a else a)
fun iter2(i, j, a) =
if i * i > n then iter1(i, j, a)
else if Array.sub(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])
end
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 を呼び出します。