M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

継続渡しスタイル

今回は「継続渡しスタイル (Continuation Passing Style : CPS)」という手法について説明します。Scheme には「継続」という他の言語 [*1] にはない強力な機能がありますが、使いこなすのはちょっと難しいといわれています。継続渡しスタイルはクロージャを使った汎用的な方法で、クロージャがあるプログラミング言語であれば、継続渡しスタイルでプログラムを作成することができます。

-- note --------
[*1] 実は Ruby にも「継続」があります。また、標準的な機能ではありませんが、SML/NJ や OCaml でも拡張機能を使って「継続」を取り扱うことができます。

●継続とは?

最初に継続について簡単に説明します。継続は「次に行われる計算」のことです。たとえば、次のプログラムを例に考えてみましょう。

リスト : 逐次実行

fun foo () = print "foo\n"
fun bar () = print "bar\n"
fun baz () = print "baz\n"

fun test () = (foo(); bar(); baz())
- test();
foo
bar
baz
val it = () : unit

関数 test は関数 foo, bar, baz を順番に呼び出します。foo の次に実行される処理は bar, baz の関数呼び出しです。この処理が foo を呼び出したあとの「継続」になります。同様に、bar のあとに実行されるのは baz の呼び出しで、この処理がこの時点での「継続」になります。また、baz を呼び出したあと、test の中では次に実行する処理はありませんが、test は関数呼び出しされているので、関数呼び出しから元に戻る処理が baz を呼び出したあとの「継続」になります。

このように、あるプログラムを実行しているとき、そのプログラムを終了するまでには「次に実行する処理 (計算)」が必ず存在します。一般に、この処理 (計算) のことを「継続」といいます。Scheme の場合、次の計算を続行するための情報を取り出して、それを保存することができます。

Scheme では、この保存した情報を「継続」といって、通常のデータ型と同様に取り扱うことができます。つまり、継続を変数に代入したり関数の引数に渡すことができるのです。継続を使うとプログラムの実行を途中で中断し、あとからそこに戻ってプログラムの実行を再開することができます。

●継続渡しスタイルとは?

一般のプログラミング言語では、Scheme のように継続を取り出して保存することはできません。そこで、継続 (次に行う処理) を関数 (クロージャ) で表して、それを引数に渡して実行することにします。これを「継続渡しスタイル (CPS)」といいます。たとえば、次の例を見てください。

リスト : 継続渡しスタイル

fun test_cps(cont) = (foo(); bar(); cont())
val test_cps = fn : (unit -> 'a) -> 'a
- test_cps(baz);
foo
bar
baz
val it = () : unit

関数 test_cps は foo, bar を呼び出したあと、引数 cont に渡された処理 (継続) を実行します。関数 baz を渡せば foo, bar, baz と表示されますし、他の処理を渡せばそれを実行することができます。

もう一つ簡単な例を示しましょう。継続に値を渡して処理を行うこともできます。

- fun add_cps(a, b, cont) = cont(a + b);
val add_cps = fn : int * int * (int -> 'a) -> 'a
- add_cps(1, 2, fn x => x);
val it = 3 : int
- add_cps(1, 2, fn x => print(Int.toString(x) ^ "\n"));
3
val it = () : unit

関数 add_cps は引数 a と b を加算して、その結果を継続 cont に渡します。cont に fn x => x を渡せば、計算結果を返すことができます。また、cont で print を呼び出せば、計算結果を表示することができます。

●再帰呼び出しと継続渡しスタイル

CPS を使うと再帰呼び出しを末尾再帰に変換することができます。たとえば、階乗の計算を CPS でプログラムすると次のようになります。

リスト : 階乗の計算 (CPS)

let rec fact_cps n cont =
  if n = 0 then cont 1
  else fact_cps (n - 1) (fun x -> cont (n * x))

引数 cont が継続を表します。n = 0 のときは、cont に階乗の値 1 を渡します。それ以外の場合は、階乗の計算を継続の処理にまかせて fact_cps を再帰呼び出します。ここで、fact_cps の呼び出しは末尾再帰になることに注意してください。

継続の処理 fn x => cont(n * x) では、継続の引数 x と fact_cps の引数 n を掛け算して、その結果を cont に渡します。たとえば、fact_cps(4, fn x => x) の呼び出しを図に示すと、次のようになります。

   fact 4 (fn x => x)
=>      4 (fn x1 => (fn x => x) (4 * x1))
=>      3 (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2))
=>      2 (fn x3 => (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2)) (2 * x3))
=>      1 (fn x4 => (fn x3 => (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2))
                     (2 * x3)) (1 * x4))
=>      0 (fn x4 => (fn x3 => (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2))
                     (2 * x3)) (1 * x4)) 1

継続の評価

   (fn x4 => (fn x3 => (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2))
              (2 * x3)) (1 * x4)) 1
=> (fn x3 => (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2)) (2 * x3)) 1
=> (fn x2 => (fn x1 => (fn x => x) (4 * x1)) (3 * x2)) 2
=> (fn x1 => (fn x => x) (4 * x1)) 6
=> (fn x => x) 24
=> 24

                    図 : fact_cps の実行

このように、継続の中で階乗の式が組み立てられていきます。そして、n = 0 のとき継続 cont に引数 1 を渡して評価すると、今までに組み立てられた式が評価されて階乗の値を求めることができます。つまり、n の階乗を求めるとき、継続 fn x => cont (n * x) の引数 x には n - 1 の階乗の値が渡されていくわけです。そして、最後に継続 fn x => x に n の階乗の値が渡されるので、階乗の値を返すことができます。

それでは実際に実行してみましょう。

val fact_cps = fn : int * (int -> 'a) -> 'a
- fact_cps(1, fn x => x);
val it = 1 : int
- fact_cps(5, fn x => x);
val it = 120 : int
- fact_cps(10, fn x => x);
val it = 3628800 : int
- fact_cps(11, fn x => x);
val it = 39916800 : int
- fact_cps(12, fn x => x);
val it = 479001600 : int

●二重再帰と継続渡しスタイル

次はフィボナッチ数列を求める関数を CPS で作りましょう。次のリストを見てください。

リスト : フィボナッチ関数

(* 二重再帰 *)
fun fibo(n) =
    if n = 0 orelse n = 1 then 1
    else fibo(n - 1) + fibo(n - 2)

(* CPS *)
fun fibo_cps(n, cont) =
    if n = 0 orelse n = 1 then cont(1)
    else fibo_cps(n - 1, fn x => fibo_cps(n - 2, fn y => cont(x + y)))
val fibo = fn : int -> int
val fibo_cps = fn : int * (int -> 'a) -> 'a

関数 fibo_cps は、引数 n が 0 または 1 のとき cont 1 を評価します。それ以外の場合は fibo_cps を再帰呼び出しします。fibo_cps (n - 1) が求まると、その値は継続の引数 x に渡されます。継続の中で、今度は fibo_cps (n - 2) の値を求めます。すると、その値は fibo_cps (n - 2) の継続の引数 y に渡されます。したがって、fibo_cps n の値は x + y で求めることができます。この値を fibo_cps n の継続 cont に渡せばいいわけです。

fibo_cps の実行を図に示すと、次のようになります。

cont は継続を表します。fibo_cps は末尾再帰になっているので、n - 1 の値を求めるために左から右へ処理が進みます。このとき、n - 2 の値を求める継続 cont が生成されていくことに注意してください。そして、f(1) の実行が終了すると継続が評価され、n - 2 の値が求められます。すると、2 番目の継続が評価されて n - 1 の値 x と n - 2 の値 y を加算して、その値を継続 cont に渡します。こうして、次々と継続が評価されてフィボナッチ関数の値を求めることができます。

それでは実際に実行してみましょう。

- fibo_cps(1, fn x => x);
val it = 1 : int
- fibo_cps(2, fn x => x);
val it = 2 : int
- fibo_cps(3, fn x => x);
val it = 3 : int
- fibo_cps(4, fn x => x);
val it = 5 : int
- fibo_cps(5, fn x => x);
val it = 8 : int
- fibo_cps(6, fn x => x);
val it = 13 : int
- fibo_cps(7, fn x => x);
val it = 21 : int
- fibo_cps(8, fn x => x);
val it = 34 : int

正常に動作していますね。

ところで、fibo_cps は末尾再帰になっていますが、関数の呼び出し回数は二重再帰の場合と同じです。したがって、実行速度は二重再帰の場合とほとんどかわりません。また、二重再帰の場合は関数呼び出しによりスタックが消費されますが、CPS の場合はクロージャが生成されるのでメモリ (ヒープ領域) が消費されます。このように、再帰呼び出しを CPS に変換したからといって、効率の良いプログラムになるとは限りません。ご注意くださいませ。

●CPS の便利な使い方

階乗やフィボナッチ関数の場合、CPS に変換するメリットはほとんどありませんが、場合によっては CPS に変換した方が簡単にプログラムできることもあります。たとえば、リストを平坦化する関数 flatten で、リストの要素に空リストが含まれていたら空リストを返すようにプログラムを修正することを考えてみましょう。次のリストを見てください。

リスト : リストの平坦化 (間違い)

fun flatten([]) = []
|   flatten([]::_) = []
|   flatten(x::xs) = x @ flatten(xs)
val flatten = fn : 'a list list -> 'a list

関数 flatten は空リストを見つけたら空リストを返していますが、これでは正常に動作しません。実際に試してみると次のようになります。

- flatten([[1, 2], [3, 4], [5, 6]]);
val it = [1,2,3,4,5,6] : int list
- flatten([[1, 2], [3, 4], [], [5, 6]]);
val it = [1,2,3,4] : int list

2 番目の例が空リストを含む場合です。この場合、空リストを返したいのですが、その前の要素を連結したリストを返しています。空リストを見つける前にリストの連結処理を行っているので、空リストを見つけたらその処理を廃棄しないといけないのです。

このような場合、CPS を使うと簡単です。次のリストを見てください。

リスト : リストの平坦化 (CPS)

fun flatten_cps([], cont) = cont([])
|   flatten_cps([]::_, cont) = []
|   flatten_cps(x::xs, cont) = flatten_cps(xs, fn y => cont(x @ y))
val flatten_cps = fn : 'a list list * ('a list -> 'b list) -> 'b list

flatten を CPS に変換するのは簡単です。リストの先頭の要素 x と平坦化したリストの連結を継続で行うだけです。平坦化したリストは継続の引数 y に渡されるので、x @ y でリストを連結して、それを継続 cont に渡せばいいわけです。

引数のリストが空リストになったら継続 cont に空リストを渡して評価します。これで、リストの連結処理が行われます。もしも、途中で空リストを見つけた場合は、空リストをそのまま返します。この場合、継続 cont は評価されないので、リストの連結処理は行われず、空リストをそのまま返すことができます。

それでは実行してみましょう。

- flatten_cps([[1, 2], [3, 4], [5, 6]], fn x => x);
val it = [1,2,3,4,5,6] : int list
- flatten_cps([[1, 2], [3, 4], [], [5, 6]], fn x => x);
val it = [] : int list

正常に動作していますね。

●二分木の巡回を CPS で実装

次は二分木を巡回するプログラムを CPS で作ってみましょう。二分木は拙作のページ モジュール (2) で簡単に説明しました。二分木の構造と二分木を巡回する関数 traverse_tree は次のようになります。なお、今回作成した二分木の詳細は プログラムリスト をお読みください。

リスト : 二分木の巡回

(* 節の定義 *)
datatype 'a tree = Nil | Node of 'a * 'a tree * 'a tree

(* 巡回 *)
fun traverse_tree _ Nil = ()
|   traverse_tree f (Node(x, left, right)) = (
      traverse_tree f left;
      f(x);
      traverse_tree f right
    )
val traverse_tree = fn : ('a -> 'b) -> 'a tree -> unit

traverse_tree は二重再帰になっています。そこで、f(x) の評価と右部分木の巡回は継続で行うことにします。プログラムは次のようになります。

リスト : 二分木の巡回 (CPS)

fun traverse_tree_cps _ Nil cont = cont()
|   traverse_tree_cps f (Node(x, left, right)) cont =
    traverse_tree_cps f left (fn () => (f(x); traverse_tree_cps f right (fn () => cont ())))
val traverse_tree_cps = fn : ('a -> 'b) -> 'a tree -> (unit -> 'c) -> 'c

traverse_tree_cps は副作用が目的なので、継続に値を渡す必要はありません。そこで、cont には unit を渡すことにします。左部分木をたどったら継続 cont を呼び出します。その中で f(x) を評価し、そのあと右部分木をたどります。このときの継続は cont () を評価するだけです。これで生成された継続を呼び出して、木を巡回することができます。

それでは実際に試してみましょう。

- val a = tree_of_list([5,6,4,7,3,1,2,9,8]);
val a = Node (5,Node (4,Node #,Nil),Node (6,Nil,Node #)) : int tree
- traverse_tree_cps (fn(x) => print(Int.toString(x) ^ "\n")) a (fn () => ());
1
2
3
4
5
6
7
8
9
val it = () : unit

このように、traverse_tree_cps で二分木を通りがけ順で巡回することができます。

●二分木と遅延ストリーム

二分木の巡回を CPS に変換すると、遅延ストリームに対応するのも簡単です。次のリストを見てください。

リスト : 巡回 (遅延ストリーム版)

fun lazy stream_of_tree(Nil, cont) = cont()
|        stream_of_tree(Node(x, left, right), cont) =
         stream_of_tree(left, fn () => Cons(x, stream_of_tree(right, fn () => cont())))
val stream_of_tree = fn : 'a tree * (unit -> 'a stream! susp) -> 'a stream! susp
val stream_of_tree_ = fn : 'a tree * (unit -> 'a stream! susp) -> 'a stream!

stream_of_tree は二分木を巡回してその要素を順番に出力する遅延ストリームを生成します。traverse_tree_cps は継続の中で関数 f を呼び出しましたが、stream_of_tree は継続の中で遅延ストリーム Cons (x, <lazy>) を返します。そして、遅延オブジェクトの中で右部分木をたどり、その継続の中で cont () を呼び出します。

ここで継続 cont の型は unit -> 'a stream ('a stream! susp) になることに注意してください。stream_of_tree を呼び出すときに渡す継続が一番最後に呼び出されるので、遅延ストリームの終端 Nils を返すように定義してください。

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

- val a = tree_of_list([5,6,4,7,3,1,2,9,8]);
val a = Node (5,Node (4,Node #,Nil),Node (6,Nil,Node #)) : int tree
- val s = stream_of_tree(a, fn () => Nils);
val s = $$ : int stream! susp
- stream_take(s, 9);
val it = [1,2,3,4,5,6,7,8,9] : int list
- stream_take(s, 10);

uncaught exception Empty_stream

stream_of_tree を使うと、2 つの二分木が等しいか判定する述語 isequal を簡単に作ることができます。二分木の要素がすべて等しい場合、isequal は true を返し、そうでなければ false を返すことにします。つまり、二分木を集合として扱うわけです。プログラムは次のようになります。

リスト : 同値の判定

fun isequal(tree1, tree2) =
    let
      fun isequal_sub(Nils, Nils) = true
      |   isequal_sub(Cons(x, t1), Cons(y, t2)) =
          if x = y then isequal_sub(t1, t2) else false
    in
      isequal_sub(stream_of_tree(tree1, fn() => Nils),
                  stream_of_tree(tree2, fn() => Nils))
    end
val isequal = fn : ''a tree * ''a tree -> bool

実際の処理は局所関数 isequal_sub で行います。isequal_sub には二分木の遅延ストリームを渡します。あとは、遅延ストリームから要素を一つずつ取り出して、それが等しいかチェックするだけです。

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

- val a = tree_of_list([5,2,1,3,4,8,7,9,6]);
val a = Node (5,Node (2,Node #,Node #),Node (8,Node #,Node #)) : int tree
- val b = tree_of_list([1,2,3,4,5,6,7,8,9]);
val b = Node (1,Nil,Node (2,Nil,Node #)) : int tree
- isequal(a, b);
val it = true : bool
- val c = tree_of_list([5,2,1,3,4,8,7,10,6]);
val c = Node (5,Node (2,Node #,Node #),Node (8,Node #,Node #)) : int tree
- isequal(a, c);
val it = false : bool

変数 a, b に二分木をセットします。a と b では二分木の形状は異なりますが要素はすべて同じです。したがって、isequal(a, b) は true を返します。変数 c にセットされた二分木は要素が一つだけ異なっているので、isequal(a, c) は false を返します。

部分集合を判定する関数 issubset も簡単です。次のリストを見てください。

リスト : 部分集合の判定

fun issubset(tree1, tree2) =
    let
      fun issubset_sub(Nils, _) = true
      |   issubset_sub(_, Nils) = false
      |   issubset_sub(s1 as Cons(x, t1), Cons(y, t2)) =
          if x = y then issubset_sub(t1, t2)
          else if x > y then issubset_sub(s1, t2)
          else false
    in
      issubset_sub(stream_of_tree(tree1, fn() => Nils),
                   stream_of_tree(tree2, fn() => Nils))
    end
val issubset = fn : int tree * int tree -> bool

実際の処理は局所関数 issubset_sub で行います。遅延ストリーム s1 が s2 の途中で終了した場合、tree1 の要素はすべて tree2 にあるので tree1 は tree2 の部分集合です。issubset は true を返します。そうでなければ、遅延ストリームから要素を一つずつ取り出します。x = y ならば次の要素を調べます。 x > y の場合、x と等しい要素が s2 に存在するかもしれないので、x と s2 の次の要素を比較します。x < y の場合は、x と等しい要素は s2 に存在しないことがわかるので false を返します。

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

- val a = tree_of_list([5,6,4,7,3,1,2,9,8]);
val a = Node (5,Node (4,Node #,Nil),Node (6,Nil,Node #)) : int tree
- val b = tree_of_list([6,4,8,2]);
val b = Node (6,Node (4,Node #,Nil),Node (8,Nil,Nil)) : int tree
- issubset(b, a);
val it = true : bool
- issubset(a, b);
val it = false : bool

●遅延ストリームを使わない方法

ところで、遅延ストリームを使わなくても、クロージャを使って同様のことを行うことができます。次のリストを見てください。

リスト : 遅延ストリームを使わない場合

(* 継続を表すデータ型 *)
datatype 'a continue = Nilc | Cont of 'a * (unit -> 'a continue)

(* 二分木の巡回 *)
fun continue_of_tree(Nil, cont) = cont()
|   continue_of_tree(Node(x, left, right), cont) =
    continue_of_tree(left, fn () => Cont(x, fn() => continue_of_tree(right, fn () => cont())))

(* 二分木 : 同値の判定 *)
fun isequal1(tree1, tree2) =
    let
      fun isequal_sub(Nilc, Nilc) = true
      |   isequal_sub(Cont(x, t1), Cont(y, t2)) =
          if x = y then isequal_sub(t1(), t2()) else false
    in
      isequal_sub(continue_of_tree(tree1, fn() => Nilc),
                  continue_of_tree(tree2, fn() => Nilc))
    end

(* 二分木 : 部分集合の判定 *)
fun issubset1(tree1, tree2) =
    let
      fun issubset_sub(Nilc, _) = true
      |   issubset_sub(_, Nilc) = false
      |   issubset_sub(s1 as Cont(x, t1), Cont(y, t2)) =
          if x = y then issubset_sub(t1(), t2())
          else if x > y then issubset_sub(s1, t2())
          else false
    in
      issubset_sub(continue_of_tree(tree1, fn() => Nilc),
                   continue_of_tree(tree2, fn() => Nilc))
    end
val continue_of_tree = fn : 'a tree * (unit -> 'a continue) -> 'a continue
val isequal1 = fn : ''a tree * ''a tree -> bool
val issubset1 = fn : int tree * int tree -> bool

継続を表すデータ型として 'a continue を定義します。Nilc は継続が終了したことを表し、Cont が継続の本体を表します。Cont の第 2 要素にはクロージャを格納し、このクロージャを評価すると次の要素を求めることができます。この場合、遅延オブジェクトのかわりにクロージャを使っているだけなので、計算結果はキャッシュされないことに注意してください。

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

- val a = tree_of_list([5,6,4,7,3,8,9,2,1]);
val a = Node (5,Node (4,Node #,Nil),Node (6,Nil,Node #)) : int tree
- val b = tree_of_list([2,4,6,8]);
val b = Node (2,Nil,Node (4,Nil,Node #)) : int tree
- isequal1(a, a);
val it = true : bool
- isequal1(b, a);
val it = false : bool
- issubset1(b, a);
val it = true : bool
- issubset1(a, b);
val it = false : bool

このように、クロージャを使ってプログラムの実行を中断したり、あとから再開することもできます。


●プログラムリスト

(*
 * tree.sml : 二分木
 *
 *            Copyright (C) 2012-2021 Makoto Hiroi
 *
 *)
(* lazy.sml を先にロードすること *)

(* 例外 *)
exception Empty_tree

(* 節の定義 *)
datatype 'a tree = Nil | Node of 'a * 'a tree * 'a tree

(* データの探索 *)
fun search_tree(x, Nil) = false
|   search_tree(x, Node(y, left, right)) =
    if x = y then true
    else if x < y then search_tree(x, left)
    else search_tree(x, right)

(* データの挿入 *)
fun insert_tree(x, Nil) = Node(x, Nil, Nil)
|   insert_tree(x, node as Node(y, left, right)) =
    if x = y then node
    else if x < y then Node(y, insert_tree(x, left), right)
    else Node(y, left, insert_tree(x, right))

(* 最小値を求める *)
fun search_min(Nil) = raise Empty_tree
|   search_min(Node(x, Nil, _)) = x
|   search_min(Node(_, left, _)) = search_min(left)

(* 最小値を削除する *)
fun delete_min(Nil) = raise Empty_tree
|   delete_min(Node(_, Nil, right)) = right
|   delete_min(Node(x, left, right)) = Node(x, delete_min(left), right)

(* 削除 *)
fun delete_tree(_, Nil) = raise Empty_tree
|   delete_tree(x, Node(y, left, right)) =
    if x = y then
      if left = Nil then right
      else if right = Nil then left
      else
        let val min_data = search_min(right) in
          Node(min_data, left, delete_min(right))
        end
    else if x < y then Node(y, delete_tree(x, left), right)
    else Node(y, left, delete_tree(x, right))

(* 巡回 *)
fun traverse_tree _ Nil = ()
|   traverse_tree f (Node(x, left, right)) = (
      traverse_tree f left;
      f(x);
      traverse_tree f right
    )

(* CPS スタイル *)
fun traverse_tree_cps _ Nil cont = cont()
|   traverse_tree_cps f (Node(x, left, right)) cont =
    traverse_tree_cps f left (fn () => (f(x); traverse_tree_cps f right (fn () => cont ())))

(* リスト -> 二分木 *)
fun tree_of_list(xs) = foldl (fn(x, a) => insert_tree(x, a)) Nil xs

(* 二分木 -> リスト *)
fun list_of_tree(node) =
    let
      fun iter(Nil, a) = a
      |   iter(Node(x, left, right), a) = iter(left, x::iter(right, a))
    in
      iter(node, [])
    end

(* 遅延ストリーム版 *)
fun lazy stream_of_tree(Nil, cont) = cont()
|        stream_of_tree(Node(x, left, right), cont) =
         stream_of_tree(left, fn () => Cons(x, stream_of_tree(right, fn () => cont())))

(* 同値の判定 *)
fun isequal(tree1, tree2) =
    let
      fun isequal_sub(Nils, Nils) = true
      |   isequal_sub(Cons(x, t1), Cons(y, t2)) =
          if x = y then isequal_sub(t1, t2) else false
    in
      isequal_sub(stream_of_tree(tree1, fn() => Nils),
                  stream_of_tree(tree2, fn() => Nils))
    end

(* 部分集合の判定 *)
fun issubset(tree1, tree2) =
    let
      fun issubset_sub(Nils, _) = true
      |   issubset_sub(_, Nils) = false
      |   issubset_sub(s1 as Cons(x, t1), Cons(y, t2)) =
          if x = y then issubset_sub(t1, t2)
          else if x > y then issubset_sub(s1, t2)
          else false
    in
      issubset_sub(stream_of_tree(tree1, fn() => Nils),
                   stream_of_tree(tree2, fn() => Nils))
    end


(* 遅延ストリームを使わない場合 *)

(* 継続を表すデータ型 *)
datatype 'a continue = Nilc | Cont of 'a * (unit -> 'a continue)

(* 二分木の巡回 *)
fun continue_of_tree(Nil, cont) = cont()
|   continue_of_tree(Node(x, left, right), cont) =
    continue_of_tree(left, fn () => Cont(x, fn() => continue_of_tree(right, fn () => cont())))

(* 二分木 : 同値の判定 *)
fun isequal1(tree1, tree2) =
    let
      fun isequal_sub(Nilc, Nilc) = true
      |   isequal_sub(Cont(x, t1), Cont(y, t2)) =
          if x = y then isequal_sub(t1(), t2()) else false
    in
      isequal_sub(continue_of_tree(tree1, fn() => Nilc),
                  continue_of_tree(tree2, fn() => Nilc))
    end

(* 二分木 : 部分集合の判定 *)
fun issubset1(tree1, tree2) =
    let
      fun issubset_sub(Nilc, _) = true
      |   issubset_sub(_, Nilc) = false
      |   issubset_sub(s1 as Cont(x, t1), Cont(y, t2)) =
          if x = y then issubset_sub(t1(), t2())
          else if x > y then issubset_sub(s1, t2())
          else false
    in
      issubset_sub(continue_of_tree(tree1, fn() => Nilc),
                   continue_of_tree(tree2, fn() => Nilc))
    end

初版 2012 年 7 月 7 日
改訂 2021 年 5 月 29 日

Copyright (C) 2012-2021 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]