めざそう言語処理系の沼 〜shift/resetへの旅 〜 その１８ shift/resetでつくるListモナド

前回のMaybeモナドに続いて、非決定性を扱うためのListモナドをつくってみたい。

非決定性の説明に関してはSICPを参照してほしい：

sicp.iijlab.net

前回と同じくreifyとreflect（実装内容は違うが）、そして今回新たにreturnを実装していく。

さらにreflectに使うためにmapとmergeも定義する。

まずmap：

(letrec [map [f xs acc]
           (if (nil? xs) acc
             (map f (cdr xs) (cons (f (car xs)) acc)))]
  ...)

関数型では非常に一般的なmap関数。末尾再帰型にするためにアキュミュレータ引数が追加されている。本来ならこの再帰関数をラップした(letfn [map2 [f xs] (map f xs nil)])のような関数を用意したくなるが、今回mapはreflect内でしか使わないのでこのままにしておく。あとアキュミュレータを使っているのに結果をリバースしないので要素が逆順になる、が今回はあまり関係ないので無視。

次にmerge：

(letrec [merge [xss acc]
           (cond
             [(nil? xss) acc]
             [(nil? (car xss)) (merge (cdr xss) acc)]
             [true (merge
                     (cons (cdr (car xss)) (cdr xss))
                     (cons (car (car xss)) acc))])]
  ...)

concatとかflattenなどとも呼ばれる「リストのリスト」をリストに変換する関数。ここでもアキュミュレータがむき出しになっているのと最後にアキュミュレータをリバースしないので要素が逆順になる。

mapやmergeは本来builtinではないにしろ（kontlangを使って定義できるため）、stdlib的なもので用意したくなる。近いうちに追加するかも。

reifyは前回と同じく、resetを隠蔽するマクロなだけ：

(let [reify (macro [expr] (reset expr))]
 ...)

それに対してreflectは前回とかなり違う：

(let [reflect (fn [m]
        (shift [k]
          (merge (map k m nil) nil)))]
  ...)

リストmを受け取り、map k mでその要素すべてを順に限定継続kに渡して、返ってくるリストをmergeしている。

ちなみにMaybeモナドの場合のreflectは：

(let [reflect (fn [m]
        (shift [k]
          (if (nil? m) m (k m))))]
  ...)

だった。reflectに各モナド特有のロジックが表れやすいようだ。

return:

(let [return list]
  ...)

Listモナドの場合、returnは値を単一要素のリストに変換するだけなので横着してlet [return list]としている。

組み合わせて使ってみる：

(reify
  (let [(x (reflect (list 1 2 3)))
        (y (reflect (list 4 5 6)))]
    (return (list x y))))

このプログラムだとなんの条件もつけていないので結果は

((1 6) (1 5) (1 4) (2 6) (2 5) (2 4) (3 6) (3 5) (3 4))

と、(1 2 3)と(4 5 6)の要素の組み合わせすべてとなる。

ここに条件を入れてやることでバックトラックつきの探索を行わせることができる。

例えば「shift/resetプログラミング入門」の例題にもなっている、ピタゴラスの定理に出てくる等式x^2 + y^2 = z^2を満たす１〜５の自然数の組み合わせを探索するプログラム：

(reify
  (let [(x (reflect (list 1 2 3 4 5)))
        (y (reflect (list 1 2 3 4 5)))
        (z (reflect (list 1 2 3 4 5)))]
    (if (= (* z z)
           (+ (* x x)
              (* y y)))
      (return (list x y z))
      nil)))

これは結果が

((3 4 5) (4 3 5))

となる。バックトラックのロジックはreify、reflectとreturnに隠蔽されて、letやifで直線的なコードを書くだけで非決定性プログラミングができるのがうれしいところ。

ちなみに今回の「ピタゴラスの定理」プログラムの全容：

(letrec [(map [f xs acc]
           (if (nil? xs) acc
             (map f (cdr xs) (cons (f (car xs)) acc))))
         (merge [xss acc]
           (cond
             [(nil? xss) acc]
             [(nil? (car xss)) (merge (cdr xss) acc)]
             [true (merge
                     (cons (cdr (car xss)) (cdr xss))
                     (cons (car (car xss)) acc))]))]
  (let [(reify (macro [expr] (reset expr)))
        (reflect (fn [m]
          (shift [k]
            (merge (map k m nil) nil))))
        (return list)]
    (reify
      (let [(x (reflect (list 1 2 3 4 5)))
            (y (reflect (list 1 2 3 4 5)))
            (z (reflect (list 1 2 3 4 5)))]
        (if (= (* z z)
               (+ (* x x)
                  (* y y)))
          (return (list x y z))
          nil)))))

次回はStateモナドを実装してみる。