M.Hiroi's Home Page

Functional Programming

Yet Another SML/NJ Problems

[ PrevPage | SML/NJ | NextPage ]

●問題111

2 つのリスト xs, ys を受け取って動作するマップ関数 map2 f xs ys と畳み込みを行う関数 foldl2 f a xs ys, foldr2 f a xs ys を定義してください。引数のリストの長さが異なる場合は、短いリストの長さに合わせてください。なお、SML/NJ のモジュール ListPair には同様の動作を行う関数 map, foldl, foldr が用意されています。

val map2 = fn : ('a * 'b -> 'c) -> 'a list -> 'b list -> 'c list
val foldl2 = fn : ('a * 'b * 'c -> 'c) -> 'c -> 'a list -> 'b list -> 'c
val foldr2 = fn : ('a * 'b * 'c -> 'c) -> 'c -> 'a list -> 'b list -> 'c
- map2 (op +) [1,2,3,4] [10,100,1000,10000];
val it = [11,102,1003,10004] : int list
- map2 (op * ) [1,2,3] [10,100,1000,10000];
val it = [10,200,3000] : int list

- foldl2 (fn(x,y,a) => (x, y) :: a) [] [1,2,3,4] [10,11,12,13];
val it = [(4,13),(3,12),(2,11),(1,10)] : (int * int) list
- foldl2 (fn(x,y,a) => x * y + a) 0 [1,2,3,4] [10,11,12,13];
val it = 120 : int

- foldr2 (fn(x,y,a) => (x, y) :: a) [] [1,2,3,4] [10,11,12,13];
val it = [(1,10),(2,11),(3,12),(4,13)] : (int * int) list
- foldr2 (fn(x,y,a) => x * y + a) 0 [1,2,3,4] [10,11,12,13];
val it = 120 : int

解答

●問題112

関数 zip でまとめたリストを元に戻す関数 unzip xs を定義してください。

val unzip = fn : ('a * 'b) list -> 'a list * 'b list
- zip([1,2,3,4,5],[6,7,8,9,10]);
val it = [(1,6),(2,7),(3,8),(4,9),(5,10)] : (int * int) list
- unzip [(1,6),(2,7),(3,8),(4,9),(5,10)];
val it = ([1,2,3,4,5],[6,7,8,9,10]) : int list * int list

解答

●問題113

3 つのリスト xs, ys, zs の要素 x, y, z を取り出し、タプル (x, y, z) にまとめてリストに格納して返す関数 zip3(xs, ys, zs) を定義してください。リストは短いほうに合わせるものとします。

val zip3 = fn : 'a list * 'b list * 'c list -> ('a * 'b * 'c) list
- zip3([1,2,3],[4,5,6],[7,8,9]);
val it = [(1,4,7),(2,5,8),(3,6,9)] : (int * int * int) list
- zip3([1,2,3],[4,5,6],[7,8]);
val it = [(1,4,7),(2,5,8)] : (int * int * int) list

解答

●問題114

zip3 したリストを元に戻す関数 unzip3 xs を定義してください。

val unzip3 = fn : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list
- unzip3 [(1,2,3),(4,5,6),(7,8,9)];
val it = ([1,4,7],[2,5,8],[3,6,9]) : int list * int list * int list

解答

●問題115

関数 takeWhile pred xs は述語 pred を満たす要素が続いている間、リスト xs の先頭から順番に要素を取り出します。関数 takeWhile を定義してください。

val takeWhile = fn : ('a -> bool) -> 'a list -> 'a list
- fun even x = x mod 2 = 0;
val even = fn : int -> bool
- fun odd x = x mod 2 = 1;
val odd = fn : int -> bool
- takeWhile even [2,4,6,8,1,2,3,4,5];
val it = [2,4,6,8] : int list
- takeWhile odd [2,4,6,8,1,2,3,4,5];
val it = [] : int list

解答

●問題116

関数 dropWhile pred xs は述語 pred を満たす要素が続いている間、リスト xs の先頭から順番に要素を取り除きます。関数 dropWhile を定義してください。

val dropWhile = fn : ('a -> bool) -> 'a list -> 'a list
- dropWhile even [2,4,6,8,1,2,3,4,5];
val it = [1,2,3,4,5] : int list
- dropWhile odd [2,4,6,8,1,2,3,4,5];
val it = [2,4,6,8,1,2,3,4,5] : int list

解答

●問題117

関数 span pred xs はタプル (takeWhile pred xs, dropWhile pred xs) を返します。takeWhile と dropWhile を使わないで関数 span を定義してください。

val span = fn : ('a -> bool) -> 'a list -> 'a list * 'a list
- span even [2,4,6,8,1,2,3,4,5];
val it = ([2,4,6,8],[1,2,3,4,5]) : int list * int list
- span odd [2,4,6,8,1,2,3,4,5];
val it = ([],[2,4,6,8,1,2,3,4,5]) : int list * int list

解答

●問題118

関数 break pred xs は span とは逆の動作、つまり span (not o pred) xs と同じ動作をします。takeWhile, dropWhile, span を使わないで関数 break を定義してください。

val break = fn : ('a -> bool) -> 'a list -> 'a list * 'a list
- break even [2,4,6,8,1,2,3,4,5];
val it = ([],[2,4,6,8,1,2,3,4,5]) : int list * int list
- break odd [2,4,6,8,1,2,3,4,5];
val it = ([2,4,6,8],[1,2,3,4,5]) : int list * int list

解答

●問題119

関数 scanl f a xs は畳み込みを行う関数 fold f a xs と同じ動作をしますが、計算途中の累積値をリストに格納して返すところが異なります。関数 scanl を定義してください。

val scanl = fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b list
- scanl (op +) 0 [1,2,3,4,5];
val it = [0,1,3,6,10,15] : int list
- scanl (op ::) [] [1,2,3,4,5];
val it = [[],[1],[2,1],[3,2,1],[4,3,2,1],[5,4,3,2,1]] : int list list

解答

●問題120

関数 scanr f a xs は畳み込みを行う関数 fold-right f a xs と同じ動作をしますが、計算途中の累積値をリストに格納して返すところが異なります。関数 scanr を定義してください。

val scanr = fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b list
- scanr (op +) 0 [1,2,3,4,5];
val it = [15,14,12,9,5,0] : int list
- scanr (op ::) [] [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

解答

●問題121

関数 mapAaccumL f a xs は map と foldl を合わせた関数で、畳み込みを行った結果と各要素に関数 f を適用した結果を格納したリストをタプルで返します。関数 f は累積値とリストの要素を受け取り、新しい累積値とリストに格納する値をタプルで返します。関数 mapAccumL を定義してください。

val mapAccumL = fn : ('a * 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
- mapAccumL (fn(a, x) => (x * 2 + a, x * 2)) 0 [1,2,3,4,5];
val it = (30,[2,4,6,8,10]) : int * int list
- mapAccumL (fn(a, x) => (x * 2 :: a, x * 2)) [] [1,2,3,4,5];
val it = ([10,8,6,4,2],[2,4,6,8,10]) : int list * int list

解答

●問題122

関数 mapAccumR f a xs は map と foldr を合わせた関数で、畳み込みを行った結果と各要素に関数 f を適用した結果を格納したリストをタプルで返します。関数 f は累積値とリストの要素を受け取り、新しい累積値とリストに格納する値をタプルで返します。関数 mapAccumR を定義してください。

val mapAccumR = fn : ('a * 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
- mapAccumR (fn(a, x) => (x * 2 + a, x * 2)) 0 [1,2,3,4,5];
val it = (30,[2,4,6,8,10]) : int * int list
- mapAccumR (fn(a, x) => (x * 2 :: a, x * 2)) [] [1,2,3,4,5];
val it = ([2,4,6,8,10],[2,4,6,8,10]) : int list * int list

解答

●問題123

リスト xs の要素の間に x を挿入する関数 intersperse(x, xs) を定義してください。

val intersperse = fn : 'a * 'a list -> 'a list
- intersperse(0, [1,2,3,4,5]);
val it = [1,0,2,0,3,0,4,0,5] : int list
- intersperse([0,0], [[1,2],[3,4],[5,6]]);
val it = [[1,2],[0,0],[3,4],[0,0],[5,6]] : int list list

解答

●問題124

リスト ys の要素の間にリスト xs を挿入して平坦化する関数 intercalate(xs, ys) を定義してください。この場合、ys の要素はリストでなければなりません。

val intercalate = fn : 'a list * 'a list list -> 'a list
- intercalate([0,0], [[1,2],[3,4],[5,6]]);
val it = [1,2,0,0,3,4,0,0,5,6] : int list
- intercalate([0,0], [[1,2]]);
val it = [1,2] : int list
- intercalate([0,0], []);
val it = [] : int list

解答

●問題125

畳み込みを行う関数 foldl, foldr はリストの要素に関数が適用されますが、リストそのものを関数に渡して畳み込みを行う方法も考えられます。リストの先頭から畳み込みを行う関数 pair_foldl と、末尾から畳み込みを行う関数 pair_foldr を定義してください。

val pair_foldl = fn : ('a list * 'b -> 'b) -> 'b -> 'a list -> 'b
val pair_foldr = fn : ('a list * 'b -> 'b) -> 'b -> 'a list -> 'b
- pair_foldl (fn(x, a) => x :: a) [] [1,2,3,4,5];
val it = [[5],[4,5],[3,4,5],[2,3,4,5],[1,2,3,4,5]] : int list list
- pair_foldr (fn(x, a) => x :: a) [] [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

- fun sum xs = foldl (op +) 0 xs;
val sum = fn : int list -> int
- pair_foldl (fn(x, a) => sum x :: a) [] [1,2,3,4,5];
val it = [5,9,12,14,15] : int list
- pair_foldr (fn(x, a) => sum x :: a) [] [1,2,3,4,5];
val it = [15,14,12,9,5] : int list

解答

●問題126

リスト xs の接頭辞をすべて求める関数 inits xs を定義してください。

val inits = fn : 'a list -> 'a list list
- inits [1,2,3,4,5];
val it = [[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5]] : int list list

解答

●問題127

リスト xs の接尾辞をすべて求める関数 tails xs を定義してください。

val tails = fn : 'a list -> 'a list list
- tails [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

解答

●問題128

リスト xs の中で等しい要素を集めてグループに分ける関数 group_collection xs を定義してください。なお、等値関係は述語 = でチェックするものとします。

val group_collection = fn : ''a list -> ''a list list
- group_collection [1,2,1,3,2,1,4,3,2,1,1,2,3,4,5];
val it = [[1,1,1,1,1],[2,2,2,2],[3,3,3],[4,4],[5]] : int list list
- group_collection [1,2,3,4,5];
val it = [[1],[2],[3],[4],[5]] : int list list

解答

●問題129

リスト xs に x を挿入するパターンをすべて求めてリストに格納して返す関数 interleave x xs を定義してください。

val interleave = fn : 'a -> 'a list -> 'a list list
- interleave 0 [1,2,3,4,5];
val it =
  [[0,1,2,3,4,5],[1,0,2,3,4,5],[1,2,0,3,4,5],[1,2,3,0,4,5],[1,2,3,4,0,5],
   [1,2,3,4,5,0]] : int list list
- interleave 0 [1];
val it = [[0,1],[1,0]] : int list list
- interleave 0 [];
val it = [[0]] : int list list

解答

●問題130

関数 interleave を使ってリスト xs の順列を求める関数 permutations を定義してください。なお、順列はリストに格納して返すものとします。

val permutations = fn : 'a list -> 'a list list
- permutations [1,2,3];
val it = [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]] : int list list
- permutations [#"a",#"b",#"c"];
val it =
  [[#"a",#"b",#"c"],[#"b",#"a",#"c"],[#"b",#"c",#"a"],[#"a",#"c",#"b"],
   [#"c",#"a",#"b"],[#"c",#"b",#"a"]] : char list list

解答


●解答111

リスト : マッピングと畳み込み

fun map2 _ [] _ = []
|   map2 _ _ [] = []
|   map2 f (x::xs) (y::ys) = f(x, y) :: map2 f xs ys

fun foldl2 _ a [] _ = a
|   foldl2 _ a _ [] = a
|   foldl2 f a (x::xs) (y::ys) = foldl2 f (f(x, y, a)) xs ys

fun foldr2 _ a [] _ = a
|   foldr2 _ a _ [] = a
|   foldr2 f a (x::xs) (y::ys) = f(x, y, foldr2 f a xs ys)

(* 別解 *)
fun zip([], _) = []
|   zip(_, []) = []
|   zip(x::xs, y::ys) = (x, y) :: zip(xs, ys)

fun map2a f xs ys = map f (zip(xs, ys))

fun foldl2a f a xs ys = foldl (fn((x,y),z) => f(x,y,z)) a (zip(xs, ys))

fun foldr2a f a xs ys = foldr (fn((x,y),z) => f(x,y,z)) a (zip(xs, ys))

マッピングと畳み込みは再帰呼び出しを使うと簡単です。どの関数も、xs または ys が空リストになったときが再帰の停止条件となります。別解は zip と map, foldl, foldr を組み合わせたものです。

●解答112

リスト : ひとつのリストを 2 つのリストに分ける

fun unzip([]) = ([], [])
|   unzip((x, y)::xs) =
    let
      val (a, b) = unzip(xs)
    in
      (x::a, y::b)
    end

unzip は再帰呼び出しでプログラムすると簡単です。引数が空リストの場合、2 つの空リストをタプルに格納して返します。そうでなければ、unzip を再帰呼び出しして、返り値 (タプル) を受け取ります。そして、受け取ったリストに要素を追加して、それをタプルに格納して返すだけです。

●解答113

リスト : 3 つのリストをひとつにまとめる

fun zip3([], _, _) = []
|   zip3(_, [], _) = []
|   zip3(_, _, []) = []
|   zip3(x::xs, y::ys, z::zs) = (x, y, z) :: zip3(xs, ys, zs)

zip3 も再帰呼び出しで簡単にプログラムできます。引数の中でどれかひとつが空リストであれば空リストを返します。あとは、zip3 を再帰呼び出しして、その返り値に各リストの先頭要素を格納したタプルを追加するだけです。

●解答114

リスト : ひとつのリストを 3 つのリストに分ける

fun unzip3([]) = ([], [], [])
|   unzip3((x,y,z)::xs) =
    let
      val (a, b, c) = unzip3(xs)
    in
      (x::a, y::b, z::c)
    end

unzip3 も簡単です。引数が空リストの場合、3 つの空リストを格納したタプルを返します。そうでなければ unzip3 を再帰呼び出しして、返り値と変数 (a, b, c) をパターンマッチします。あとは、タプルの要素 x, y, z をリスト a, b, c に追加し、それをタプルに格納して返せばいいわけです。

●解答115

リスト : pred が真の要素を取り出す

fun takeWhile _ [] = []
|   takeWhile p (x::xs) =
    if p x then x :: takeWhile p xs else []

takeWhile は xs が空リストまたは述語 pred が偽を返すとき空リストを返します。そうでなければ、takeWhile を再帰呼び出しして、その返り値にリストの要素を追加します。

●解答116

リスト : pred が真の要素を取り除く

fun dropWhile _ [] = []
|   dropWhile p (a as(x::xs)) =
    if p x then dropWhile p xs else a

dropWhile は簡単です。引数が空リストまたは述語 pred が偽を返すとき、空リストまたはリスト a を返します。そうでなければ、dropWhile を再帰呼び出しするだけです。

●解答117

リスト : pred が偽を返すところでリストを分ける

fun span _ [] = ([], [])
|   span p (y as (x::xs)) =
    if p x then
      let
        val (a, b) = span p xs
      in
        (x::a, b)
      end
    else ([], y)

span は再帰呼び出しでプログラムすると簡単です。引数が空リストまたは述語 pred が偽を返すときが再帰の停止条件です。そうでなければ、span を再帰呼び出しして返り値を変数 (a, b) にセットします。そして、リストの先頭要素 x を a に追加して、b といっしょにタプルに格納して返します。

●解答118

リスト : pred が真を返すところでリストを分ける

fun break _ [] = ([], [])
|   break p (y as (x::xs)) =
    if p x then ([], y)
    else
      let
        val (a, b) = break p xs
      in
        (x::a, b)
      end

break も再帰呼び出しでプログラムすると簡単です。引数が空リストまたは述語 pred が真を返すときが再帰の停止条件です。そうでなければ、break を再帰呼び出しして返り値を変数 (a, b) で受け取ります。そして、リストの先頭要素 x を a に追加して、b といっしょにタプルに格納して返します。

●解答119

リスト : 累積値リストの生成

fun scanl _ a [] = [a]
|   scanl f a (x::xs) = a :: scanl f (f(x, a)) xs

(* 別解 *)
fun scanl1 f a xs =
    rev (foldl (fn(x, a) => f(x, hd a) :: a) [a] xs)

scanl はリストの最後の要素が最終の累積値になります。引数のリストが空リストのとき、累積変数 a の値をリストに格納して返します。そうでなければ、scanl を再帰呼び出しして、その返り値に累積変数 a の値を追加して返します。scanl を再帰呼び出しするときは、関数 f を呼び出して累積変数の値を更新することに注意してください。別解は fold を使ったバージョンです。返り値のリストは逆順になるので、関数 rev で反転しています。

●解答120

リスト : 累積値リストの生成

fun scanr _ a [] = [a]
|   scanr f a (x::xs) =
    let
      val ys as (y::_) = scanr f a xs
    in
      f(x, y) :: ys
    end

(* 別解 *)
fun scanr1 f a xs = foldr (fn(x, a) => f(x, hd a) :: a) [a] xs

scanr はリストの先頭の要素が最終の累積値、最後の要素が初期値になります。引数のリストが空リストの場合は [a] を返します。そうでなければ、scanr を再帰呼び出しします。このとき、累積変数 a の値は更新しません。返り値のリストは変数 ys にセットします。この ys の先頭要素が一つ前の累積値になるので、この値 y とリストの先頭要素 x を関数 f に渡して評価します。あとは、f の返り値を ys の先頭に追加して返せばいいわけです。別解は foldr を使ったバージョンです。

●解答121

リスト : マッピングと畳み込み

fun mapAccumL _ acc [] = (acc, [])
|   mapAccumL f acc (x::xs) =
    let
      val (a, y) = f(acc, x)
      val (b, ys) = mapAccumL f a xs
    in
      (b, y::ys)
    end

mapAccumL は foldl と map を組み合わせたものです。累積値はリストの先頭から計算し、マッピングの結果は末尾から組み立てていきます。引数 acc は初期値とともに計算途中の累積値を表します。引数のリストが空リストの場合、acc と空リストをタプルで返します。そうでなければ、関数 f に累積値 acc と要素 x を渡して評価し、新しい累積値とマッピングの値を変数 a と y にセットします。

それから、mapAccumL を再帰呼び出しします。このとき、累積値は a になることに注意してください。返り値は畳み込みの値 b とマッピングの結果を格納したリスト ys です。あとは、ys に y を追加して b と一緒にタプルで返すだけです。

●解答122

リスト : マッピングと畳み込み

fun mapAccumR _ acc [] = (acc, [])
|   mapAccumR f acc (x::xs) =
    let
      val (a, ys) = mapAccumR f acc xs
      val (b, y)  = f(a, x)
    in
      (b, y::ys)
    end

mapAccumR の場合、累積値はリストの末尾から計算し、マッピングの結果も末尾から組み立てていきます。引数のリストが空リストの場合、初期値 acc と空リストをタプルで返します。そうでなければ mapAccumR を再帰呼び出しします。初期値 acc をそのまま渡すことに注意してください。累積値が変数 a に、マッピングの値を格納したリストが変数 ys にセットされます。

次に関数 f を呼び出します。このとき、累積値 a とリストの要素 x を渡します。結果は、新しい累積値が b に、マッピングの値が y にセットされます。あとは、y を ys に追加して累積値 b と一緒にタプルで返すだけです。

●解答123

リスト : 要素の間にデータを挿入する

fun intersperse(_, []) = []
|   intersperse(_, [x]) = [x]
|   intersperse(x, y::ys) = y :: x :: intersperse(x, ys)

(* 別解 *)
fun intersperse1(_, []) = []
|   intersperse1(x, y::ys) =
    y :: foldr (fn(z, a) => x :: z :: a) [] ys

intersperse は再帰呼び出しで簡単にプログラムできます。引数のリストが空リストまたは要素がひとつしかない場合、データを挿入できないのでリストをそのまま返します。そうでなければ、先頭の要素と次の要素の間に x を挿入します。 y :: x :: のあとに残りのリスト ys に対して intersperse を再帰呼び出しすればいいわけです。別解は畳み込み foldr を使ったバージョンです。

●解答124

リスト : リストの要素の間にデータを挿入して平坦化する

(* リストの平坦化 *)
fun flatten [] = []
|   flatten (x::xs) = x @ flatten xs

fun intercalate(xs, ys) = flatten (intersperse(xs, ys))

(* 別解 *)
fun intercalate1(_, []) = []
|   intercalate1(x, y::ys) =
    y @ foldr (fn(z, a) => x @ z @ a) [] ys

intercalate は intersperse を呼び出して xs を ys の要素の間に挿入し、その結果を関数 flatten で平坦化するだけです。別解は intersperses を使わずに foldr でプログラムしたものです。intersperses と違って、演算子 @ でリストを連結していることに注意してください。これでリストを平坦化することができます。

●解答125

リスト : 畳み込み

fun pair_foldl _ a [] = a
|   pair_foldl f a xs = pair_foldl f (f(xs, a)) (tl xs)

fun pair_foldr _ a [] = a
|   pair_foldr f a xs = f(xs, pair_foldr f a (tl xs))

pair_foldl と pair_foldr は簡単です。関数 f を呼び出すときリストの要素の代わりにリスト xs をそのまま渡すだけです。あとは普通の畳み込み foldl, foldr と同じです。

●解答126

リスト : 接頭辞を求める

fun inits xs = scanl (fn(x, a) => a @ [x]) [] xs

(* 別解 *)
fun inits1 xs = foldl (fn(x, a) => ((hd a) @ [x]) :: a) [[]] xs

inits は scanl を使うと簡単です。累積値 a の末尾に x を追加していくだけです。別解は foldl を使ったバージョンです。

●解答127

リスト : 接尾辞を求める

fun tails xs = scanr (op ::) [] xs

(* 別解 *)
fun tails1 xs = pair_foldr (op ::) [[]] xs

inits は scanr を使うと簡単です。累積値の先頭に xs の要素を追加するだけです。別解のように pair_foldr を使っても簡単にプログラムできます。

●解答128

リスト : 等値 (eqv?) でグループに分ける

fun group_insert(x, []) = [[x]]
|   group_insert(x, y::ys) =
    if x = (hd y) then (x::y)::ys else y :: group_insert(x, ys)

fun group_collection xs = foldl group_insert [] xs

group_collection は x をグループに挿入する関数 group_insert(x, ys) を定義すると簡単です。group_insert の引数 ys はグループ (リスト) を格納したリストです。ys が空リストの場合、x と等しい値を持つグループはなかったので新しいグループを生成して返します。グループの先頭要素 (hd y) と x が等しい場合、そのグループに x を追加して返します。そうでなければ、group_insert を再帰呼び出しして次のグループをチェックします。

group_collection は引数 xs の要素を順番に取り出し、group_insert で該当するグループに挿入していくだけです。この処理は foldl を使うと簡単にできます。

●解答129

リスト : データをひとつ挿入するパターンをすべて求める

fun interleave x [] = [[x]]
|   interleave x (xs as (y::ys)) =
    [x::xs] @ map (fn(zs) => y :: zs) (interleave x ys)

(* 別解 *)
fun interleave1 x xs =
    let
      fun iter([], ys, a) = revAppend(ys, [x]) :: a
      |   iter(zs as x1::xs1, ys, a) =
          iter(xs1, x1::ys, revAppend(ys, x::zs) :: a)
    in
      iter(xs, [], [])
    end

interleave はリストの先頭に x を挿入する場合と、それ以外の場合に分けて考えます。先頭に追加するのは簡単ですね。それ以外の場合は、先頭要素を取り除いたリスト ys に x を挿入すればいいので、interleave を再帰呼び出しすることで求めることができます。そして、その返り値のリストに先頭要素 y を追加すればいいわけです。

プログラムは簡単です。引数のリストが空リストの場合は [[x]] を返します。そうでなければ、xs の先頭に x を追加したものと、interleave x ys の返り値に y を追加したものを演算子 @ で連結して返します。

別解はリストの先頭から順番に x の挿入位置を変えていきます。x よりも前にある要素を変数 ys に格納しておくと、x を挿入したリストは、ys @ [x] @ zs で求めることができます。interleave1 の場合、ys は逆順になるので、リストの連結処理を関数 revAppend で行っています。

●解答130

リスト : 順列の生成

fun flatmap _ [] = []
|   flatmap f (x::xs) = f x @ flatmap f xs

fun permutations [] = [[]]
|   permutations (x::xs) =
    flatmap (interleave x) (permutations xs)

permutations は簡単です。permutations を再帰呼び出しして xs の順列を求め、順列を表す要素に interleave で x を挿入すればいいわけです。リストを平坦化するため flatmap を使っていることに注意してください。


Copyright (C) 2012 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]