M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

ファイル入出力

SML/NJ の入出力は Common Lisp などの近代的なプログラミング言語と同様に「ストリーム (stream)」を介して行われます。入力ストリームを表すデータ型が instream で、出力ストリームを表すデータ型が outstream です。テキストファイルの入出力関数はストラクチャ TextIO にまとめられています。今回はファイルの入出力について説明します。

●ストリーム

ファイルからデータを入力、逆にデータをファイルへ出力する場合、SML/NJ では「ストリーム (stream)」を使います。ストリームは「流れ」や「小川」という意味ですが、プログラミング言語の場合は「ファイルとプログラムの間でやりとりされるデータの流れ」という意味で使われています。

SML/NJ では、ストリーム型データを介してファイルにアクセスします。ストリームはファイルと一対一に対応していて、ファイルからデータを入力する場合は、ストリームを経由してデータが渡されます。逆に、ファイルへデータを出力するときも、ストリームを経由して行われます。

●ファイルのオープンとクローズ

ファイルにアクセスする場合、次の 3 つの操作が基本になります。

  1. アクセスするファイルをオープンする
  2. 入出力関数を使ってファイルを読み書きする。
  3. ファイルをクローズする。

「ファイルをオープンする」とは、アクセスするファイルを指定して、それと一対一に対応するストリームを生成することです。入出力関数は、そのストリームを経由してファイルにアクセスします。SML/NJ の場合、ファイルをオープンするには関数 openIn と openOut を使います。オープンしたファイルは必ずクローズしてください。この操作を行う関数が closeIn と closeOut です。

val openIn   : string -> instream
val openOut  : string -> outstream
val closeIn  : instream -> unit
val closeOut : outstream -> unit

ファイル名は文字列で指定し、ファイル名のパス区切り記号にはスラッシュ ( / ) を使います。\ は文字列のエスケープコードに割り当てられているため、そのままではパス区切り記号に使うことはできません。ご注意ください。ファイルのオープンやクローズに失敗した場合は例外 Io が送出されます。

●input1 と output1

主な入出力関数を次に示します。

読み込み
val TextIO.input1    : instream -> char option 
val TextIO.inputLine : instream -> string option
書き込み
val TextIO.output1 : outstream * char -> unit
val TextIO.output  : outstream * string -> unit

関数 input1 は入力ストリームから 1 文字 (1 byte) 読み込みます。関数 inputLine はファイルから 1 行読み込みます。改行文字は削除されません。関数 output1 は出力ストリームに 1 文字 (1 byte) 書き込みます。関数 output は出力ストリームに 1 行書き込みます。

入力ストリームの場合、ファイルに格納されているデータには限りがあるので、ストリームからデータを取り出していくと、いつかはデータがなくなります。この状態を「ファイルの終了 (end of file : EOF)」 といいます。ファイルが終了したとき、input1 と inputLine は NONE を返します。また、ファイルの終了は次の関数でチェックすることができます。

val TextIO.endOfStream : instream -> bool

ファイルが EOF の場合、endOfStream は true を返します。そうでなければ false を返します。

簡単な例題として、ファイルの内容を画面へ出力する関数 cat を作ってみましょう。input1 と output1 を使うと、プログラムは次のようになります。

リスト : ファイルの表示 (1)

fun cat1 filename =
  let
    open TextIO
    val a = openIn( filename )
    fun cat_sub NONE = ()
    |   cat_sub(SOME c) = (output1(stdOut, c); cat_sub(input1 a))  
  in
    cat_sub(input1 a);
    closeIn a 
  end

関数 cat1 の引数 filename はファイル名を表す文字列です。最初にストラクチャ TextIO をオープンします。open は宣言なので、let と in の間に書くことができます。有効範囲は局所変数の場合と同じです。次に、openIn でファイルをオープンします。

ファイルの表示は関数 cat_sub で行います。cat_sub の引数は input1 a の返り値 (char option) です。NONE の場合はファイルが終了したのでユニットを返します。データがある場合は、パターンマッチングで文字 c を取り出し、output1 で c を標準出力 (stdOut) へ出力します。そして、input1 a で 1 文字読み込んで cat_sub を再帰呼び出しします。最後に、closeIn でファイルを閉じます。

cat1 は再帰呼び出しを使いましたが、繰り返しでも簡単にプログラムできます。次のリストを見てください。

リスト : ファイルの表示 (2)

fun cat2 filename =
  let
    open TextIO
    val a = openIn filename
    val c = ref (NONE: char option)
  in
    while (c := input1 a; isSome (!c)) do output1(stdOut, valOf(!c));
    closeIn a
  end

まず、option 型を格納する ref 変数 c を用意します。NONE は多相的なデータなので、型を char option に指定します。while ループの条件部は複文を使っています。最初に、ref 変数 c に input1 の返り値をセットし、次に関数 isSome でデータがあるかチェックします。これが複文の返り値になるので、isSome が false を返すと while ループが終了します。データがある間は output1 でデータを stdOut へ出力します。

●inputLine と output

次は、inputLine と output を使ってみましょう。プログラムは次のようになります。

リスト : ファイルの表示 (3)

fun cat3 filename =
  let
    open TextIO
    val a = openIn filename
    val b = ref (NONE: string option)
  in
    while (b := inputLine a; isSome (!b)) do output(stdOut, valOf(!b));
    closeIn a
  end

fun cat4 filename =
  let
    open TextIO
    val a = openIn filename
  in
    while (not(endOfStream a)) do output(stdOut, valOf(inputLine a));  
    closeIn a
  end

関数 cat3 は cat2 を行単位の入出力に改造しただけです。string option を格納する ref 変数 b を用意します。while ループの条件部で、inputLine の返り値を b にセットし、isSome でデータがあるかチェックします。NONE であれば while ループを終了します。そうでなければ、データを output で stdOut へ出力します。

関数 cat4 は endOfStream でファイルの終了をチェックしています。endOfStream はファイルが終了すると true を返すので、while ループの条件部では述語 not で結果を反転していることに注意してください。あとは inputLine で読み込んだデータを output で stdOut へ出力するだけです。

●ファイルの書き込み

データをファイルに書き込むには、ファイルを openOut でオープンします。このとき、注意事項が一つあります。既に同じ名前のファイルが存在している場合は、そのファイルの長さを 0 に切り詰めてからデータを書き込みます。既存のファイルは内容が破壊されることに注意してください。

それでは簡単な例題として、string list の要素を 1 行ずつファイルに書き込む関数 output_stringList を作ってみましょう。次のリストを見てください。

リスト : ファイルの書き込み

fun output_stringList(data, filename) =
  let
    open TextIO
    val a = openOut filename
  in
    app (fn x => output(a, x ^ "\n")) data;  
    closeOut a
  end

最初に openOut でファイルをオープンします。あとは、高階関数 app を使って data から要素を一つずつ取り出し、改行文字を付加してから output で出力するだけです。

このほかにも、SML/NJ にはいろいろな入出力関数が用意されています。詳しい説明は SML/NJ ライブラリのマニュアル The Standard ML Basis Library を参照してください。


初版 2005 年 6 月 11 日
改訂 2020 年 8 月 16 日

経路の探索

今回は、地図上の A 地点から B 地点までの道順を求める、といった「経路の探索」と呼ばれる問題を取り上げます。「探索」にはいろいろな種類があります。「8 クイーン」のようなパズルの解法も、あらゆる可能性の中から正解に行き着く手順を探すことですから、探索の一つと考えることができます。そして、探索でよく用いられる最も基本的な方法が「バックトラック」なのです。もちろん、経路の探索もバックトラックで解くことができます。

このほかに、もう一つ基本的な方法として「幅優先探索」があります。バックトラックの場合、失敗したら後戻りして別の道を選び直しますが、幅優先探索の場合は、全ての経路について並行に探索を進めていきます。幅優先探索は最短手順を求めるのに適したアルゴリズムですが、問題によっては必要となるメモリの量がとても多くなり、幅優先探索を使用することができない場合があります。このような場合、「反復深化」という方法を使うと、多少時間はかかりますが、少ないメモリで最短手順を求めることができます。今回はこの 3 つの方法で経路を求めてみましょう。

●グラフの表現方法

簡単な例題として、次に示す経路を考えてみます。


        図 :経路図

点とそれを接続する線からなる図形を「グラフ (graph)」といいます。点のことを「頂点 (vertex)」とか「節 (node)」と呼び、線のことを「辺 (edge)」とか「弧 (arc)」と呼びます。グラフには 2 種類あって、辺に向きがないものを「無向グラフ」といい、向きがあるものを「有向グラフ」といいます。有向グラフは一方通行の道と考えるとわかりやすいでしょう。上図ではアルファベットで頂点を表しています。今回は経路をグラフで表していますが、このほかにもいろいろな問題をグラフで表現することができます。

グラフをプログラムする場合、よく使われる方法が「隣接行列」と「隣接リスト」です。隣接行列は 2 次元配列で頂点の連結を表す方法です。頂点が N 個ある場合、隣接行列は N 行 N 列の行列で表すことができます。上図を隣接行列で表すと、次のようになります。

   | A B C D E F G
  -+--------------  
  A| 0 1 1 0 0 0 0
  B| 1 0 1 1 0 0 0
  C| 1 1 0 0 1 0 0
  D| 0 1 0 0 1 1 0
  E| 0 0 1 1 0 0 1
  F| 0 0 0 1 0 0 0
  G| 0 0 0 0 1 0 0

    図 : 隣接行列

A に接続している頂点は B と C なので、A 行の B と C に 1 をセットし、接続していない頂点には 0 をセットします。経路が一方通行ではない無向グラフの場合は、A 列の B と C にも 1 がセットされます。

隣接行列の欠点は、辺の数が少ない場合でも N 行 N 列の行列が必要になることです。つまり、ほとんどの要素が 0 になってしまい、メモリを浪費してしまうのです。この欠点を補う方法に隣接リストがあります。これは、つながっている頂点を格納する方法です。次の図を見てください。

  A => [B, C]
  B => [A, C, D]  
  C => [A, B, E]
  D => [B, E, F]
  E => [C, D, G]
  F => [D]
  G => [E]


  図 : 隣接リスト

上図は、頂点とそこに接続されている頂点を => と [ ] で表しています。これを SML/NJ で表すと、次のようになります。

リスト : 隣接リスト (1)

val adjacent = [
  [1, 2],     (* A *)  
  [0, 2, 3],  (* B *)
  [0, 1, 4],  (* C *)
  [1, 4, 5],  (* D *)
  [2, 3, 6],  (* E *)
  [3],        (* F *)
  [4]];       (* G *)
};
リスト : 隣接リスト (2)

val adjacent = #[
  #[1, 2],     (* A *)  
  #[0, 2, 3],  (* B *)
  #[0, 1, 4],  (* C *)
  #[1, 4, 5],  (* D *)
  #[2, 3, 6],  (* E *)
  #[3],        (* F *)
  #[4]];       (* G *)
};

頂点 A から G を数値 0 から 6 に対応させるところがポイントです。すると、隣接リスト adjacent は int list list で表すことができます。リストのほかに、「ベクタ (vector)」を使うこともできます。SML/NJ のベクタは、値を書き換えることができない 1 次元配列のことです。ベクタは #[ ... ] で生成することができます。次の例を見てください。

- #[1, 2, 3];
val it = #[1,2,3] : int vector

- #[[1, 2], [3, 4, 5]];
val it = #[[1,2],[3,4,5]] : int list vector

- #[#[1, 2], #[3, 4, 5]];
val it = #[#[1,2],#[3,4,5]] : int vector vector

ベクタは配列と同様に多相的なデータなので、型は 'a vector で表されます。int を格納するベクタは int vecotor になり、int list を格納するベクタは int list vector になります。もちろん、int vector を格納することもできます。その場合は int vector vector になります。隣接リスト (2) は int vector vector で隣接リストを表しています。

ベクタの操作関数はストラクチャ Vector に定義されています。ベクタの操作は配列とほとんど同じです。ただし、値を書き換える操作はありません。ベクタの要素は配列と同様に関数 sub で取り出すことができますが、ベクタの要素を書き換える関数 update はありません。

ところで、隣接リストにも欠点があります。たとえば、E と G が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。

●深さ優先探索

今回は隣接リスト (1) を使って、A から G までの経路をバックトラックで求めることにします。バックトラックを再帰呼び出しで実現する場合、経路を「進む」ことを再帰呼び出しに対応させるのがポイントです。たとえば、経路を探索する関数を search としましょう。search は引数として現在地点の頂点を受け取ることにします。最初は search(A) と呼び出します。そして、A から B へ進むには search(B) と呼び出します。これで B へ進むことができます。

それでは、A に戻るにはどうしたらいいのでしょう。search(B) は search(A) から呼び出されたので、search(B) の実行を終了すれば、呼び出し元である search(A) に戻ることができます。つまり、関数の実行を終了すれば、一つ手前の地点にバックトラックできるのです。このように再帰呼び出しを使うと、進むことと戻ることを関数呼び出しで簡単に実現することができます。

それでは具体的に説明しましょう。経路はリストに頂点を格納して表すことにします。次の図を見てください。

  A - B - D      ─→  [0, 1. 3]    ==> [3, 1, 0]

  A - B - C - E  ─→  [0, 1, 2, 4] ==> [4, 2, 1, 0]  

                               逆順で管理する


                図 : 経路の表し方

リストの最後尾にデータを追加するのは面倒なので、経路は上図のように逆順で管理することにします。

経路の探索を行う関数 search は、次のように定義します。

val search = fn : int * int list -> unit

search の第 1 引数がゴール、第 2 引数が経路を表すリストです。リストの先頭要素が現在地点の頂点になります。search は現在地点に隣接している頂点を一つ選び、経路を進めていきます。A から G までの経路を求めるには、次のように呼び出します。

(* A から G までの経路を求める *)
search(6, [0])

search は出発点 A をリストにセットし、A に接続されている頂点を選びます。隣接リストから順番に選ぶことにすると、次の頂点は B となります。B へ進むためには、次のように search を再帰呼び出しします。

(* B へ進む時の再帰呼び出し *)
search(6, [1, 0]);

この関数の実行を終了すると、呼び出し元の関数である頂点 A の処理に戻ります。

実際のプログラムは次のようになります。

リスト : 深さ優先探索 (depth first search)

fun print_intlist nil = print "\n"
|   print_intlist (x::xs) = (print(Int.toString(x) ^ " "); print_intlist xs)

fun check(x, nil)   = true
|   check(x, y::ys) = if x = y then false else check(x, ys)

fun dfs(goal, path as x::xs) = 
  if x = goal then print_intlist (rev path)
  else app (fn y => if check(y, path) then dfs(goal, y::path) else ())
           (List.nth(adjacent, x))

fun solver() = dfs(6, [0])

関数 dfs (Depth-First-Search の略) を見てください。最初に、現在地点 x がゴール goal かチェックします。これが再帰呼び出しの停止条件になります。ゴールしたら print_intlist で経路を表示します。ここで探索を終了することもできますが、バックトラックすることで全ての経路を見つけることができます。パズルを解く場合、解の総数を求めることが多いので、全ての解をもれなく探索する必要があります。バックトラックを使えば、このような要求も満たすことができます。

ゴールしていない場合は、隣接リストから次の頂点を選びます。関数 nth はリストから n 番目の要素を取り出します。nth はストラクチャ List に定義されている関数です。

nth list n

nth の場合、リストの先頭要素が 0 番目になります。簡単な使用例を示します。

- val a = [1, 2, 3];
val a = [1,2,3] : int list
- List.nth(a, 0);
val it = 1 : int
- List.nth(a, 2);
val it = 3 : int

頂点 x の隣接リストを nth で取り出します。そして、関数 app でリストの要素を順番に取り出して、匿名関数の中で search を再帰呼び出しします。このとき、経路に含まれている頂点を選んではいけません。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールまでたどり着くことができなくなります。このチェックを関数 check で行っています。経路 path の中に頂点 y がないことを確認してから、経路に y を追加して dfs を再帰呼び出しします。

実行結果は次のようになります。

- solver();
0 1 2 4 6
0 1 3 4 6
0 2 1 3 4 6
0 2 4 6
val it = () : unit

4 通りの経路を見つけることができました。バックトラックによる探索は、経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるのに適したアルゴリズムが「幅優先探索 (breadth first search)」です。

●幅優先探索

バックトラックによる探索は「深さ優先探索」や「縦形探索」とも呼ばれるように、一つの経路を先へ先へと進めていきます。このため最初に見つかる経路が最短経路であるとは限りません。幅優先探索は全ての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。

それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。


        図 : 経路図

幅優先探索の様子を下図に示します。


                        図 : 幅優先探索

まず、出発点 A から一つ進んだ経路 (2 節点) を全て求めます。この場合は、[A, B] と [A, C] の 2 つあり、これを全て記憶しておきます。次に、これらの経路から一つ進めた経路 (3 節点) を全て求めます。経路 [A, B] は [A, B, C] と [A, B, D] へ進めることができますね。ほかの経路 [A, C] も同様に進めて、全ての経路を記憶します。あとはこの作業をゴールに達するまで繰り返せばいいのです。

上図では、4 節点の経路 [A, C, E, G] でゴールに達していることがわかります。このように幅優先探索では、最初に見つかった経路が最短距離 (または最小手数) となるのです。この性質は、全ての経路を平行に進めていく探索順序から考えれば当然のことといえるでしょう。このことからバックトラックの縦形探索に対して、幅優先探索は「横形探索」と呼ばれます。このあとも探索を繰り返せば全ての経路を求めることができます。

完成までの最小手数を求めるパズルを解く場合、幅優先探索を使ってみるといいでしょう。ただし、探索を進めるにしたがって、記憶しておかなければならないデータの総数が爆発的に増加する、つまりメモリを大量消費することに注意してください。

上図の場合ではメモリを大量消費することはありませんが、問題によってはマシンに搭載されているメモリが不足するため、幅優先探索を実行できない場合もあるでしょう。したがって、幅優先探索を使う場合は、メモリの消費量を抑える工夫も必要になります。

●経路の管理

経路の管理はキューを使うと簡単です。幅優先探索でのキューの動作を下図に示します。


          図 : 幅優先探索とキューの動作

最初は、(1) のように出発点をキューにセットしておきます。次に、キューから経路を取り出し、(2) のように経路 [A] を一つ進めて、経路 [A, B] [A, C] を作り、それをキューに追加します。(3) では、経路 [A, B] を取り出して、一つ進めた経路 [A, B, C] と [A, B, D] をキューに追加します。あとはキューに経路がある間、処理を繰り返せばいいわけです。

キューは先入れ先出し (FIFO) の性質を持つデータ構造です。距離の短い経路から順番に処理されるため、幅優先探索として機能するわけです。

●プログラムの作成

それではプログラムを作りましょう。経路図は深さ優先探索と同じく隣接リスト (1) で表します。キューは モジュール (3) で作成したファンクタ makeQueue を使って生成します。プログラムは次のようになります。

リスト : 幅優先探索 (1)

(* ストラクチャの生成 *)
structure PathQueue = makeQueue(type item = int list)
open PathQueue

(* 幅優先探索 *)
fun bfs start goal = 
  let
    val q = ref create
  in
    q := enqueue(!q, [start]);
    while not(isEmpty(!q)) do (
      let
        val path = front(!q)
      in
        q := dequeue(!q);
        if hd path = goal then print_intlist(rev path)
        else app (fn(y) => if check(y, path) then q := enqueue(!q, y::path) else ())
                 (List.nth(adjacent, hd path))
      end
    )
  end

最初にストラクチャ PathQueue をファンクタ makeQueue で生成します。makeQueue の引数は、経路のデータ型 int list を指定します。幅優先探索を行う関数が bfs (Breadth-First-Search の略) です。幅優先探索は繰り返しを使うと簡単にプログラムできます。create で空のキューを生成して ref 変数 q にセットします。

次に、関数 enqueue でスタート地点の経路 [0] をキューに格納します。あとは、キューに経路がある間、while ループで探索を行います。関数 front でキューから経路を求めて変数 path にセットし、関数 dequeue でキューから経路を削除します。関数 hd でキューの先頭要素を求め、それが goal と等しければ print_intlist で経路を表示します。

そうでなければ、経路を一つ進めます。この処理は深さ優先探索とほぼ同じですが、新しい経路を enqueue でキューに追加していくところが異なります。これで全ての経路を求めることができます。

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

- bfs(0, 6);
0 2 4 6
0 1 2 4 6
0 1 3 4 6
0 2 1 3 4 6
val it = () : unit

結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが、経路の総数は 4 通りとなります。

ちなみに、再帰定義で幅優先探索をプログラムすると次のようになります。

リスト : 幅優先探索 (2)

fun bfs1(goal, q) = 
  if isEmpty q then ()
  else
    let
      val path = front q
    in
      if hd path = goal then print_intlist (rev path) else ();
      bfs1(goal, 
           List.foldl (fn(x, q) => if check(x, path) then enqueue(q, x::path) else q)
                      (dequeue q)
                      (List.nth(adjacent, hd path)))
    end

(* 探索の実行 *)
fun solver_bfs1() = bfs1(6, enqueue(create, [0]))

こちらの方が関数型言語らしいプログラムかもしれません。ご参考までに。

●反復深化

幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときは、幅優先探索を使うことができません。深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。

それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていく、という方法です。

たとえば、1 手で解が見つからない場合は、2 手までを探索し、それでも見つからない場合は 3 手までを探索する、というように制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping)」といいます。

反復深化は、最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大するという欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。

●反復深化のプログラム

それでは、同じ経路図を使って反復深化を具体的に説明しましょう。


        図 : 経路図

反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を1手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。

リスト : 反復深化

fun ids(n, limit, goal, path) =
  if n = limit
  then
    if hd path = goal then print_intlist(rev path) else ()
    else app (fn x => if check(x, path) then ids(n + 1, limit, goal, x::path) else ())
             (List.nth(adjacent, hd path))

(* 探索の実行 *)
fun solver_ids() =
  let
    val i = ref 1
  in
    while !i < 7 do (
      print(Int.toString(!i) ^ " moves\n" );
      ids(0, !i, 6, [0]);
      i := !i + 1
    )
  end

関数 ids (Iterative-Deeping-Searh の略) の引数 limit が上限値を表します。引数 n が経路の長さを表し、これが上限値 limit に達したら探索を打ち切ります。このとき、ゴールに到達したかチェックします。あとは、関数 solver_ids で limit の値を増やしながら ids を呼び出せばいいわけです。それでは実行結果を示しましょう。

- solver_ids();
1 moves
2 moves
3 moves
0 2 4 6
4 moves
0 1 2 4 6
0 1 3 4 6
5 moves
0 2 1 3 4 6
6 moves
val it = () : unit  

結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムでは全ての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。

●プログラムリスト

(*
 * keiro.sml : 経路の探索
 *
 *             Copyright (C) 2005-2020 Makoto Hiroi
 *)

(* ファンクタの定義 *)
functor makeQueue(type item) = struct
  abstype 'a queue = Q of 'a list * 'a list with
    exception EmptyQueue
    val create = Q(nil: item list, nil: item list)

    fun enqueue(Q(front, rear), x) = Q(front, x::rear)

    fun dequeue(Q(nil, nil)) = raise EmptyQueue
    |   dequeue(Q(nil, rear)) = dequeue(Q(rev rear, nil))
    |   dequeue(Q(x::xs, rear)) = Q(xs, rear)

    fun front(Q(nil, nil)) = raise EmptyQueue
    |   front(Q(nil, rear)) = front(Q(rev rear, nil))
    |   front(Q(x::xs, _)) = x

    fun isEmpty(Q(nil, nil) ) = true
    |   isEmpty _ = false
  end
end

(* ストラクチャの生成 *)
structure PathQueue = makeQueue(type item = int list)
open PathQueue

(* 隣接リスト *)
val adjacent = [
  [1, 2],     (* 0 *)
  [0, 2, 3],  (* 1 *)
  [0, 1, 4],  (* 2 *)
  [1, 4, 5],  (* 3 *)
  [2, 3, 6],  (* 4 *)
  [3],        (* 5 *)
  [4]];       (* 6 *)

(* int list の表示 *)
fun print_intlist nil = print "\n"
|   print_intlist (x::xs) = ( print (Int.toString(x) ^ " "); print_intlist xs)

(* 同じ頂点が含まれているか *)
fun check(x, nil)   = true
|   check(x, y::ys) = if x = y then false else check(x, ys)

(* 深さ優先探索 *)
fun dfs(goal, path as x::xs) = 
  if x = goal then print_intlist (rev path)
  else app (fn y => if check(y, path) then dfs(goal, y::path) else ())
           (List.nth(adjacent, x))

(* 探索の実行 *)
fun solver() = dfs(6, [0])

(* 幅優先探索 *)
fun bfs start goal = 
  let
    val q = ref create
  in
    q := enqueue(!q, [start]);
    while not(isEmpty(!q)) do (
      let
        val path = front(!q)
      in
        q := dequeue(!q);
        if hd path = goal then print_intlist(rev path)
        else app (fn(y) => if check(y, path) then q := enqueue(!q, y::path) else ())
                 (List.nth(adjacent, hd path))
      end
    )
  end

(* 繰り返しを使わない場合 *)
fun bfs1(goal, q) = 
  if isEmpty q then ()
  else
    let
      val path = front q
    in
      if hd path = goal then print_intlist (rev path) else ();
      bfs1(goal, 
           List.foldl (fn(x, q) => if check(x, path) then enqueue(q, x::path) else q)
                      (dequeue q)
                      (List.nth(adjacent, hd path)))
    end

(* 探索の実行 *)
fun solver_bfs1() = bfs1(6, enqueue(create, [0]))

(* 反復深化 *)
fun ids(n, limit, goal, path) =
  if n = limit
  then
    if hd path = goal then print_intlist(rev path) else ()
    else app (fn x => if check(x, path) then ids(n + 1, limit, goal, x::path) else ())
             (List.nth(adjacent, hd path))

(* 探索の実行 *)
fun solver_ids() =
  let
    val i = ref 1
  in
    while !i < 7 do (
      print(Int.toString(!i) ^ " moves\n" );
      ids(0, !i, 6, [0]);
      i := !i + 1
    )
  end

初版 2005 年 6 月 18 日
改訂 2020 年 8 月 16 日

Copyright (C) 2005-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]