M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

遅延ストリーム (2)

遅延ストリームの続きです。今回は遅延ストリームを使った応用例として、素数や順列を生成するプログラムを作ってみましょう。遅延評価はモジュール SMLofNJ.Susp ではなくキーワード lazy を使うことにします。

●遅延ストリームの操作関数 (2)

まずは最初に、2 つの遅延ストリームを受け取って 1 つのストリームを返す関数を考えます。一番簡単な操作は 2 つのストリームを結合することです。次のリストを見てください。

リスト : 遅延ストリームの定義

(* 例外 *)
exception Empty_stream

(* 遅延ストリームの定義 *)
datatype lazy 'a stream = Nils | Cons of 'a * 'a stream

(* アクセス関数 *)
fun stream_head (Cons(x, _)) = x
|   stream_head Nils = raise Empty_stream

fun lazy stream_tail (Cons(_, s)) = s
|        stream_tail Nils = raise Empty_stream
val stream_head = fn : 'a stream! susp -> 'a
val stream_tail = fn : 'a stream! susp -> 'a stream! susp
val stream_tail_ = fn : 'a stream! susp -> 'a stream!
リスト : 遅延ストリームの結合

fun lazy stream_append(Nils, s2) = s2
|        stream_append(Cons(x, tail), s2) = Cons(x, stream_append(tail, s2))

関数 stream_append はストリーム s1 と s2 を結合したストリームを返します。処理は簡単で、s1 の要素を順番に取り出していき、s1 が空になったら s2 を返すだけです。遅延ストリームの定義に lazy を指定しているので、tail と引数 Cons(...) をパターンマッチングするときに tail が評価 (force) されます。

stream_append の型は次のようになります。

val stream_append = fn : 'a stream! susp * 'a stream! susp -> 'a stream! susp
val stream_append_ = fn : 'a stream! susp * 'a stream! susp -> 'a stream!

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

- val s1 = range(1, 4);
val s1 = $$ : int stream! susp
- val s2 = range(11, 14);
val s2 = $$ : int stream! susp
- val s3 = stream_append(s1, s2);
val s3 = $$ : int stream! susp
- stream_take(s3, 8);
val it = [1,2,3,4,11,12,13,14] : int list

次はストリーム s1 と s2 の要素を交互に出力するストリームを作ります。次のリストを見てください。

リスト : ストリームの要素を交互に出力

fun lazy interleave(Nils, s2) = s2
|        interleave(Cons(x, tail), s2) = Cons(x, interleave(s2, tail))

関数 interleave はストリーム s1 と s2 を受け取ります。そして、s1 の要素を新しいストリームに格納したら、次は s2 の要素を新しいストリームに格納します。これは遅延オブジェクトで interleave を呼び出すとき、引数 s1 と s2 の順番を交換するだけです。これで s1 と s2 の要素を交互に出力することができます。

interleave の型は次のようになります。

val interleave = fn : 'a stream! susp * 'a stream! susp -> 'a stream! susp
val interleave_ = fn : 'a stream! susp * 'a stream! susp -> 'a stream!

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

- val s4 = interleave(s1, s2);
val s4 = $$ : int stream! susp
- stream_take(s4, 8);
val it = [1,11,2,12,3,13,4,14] : int list

stream_append の場合、無限ストリームを結合することはできませんが、interleave ならば無限ストリームにも対応することができます。簡単な例を示しましょう。

- val rec lazy ones = Cons(1, ones);
val ones = $$ : int stream! susp
- stream_take(ones, 8);
val it = [1,1,1,1,1,1,1,1] : int list
- val rec lazy twos = Cons(2, twos);
val twos = $$ : int stream! susp
- stream_take(interleave(ones, twos), 10);
val it = [1,2,1,2,1,2,1,2,1,2] : int list

ones は 1 を無限に出力するストリームで、twos は 2 を無限に出力するストリームです。stream_append で ones と twos を結合しても無限に 1 を出力するだけですが、interleave で ones と twos を結合すれば、1 と 2 を交互に出力することができます。これで無限ストリームの要素を混ぜ合わせることができます。

●高階関数 (2)

2 つのストリームを受け取るマップ関数 stream_map2 も簡単です。プログラムは次のようになります。

リスト : マップ関数

fun lazy stream_map2 _ Nils _ = Nils
|        stream_map2 _ _ Nils = Nils
|        stream_map2 f (Cons(x, t1)) (Cons(y, t2)) =
         Cons(f(x, y), stream_map2 f t1 t2)

ストリーム s1 と s2 から要素 x, y を取り出し、f(x, y) の評価結果を新しいストリームに格納します。stream_map2 の型は次のようになります。

val stream_map2 = fn : ('a * 'b -> 'c) -> 'a stream -> 'b stream -> 'c stream! susp
val stream_map2_ = fn : ('a * 'b -> 'c) -> 'a stream -> 'b stream -> 'c stream!

stream_map2 を使うと、ストリームに対していろいろな処理を定義することができます。次の例を見てください。

- fun lazy add_stream(s1, s2) = stream_map2 (op +) s1 s2;
val add_stream = fn : int stream * int stream -> int stream! susp
val add_stream_ = fn : int stream * int stream -> int stream!
- val s1 = range(1, 4);
val s1 = $$ : int stream! susp
- val s2 = range(11, 14);
val s2 = $$ : int stream! susp
- val s5 = add_stream(s1, s2);
val s5 = $$ : int stream! susp
- stream_take(s5, 4);
val it = [12,14,16,18] : int list

add_stream は s1 と s2 の要素を加算したストリームを返します。この add_stream を使うと、整数を生成するストリームは次のように定義することができます。

- val rec lazy ints = Cons(1, add_stream(ones, ints));
val ints = $$ : int stream! susp
- stream_take(ints, 10);
val it = [1,2,3,4,5,6,7,8,9,10] : int list

ストリーム ints は、現在の ints に 1 を足し算することで整数を生成しています。これで整数が生成できるとは不思議ですね。ints の動作を図に示すと、次のようになります。

val rec lazy ones = Cons(1, ones)
                  = Cons(1, lazy_obj1)

val rec lazy ints = Cons(1, add_stream(ones. ints))
                  = Cons(1, lazy_obj2)

lazy_obj2 => Cons(1, lazy_obj1), Cons(1, lazy_obj2)
          => Cons(1+1, add_stream(lazy_obj1, lazy_obj2))
          => Cons(2, lazy_obj3)

lazy_obj3 => Cons(1, lazy_obj1), Cons(2, lazy_obj3)
          => Cons(3, add_stream(lazy_obj1, lazy_obj3))
          => Cons(3, lazy_obj4)


        図 : ストリーム ints の動作

ones を Cons(1, lazy_obj1) と表し、ints を Cons(1, lazy_obj2) と表します。lazy_obj は遅延オブジェクトを表します。ints で次の要素を生成するとき、lazy_obj2 が評価されます。すると、add_stream (stream_map2) に ones と ints が適用され、ストリームの要素 2 と遅延オブジェクト lazy_obj3 が生成されます。このとき、lazy_obj3 の内容は add_stream(lazy_obj1, lazy_obj2) になります。

次の要素を生成するときは、lazy_obj3 を評価します。lazy_obj1 は Cons(1, lazy_obj1) に、lazy_obj2 は Cons(2, lazy_obj3) に評価されるので、ストリームの要素は 1 + 2 = 3 になり、遅延オブジェクト lazy_obj4 の内容は add_stream(lazy_obj1, lazy_obj3) になります。そして、この遅延オブジェクトを評価することで次の要素を求めることができます。

このように、遅延オブジェクトの中に現時点の整数を保持しておき、そこに 1 を足し算することで整数列を生成しているわけです。ここで、遅延オブジェクトは評価結果をキャッシュしているので、整数 n の次の値を簡単に計算できることに注意してください。もしも、遅延オブジェクトを単純なクロージャで実装した場合、整数 n を求めるため再計算が行われるので、効率はとても悪くなります。

同様の方法でフィボナッチ数列を生成するストリームを定義することができます。

リスト : フィボナッチ数列の生成

val rec lazy fibs = Cons(0, Cons(1, add_stream(stream_tail fibs, fibs)))
val fibs = $$ : int stream! susp

fibs が現在のフィボナッチ数列を表していて、stream_tail fibs で次の要素を求めます。そして、それらを足し算することで、その次の要素を求めています。この場合、ストリームの初期値として 2 つの要素が必要になることに注意してください。

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

- stream_take(fibs, 10);
val it = [0,1,1,2,3,5,8,13,21,34] : int list

このように、2 つのストリームを使ってフィボナッチ数列を生成することができます。

●組 (pair) を生成するストリーム

それでは簡単な例題として、2 つのストリームからその要素の組み合わせを生成するストリームを作りましょう。要素が n 個のストリームの場合、組み合わせは n * n 個あります。次の図を見てください。

(a0, b0) (a0, b1) (a0, b2) ... (a0, bn)
(a1, b0) (a1, b1) (a1, b2) ... (a1, bn)
(a2, b0) (a2, b1) (a2, b2) ... (a2, bn)

                           ...

(an, b0) (an, b1) (an, b2) ... (an, bn)


        図 : n * n 個の組

この組み合わせを生成するストリームは簡単にプログラムできるように思います。次のリストを見てください。

リスト : 組を生成するストリーム

fun lazy pair_stream(Nils, _) = Nils
|        pair_stream(Cons(x, t1), s2) =
         stream_append(stream_map (fn(z) => (x, z)) s2, pair_stream(t1, s2))

関数 pair_stream はストリーム s1 と s2 の要素の組を出力します。最初に、s1 の要素 x を取り出して、stream_map で x と s2 の要素の組を生成します。それを stream_append で出力してから、pair_stream を再帰呼び出しして s1 の次の要素と s2 の組を求めます。pair_stream には lazy の指定があるので、stream_append の第 2 引数で pair_stream を呼び出すとき、遅延評価が行われるため正常に動作します。lazy の指定を外すと遅延ストリームとして正常に動作しません。ご注意ください。

pair_stream の型は次のようになります。

val pair_stream = fn : 'a stream! susp * 'b stream -> ('a * 'b) stream! susp
val pair_stream_ = fn : 'a stream! susp * 'b stream -> ('a * 'b) stream!

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

- val s1 = range(1, 4);
val s1 = $$ : int stream! susp
- val s2 = range(11, 14);
val s2 = $$ : int stream! susp
- val s3 = pair_stream(s1, s2);
val s3 = $$ : (int * int) stream! susp
- stream_take(s3, 16);
val it =
  [(1,11),(1,12),(1,13),(1,14),(2,11),(2,12),(2,13),(2,14),(3,11),(3,12),
   (3,13),(3,14),(4,11),(4,12),(4,13),(4,14)] : (int * int) list

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

●無限ストリームで組 (pair) を生成する場合

ところで、pair_stream は無限ストリームに対応していません。実際、引数 s2 に無限ストリームを渡した場合、引数 s1 の最初の要素を a0 とすると (a0, s2 の要素) という組しか生成されません。そこで、図 3 に示すように、対角線上に組を生成していくことにします。

   | a0  a1  a2  a3  a4  a5
---+-----------------------------
b0 | 1   2   4   7   11  16  ...
   |
b1 | 3   5   8   12  17  ...
   |
b2 | 6   9   13  18  ...
   |
b3 | 10  14  19  ...
   |
b4 | 15  20  ...
   |
b5 | 21 ...
   |
   | ...
   |

図 : 無限ストリームによる組の生成

図を見ればおわかりのように、対角線の要素数を n とすると、組は (an-1, b0), (an-2, b1), ..., (a1, bn-2), (a0, bn-1) となっています。これは、s1 から n 個の要素を取り出したリストと、s2 から n 個の要素を取り出して反転したリストを、zip で要素をタプルにまとめた形になっています。これをプログラムすると次のようになります。

リスト : 無限ストリームによる組の生成

(* リストの要素をタプルにまとめる *)
fun zip(x::xs, y::ys) = (x, y) :: zip(xs, ys)
|   zip(_, _) = []

(* リストをストリームに変換 *)
fun lazy stream_of_list([]) = Nils
|        stream_of_list(x::xs) = Cons(x, stream_of_list(xs))

(* 組の生成 *)
fun lazy pair_stream2(s1, s2) =
    let
      fun lazy iter n =
          stream_append(stream_of_list(zip(stream_take(s1, n),
                                           rev (stream_take(s2, n)))),
                        iter (n + 1))
    in
      iter(1)
    end
val zip = fn : 'a list * 'b list -> ('a * 'b) list
val stream_of_list = fn : 'a list -> 'a stream! susp
val stream_of_list_ = fn : 'a list -> 'a stream!
val pair_stream2 = fn : 'a stream! susp * 'b stream -> ('a * 'b) stream! susp
val pair_stream2_ = fn : 'a stream! susp * 'b stream -> ('a * 'b) stream!

関数 stream_of_list は引数のリストをストリームに変換します。実際の処理は局所関数 iter で行っています。引数 n が対角線上の要素数を表します。

stream_take で s1 と s2 から要素を取り出し、s2 から取り出したリストを rev で反転してから関数 zip で要素をタプルに格納します。結果はリストになるので、stream_of_list で遅延ストリームに変換します。そして、そのストリームと再帰呼び出しした iter の返り値を stream_append で連結します。これで組を対角線上の順番で生成することができます。

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

- val s = pair_stream2(ints, ints);
val s = $$ : (int * int) stream! susp
- stream_take(s, 10);
val it = [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]
  : (int * int) list
- stream_ref(s, 10);
val it = (4,1) : int * int
- stream_ref(s, 20);
val it = (5,2) : int * int

●素数の生成

次はストリームを使って素数を求めるプログラムを作ってみましょう。考え方は簡単です。最初に、2 から始まる整数列を生成するストリームを用意します。2 は素数なので、素数ストリームの要素になります。

次に、この整数列から 2 で割り切れる整数を取り除き除きます。これは stream_filter を使うと簡単です。2 で割り切れる整数が取り除かれたので、次の要素は 3 になります。今度は 3 で割り切れる整数を取り除けばいいのです。

これも stream_filter を使えば簡単です。このとき、入力用のストリームは 2 で割り切れる整数が取り除かれています。したがって、このストリームに対して 3 で割り切れる整数を取り除くように stream_filter を設定すればいいわけです。

このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩」といいます。ようするに、2 から始まる整数ストリームに対して、見つけた素数 2, 3, 5, 7, 11, ... を順番に stream_fiter で設定して素数でない整数をふるい落としていくわけです。

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

リスト : 素数の生成

fun lazy sieve(Nils) = raise Empty_stream
|        sieve(Cons(x, tail)) =
         Cons(x, sieve(stream_filter (fn(a) => a mod x <> 0) tail))
val sieve = fn : int stream! susp -> int stream! susp
val sieve_ = fn : int stream! susp -> int stream!

sieve には 2 から始まる整数列を生成するストリームを渡します。Cons の遅延オブジェクトを評価すると、stream_filter により整数列から 2 で割り切れる整数を取り除いたストリームが返されます。次の要素 3 を取り出すとき、このストリームに対して 3 で割り切れる整数を取り除くことになるので、2 と 3 で割り切れる整数が取り除かれることになります。次の要素は 5 になりますが、そのストリームからさらに 5 で割り切れる整数が stream_filter で取り除かれることになります。

このように stream_filter が設定されていくことで、素数でない整数をふるい落としていくことができるわけです。それでは実行してみましょう。

- val s = sieve(range(2, 1000));
val s = $$ : int stream! susp
- stream_take(s, 25);
val it = [2,3,5,7,11,13,17,19,23,29,31,37,...] : int list

- stream_take(sieve(stream_tail(ints)), 10);
val it = [2,3,5,7,11,13,17,19,23,29] : int list

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

●高速化

関数 sieve は簡単にプログラムできますが、生成する素数の個数が多くなると、その実行速度はかなり遅くなります。実をいうと、sieve なみに簡単で sieve よりも高速な方法があります。

整数 n が素数か確かめる簡単な方法は、√n 以下の素数で割り切れるか試してみることです。割り切れる素数 m があれば、n は素数ではありません。そうでなければ、n は素数であることがわかります。

これをそのままプログラムすると次のようになります。

リスト : 素数列の生成

(* 素数のチェック *)
fun checkPrime n xs =
    let
      val x = stream_head xs
    in
      if x * x > n then true
      else if n mod x = 0 then false
      else checkPrime n (stream_tail xs)
    end

(* 素数の生成 *)
fun lazy primes_from n xs =
    if checkPrime n xs
    then Cons(n, primes_from (n + 2) xs)
    else primes_from (n + 2) xs

(* 素数列 *)
val rec lazy primes = Cons(2, Cons(3, Cons(5, primes_from 7 primes)))

変数 primes は無限の素数列を表します。実際に素数を生成する処理は関数 primes_from で行います。primes_from は関数 checkPrime を呼び出して n が素数かチェックします。primes_from を呼び出すときは素数列 primes を渡すことに注意してください。そうであれば、Cons で n を遅延ストリームに追加します。そうでなければ primes_from を再帰呼び出しするだけです。偶数は素数ではないので、引数 n には奇数を与えていることに注意してください。

checkPrime も簡単です。xs (素数列 primes) から √n 以下の素数列を取り出します。√n 以下の素数は生成済みなので、xs から stream_head で順番に取り出すことが可能です。ここでは√n のかわりに条件を x * x > n とし、その場合は ture を返します。素数 x で割り切れる場合は false を返します。それ以外の場合は次の素数を調べます。

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

- stream_take(primes, 25);
val it = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,...] : int list
- stream_ref(primes, 25);
val it = 97 : int
- stream_ref(primes, 100);
val it = 541 : int
- stream_ref(primes, 200);
val it = 1223 : int

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

実行時間ですが、stream_ref で 5000 番目の素数を求めてみました。

sieve  : 1.968 秒
primes : 0.015 秒

実行環境 : Windows 10, Intel Core i5-6200U 2.30GHz, SML/NJ ver 110.98

sieve よりも primes のほうが高速になりました。興味のある方はいろいろ試してみてください。

-- 参考 URL --------
今回のプログラムは Gauche ユーザリファレンス: 6.18 遅延評価 を参考にさせていただきました。Shiro Kawai さんに感謝いたします。

●順列の生成

次は遅延ストリームを使って順列を生成するプログラムを作ってみましょう。遅延ストリームを使う場合、再帰呼び出しの一番深いところで順列が完成するようにプログラムするとうまくいきません。要素が n 個の順列を生成する場合、n - 1 個の順列を生成するストリームを生成し、そこに要素を一つ加えて n 個の順列を生成すると考えます。

まずは簡単な例として、遅延ストリームではなく、リストを使ってプログラムを作ってみます。次のリストを見てください。

リスト : 順列の生成

(* 要素を取り除く *)
fun remove(x, ls) = List.filter (fn y => x <> y) ls

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

(* map f ls の結果を平坦化する *)
fun flatmap f ls = flatten (map f ls)

(* 順列の生成 *)
fun perm(0, _) = [[]]
|   perm(n, ls) =
    flatmap (fn x => map (fn y => x :: y) (perm(n - 1, remove(x, ls)))) ls

関数 perm は引数のリスト ls から n 個を選ぶ順列を生成し、それをリストに格納して返します。n = 0 が再帰の停止条件で、空リストを格納したリストを返します。このリストに対して要素を追加します。この処理は map を二重に使うと簡単に実現できそうです。次の例を見てください。

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

リストの各要素に 5 を追加したい場合、map を使うと簡単ですね。次は、リスト [5, 6] の各要素を追加したリストを求めることを考えます。map を二重にして、[5, 6] の要素を匿名関数の引数 y に渡します。次の map で y をリストに追加します。すると、返り値のリストの型は int list list list になります。map を二重にしているので、リストの階層が 1 段深くなるわけです。

そこで、リストのリストを平坦化する関数 flatten を使います。プログラムは簡単です。リストの先頭要素 x を取り出して、x と次の要素を @ で結合すればいいわけです。たとえば、flatten [[1], [2], [3]] は [1] と [2] と [3] を @ で結合するので、[1, 2, 3] になります。flatten のデータ型は次のようになります。

val flatten = fn : 'a list list -> 'a list

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

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

実際のプログラムでは flatten と map を組み合わせた関数 flatmap を定義しておくと便利です。

関数 perm の説明に戻ります。匿名関数の中で perm を再帰呼び出しをして、n - 1 個を選ぶ順列を生成します。そして、その返り値にリスト ls の要素 x を追加すれば、n 個の順列を生成することができます。

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

- perm(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

●遅延ストリーム版

それでは、遅延ストリームを使ったプログラムを作ります。

リスト : 遅延ストリームによる順列の生成

(* ストリームの平坦化 *)
fun lazy stream_flatten(Nils) = Nils
|        stream_flatten(Cons(head, tail)) =
         stream_append(head, stream_flatten(tail))

(* stream_map の結果を平坦化する *)
fun lazy stream_flatmap proc s = stream_flatten(stream_map proc s)

(* 順列の生成 *)
fun lazy make_perm(0, _) = Cons([], Nils)
|        make_perm(n, s) =
         stream_flatmap (fn x => stream_map (fn y => x::y) (make_perm(n - 1, stream_filter (fn z => z <> x) s))) s
val stream_flatten = fn : 'a stream! susp stream! susp -> 'a stream! susp
val stream_flatten_ = fn : 'a stream! susp stream! susp -> 'a stream!
val stream_flatmap = fn : ('a -> 'b stream! susp) -> 'a stream -> 'b stream! susp
val stream_flatmap_ = fn : ('a -> 'b stream! susp) -> 'a stream -> 'b stream!
val make_perm = fn : int * ''a stream -> ''a list stream! susp
val make_perm_ = fn : int * ''a stream -> ''a list stream!

flatten のかわりに stream_flatten を、flatmap のかわりに stream_flatmap を用意します。stream_map を二重に使うので、ストリームの中にストリームが格納されます。これを平坦化するために stream_flatten を使います。stream_flatten はストリームの先頭要素 head を取り出し、stream_apeend で head のストリームと残りのストリームを結合します。

関数 make_perm はストリーム s の中から要素を n 個選ぶ順列を生成します。n = 0 の場合は空リストを格納したストリームを返します。あとは、stream_flatmap の匿名関数の中で、make_perm を再帰呼び出しして n - 1 個を選ぶ順列を生成します。ストリーム s から要素 x を取り除くため、stream_filter を使っています。これで順列を生成するストリームを作ることができます。

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

- val s = make_perm(3, range(1, 3));
val s = $$ : int list stream! susp
- stream_take(s, 6);
val it = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]] : int list list

6 通りの順列をすべて求めることができました。

●8クイーンの解法

同様に、遅延ストリームを使って 8 クイーンを解くことができます。

リスト : 8 クイーンの解法 (遅延ストリーム版)

fun attack(x, xs) =
    let
      fun attack_sub(x, n, []) = true
      |   attack_sub(x, n, y::ys) =
          if x = y + n orelse x = y - n then false
          else attack_sub(x, n + 1, ys)
    in
      attack_sub(x, 1, xs)
    end

fun lazy queen(Nils) = Cons([], Nils)
|        queen(s) =
         stream_filter
           (fn [] => true | (x::xs) => attack(x, xs))
           (stream_flatmap (fn x => stream_map (fn y => x::y) (queen(stream_filter (fn z => z <> x) s))) s)
val attack = fn : int * int list -> bool
val queen = fn : int stream! susp -> int list stream! susp
val queen_ = fn : int stream! susp -> int list stream!

関数 queen は make_perm とほぼ同じですが、stream_filter を使って追加したクイーンが他のクイーンと衝突しているものを取り除いています。衝突をチェックする関数 attack は バックトラック法 で作成したものと同じです。

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

- stream_take(queen(range(1, 8)), 10);
val it =
  [[1,5,8,6,3,7,2,4],[1,6,8,3,7,4,2,5],[1,7,4,6,8,2,5,3],[1,7,5,8,2,4,6,3],
   [2,4,6,8,3,1,7,5],[2,5,7,1,3,8,6,4],[2,5,7,4,1,8,6,3],[2,6,1,7,4,8,3,5],
   [2,6,8,3,1,4,7,5],[2,7,3,6,8,5,1,4]] : int list list

解の総数は全部で 92 通りあります。遅延ストリームを使うと、必要な分だけの計算しか行われないので効率的です。

●参考文献


●プログラムリスト

(*
 * lazy.sml : lazy を使った遅延ストリーム
 *
 *            Copyright (C) 2012-2021 Makoto Hiroi
 *
 *)

(*
 * lazy keyword を有効にする
 * コマンドラインから入力してもよい
 * sml -Cparser.lazy-keyword=true
 *)
Control.lazysml := true;
open Lazy

(* 遅延オブジェクトを評価する *)
fun force ($ x) = x

(* 例外 *)
exception Empty_stream

(* 遅延ストリームの定義 *)
datatype lazy 'a stream = Nils | Cons of 'a * 'a stream

(* アクセス関数 *)
fun stream_head (Cons(x, _)) = x
|   stream_head Nils = raise Empty_stream

fun lazy stream_tail (Cons(_, s)) = s
|        stream_tail Nils = raise Empty_stream

(* 整数列の生成 *)
fun lazy range(low, high) =
    if low > high then Nils else Cons (low, range(low + 1, high))

(* フィボナッチ数列の生成 *)
fun lazy fibo(a, b) = Cons(a, fibo(b, a + b))

(* n 番目の要素を取り出す *)
fun stream_ref(Nils, _) = raise Empty_stream
|   stream_ref(Cons(x, _), 1) = x
|   stream_ref(Cons(_, tail), n) = stream_ref(tail, n - 1)

(* n 個の要素を取り出す *)
fun stream_take(Nils, _) = raise Empty_stream
|   stream_take(Cons(x, _), 1) = [x]
|   stream_take(Cons(x, tail), n) = x :: stream_take(tail, n - 1)

(* 高階関数 *)
(* マッピング *)
fun lazy stream_map _ Nils = Nils
|        stream_map proc (Cons(x, tail)) =
         Cons (proc x, stream_map proc tail)

(* フィルター *)
fun lazy stream_filter _ Nils = Nils
|        stream_filter pred (Cons(x, tail)) =
         if pred x then Cons(x, stream_filter pred tail)
         else stream_filter pred tail

(* 畳み込み *)
fun stream_foldl _ a Nils = a
|   stream_foldl proc a (Cons(x, tail)) =
    stream_foldl proc (proc(x, a)) tail

fun stream_foldr _ a Nils = a
|   stream_foldr proc a (Cons(x, tail)) =
    proc(x, stream_foldr proc a tail)

(* ストリームの結合 *)
fun lazy stream_append(Nils, s2) = s2
|        stream_append(Cons(x, tail), s2) = Cons(x, stream_append(tail, s2))

(* ストリームの要素を交互に出力 *)
fun lazy interleave(Nils, s2) = s2
|        interleave(Cons(x, tail), s2) = Cons(x, interleave(s2, tail))

(* 2ストリームのマッピング *)
fun lazy stream_map2 _ Nils _ = Nils
|        stream_map2 _ _ Nils = Nils
|        stream_map2 f (Cons(x, t1)) (Cons(y, t2)) =
         Cons(f(x, y), stream_map2 f t1 t2)

(* ストリームの加算 *)
fun lazy add_stream(s1, s2) = stream_map2 (op +) s1 s2

(* フィボナッチ数列 *)
val rec lazy fibs = Cons(1, Cons(1, add_stream(stream_tail fibs, fibs)))

(* 組を生成するストリーム *)
fun lazy pair_stream(Nils, _) = Nils
|        pair_stream(Cons(x, t1), s2) =
         stream_append(stream_map (fn(z) => (x, z)) s2, pair_stream(t1, s2))

(* リストの要素をタプルにまとめる *)
fun zip(x::xs, y::ys) = (x, y) :: zip(xs, ys)
|   zip(_, _) = []

(* リストをストリームに変換 *)
fun lazy stream_of_list([]) = Nils
|        stream_of_list(x::xs) = Cons(x, stream_of_list(xs))

(* 組の生成 *)
fun lazy pair_stream2(s1, s2) =
    let
      fun lazy iter n =
          stream_append(stream_of_list(zip(stream_take(s1, n),
                                           rev (stream_take(s2, n)))),
                        iter (n + 1))
    in
      iter(1)
    end

(* 素数の生成 *)
fun lazy sieve(Nils) = raise Empty_stream
|        sieve(Cons(x, tail)) =
         Cons(x, sieve(stream_filter (fn(a) => a mod x <> 0) tail))

(* 高速版 *)
(* 素数のチェック *)
fun checkPrime n xs =
    let
      val x = stream_head xs
    in
      if x * x > n then true
      else if n mod x = 0 then false
      else checkPrime n (stream_tail xs)
    end

(* 素数の生成 *)
fun lazy primes_from n xs =
    if checkPrime n xs
    then Cons(n, primes_from (n + 2) xs)
    else primes_from (n + 2) xs

(* 素数列 *)
val rec lazy primes = Cons(2, Cons(3, Cons(5, primes_from 7 primes)))

(* x を削除する *)
fun remove(x, ls) = List.filter (fn y => x <> y) ls

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

(* map f ls の結果を平坦化する *)
fun flatmap f ls = flatten (map f ls)

(* 順列の生成 *)
fun perm(0, _) = [[]]
|   perm(n, ls) =
    flatmap (fn x => map (fn y => x :: y) (perm(n - 1, remove(x, ls)))) ls

(* 遅延ストリーム版 *)
fun lazy stream_flatten(Nils) = Nils
|        stream_flatten(Cons(head, tail)) =
         stream_append(head, stream_flatten(tail))

(* stream_map の結果を平坦化する *)
fun lazy stream_flatmap proc s = stream_flatten(stream_map proc s)

(* 順列の生成 *)
fun lazy make_perm(0, _) = Cons([], Nils)
|        make_perm(n, s) =
         stream_flatmap (fn x => stream_map (fn y => x::y) (make_perm(n - 1, stream_filter (fn z => z <> x) s))) s

(* 8 クイーンの解法 *)
fun attack(x, xs) =
    let
      fun attack_sub(x, n, []) = true
      |   attack_sub(x, n, y::ys) =
          if x = y + n orelse x = y - n then false
          else attack_sub(x, n + 1, ys)
    in
      attack_sub(x, 1, xs)
    end

fun lazy queen(Nils) = Cons([], Nils)
|        queen(s) =
         stream_filter (fn [] => true | (x::xs) => attack(x, xs))
                       (stream_flatmap (fn x => stream_map (fn y => x::y) (queen(stream_filter (fn z => z <> x) s))) s)

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

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

[ PrevPage | SML/NJ | NextPage ]