newLISP で On Lisp する...第22章(その4)

(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsponnewlisp.lsp に定義してあります。)

 今回で、第22章 非決定性 は、終わりです。
 真の非決定性 の 最初は、決定的な検索 のスクリプト。

(define (path node1 node2)
  (bf-path node2 (list (list node1))))

(define (bf-path dest queue)
  (if (null? queue)
      '@
      (letn ((path (first queue))
             (node (first path)))
        (if (= node dest)
            (reverse path)
            (bf-path dest
                     (append (rest queue)
                             (map (lambda (n)
                                    (cons n path))
                                  (neighbors node))))))))

(define (neighbors node)
   (map (curry nth 1) (find-all (list node '?) '((a b) (b c) (c a) (a d) (d e)))))

 関数neighbors は、“On Lisp”本書では、定義されていないのですが、ループのある有向グラフ から類推で作りました。
 引数のnode から行ける先をリストで返します。本章(その1)で定義している関数kids を使って、(defun は、newlisp-utility.lsp に定義してあります)

(defun kids (n)
    (case n
      (a '(b d))
      (b '(c))
      (c '(a))
      (d '(e))))

 としても、同じです。どちらを使うかは、お好みで。ただし、kids を使う場合は、neighbors に関数名を変更することをお忘れなく(笑)。
 動作させると、

> (path 'a 'e)
(a d e)
> (path 'a 'c)
(a b c)
> 

 “On Lisp”本書に動作例がないので比較できませんが、こんなところでしょう。
 さて、上記関数kids で、これまでの 非決定的な検索 を行うと、間違いなく a → b → c → a でループします。
 そのために、Scheme による真の choose が必要となります。
 しかし、残念ながら、“On Lisp”本書には、Common Lisp の実装例は載っていません。
 なので、割愛? いえいえ、そんなことは、ありません(笑)。
 本章(その1)で定義した非決定的オペレータ・マクロ choose-bind で、変更が必要なのは、中で使っている補助関数cb のみです。
 (mklist は、newlisp-utility.lsp に定義してあります)

(define *paths* '())
(define failsym '@)

(define-macro (choose-bind)
; (choose-bind var choices &body body)
  (letex (_var (args 0)
          _choices (args 1)
          _body (cons 'begin (2 (args))))
    (cb (fn (_var) _body) _choices)))

(defun cb (f choices)
  (let (chlist (mklist choices))
    (dolist (ch chlist)
      (letex (_f f _ch ch)
        (push (fn () (_f '_ch)) *paths* -1))))
    (fail))

 これを使って、先ほどの関数kids と本章(その2)で定義した、(=defun と =values は onnewlisp.lsp に定義してあります)

(defun descent (n1 n2)
  (letex (_n1 n1 _n2 n2) 
    (descent-tr '_n1 '_n2 '())))

(=defun descent-tr (n1 n2 res)
    (cond ((= n1 n2) (=values (push n2 res -1)))
          ((kids n1) (letex (_n1 n1)
                       (choose-bind n (kids '_n1)
                           (descent-tr n n2 (push '_n1 res -1)))))
          (true (fail))))

 で実行すると、

> (descent 'a 'c)
(a b c)
> (fail)
@
> (descent 'a 'e)
(a d e)
> 

 無限ループに陥らず、解が出ます。
 ただし、場合によっては、(fail) で、終了シンボル@ にたどり着きません。
 例えば、上記の例に続けて、(fail) を実行すると、

> *paths*
((lambda () ((lambda (n) 
    (begin 
     (letex (_n n) (descent-tr '_n 'e (push 'c '(a b) -1))))) 'a)))
> (fail)
(a b c a d e)
> (fail)
(a b c a b c a d e)
> 

 解としては間違っていないけど、(a d c) の繰り返しが、追加されていくだけ(笑)。
 こういう時、クロージャが全て見える newLISP は、重宝します。何が起こっているのか、一目瞭然です。
 試してはいませんが、“On Lisp”本書にある Scheme による真のchoose でも、同じようになると思うのですが、如何でしょうか?
 “On Lisp” 本書にもあるように、“元の実装で大抵は、十分だ。” ということで、真の非決定性 は、このあたりで終わります。

 さて、番外編から始まった 第22章 非決定性、ようやく、まとめです。

  • newLISPでも、継続渡しを使った非決定性を実装できます。
    しかし、継続 の時と同様に、Common Lispでの実装よりも制限が多くなります。

 以上、如何でしょうか?

広告

No comments yet

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中

%d人のブロガーが「いいね」をつけました。