Archive for the ‘choose-bind’ Tag
newLISP で On Lisp する...第22章(その4)
(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp と onnewlisp.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での実装よりも制限が多くなります。
以上、如何でしょうか?
newLISP で On Lisp する...第22章(その1)
(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp と onnewlisp.lsp に定義してあります。)
番外編から始まった 第22章 非決定性 の本体の始まりです(笑)。
最初の 概念 は飛ばして、探索 から。
まずは手慣らしに、決定的なツリーによる探索 の Schemeスクリプトを newLISP で記述すると、
(define (descent n1 n2)
(if (= n1 n2)
(list n2)
(let (p (try-paths (kids n1) n2))
(if p (cons n1 p) nil))))
(define (try-paths ns n2)
(if (null? ns)
nil
(or (descent (first ns) n2)
(try-paths (rest ns) n2))))
(define (kids n)
(case n
(a '(b c))
(b '(d e))
(c '(d f))
(f '(g))))
こんな感じです。ついでに、後で使う関数kids も定義しておきます。
当然動きます。
> (descent 'a 'g) (a c f g) >
もちろん本題は、非決定的なツリーによる検索 です。
newLISP には、Scheme のように call-with-current-continuation が無いので、次の Scheme での実装 を飛ばして、Common Lisp での実装 に入ります。
そして、Common Lisp による非決定的オペレータ を newLISP で実装します。
(defun は newlisp-utility.lsp に定義してあります)
(define *paths* '())
(define failsym '@)
(define-macro (choose)
; (choose &rest choices)
(letex (_choice (args 0)
_choices (args))
(if '_choices
(begin (map (fn (c) (letex (_c c) (push (fn () _c) *paths*)))
(reverse (rest '_choices)))
_choice)
(fail))))
(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)
(if choices
(progn
(if (cdr choices)
(letex (_f f _ch choices)
(push (fn () (cb _f (cdr '_ch)))
*paths*)))
(f (car choices)))
(fail)))
(defun fail ()
(if *paths*
((pop *paths*))
failsym))
さて、動作例を、まずは、choose から、
> (defun do2 (x) (choose (+ x 2) (* x 2) (pow x 2))) (lambda (x) (choose (+ x 2) (* x 2) (pow x 2))) > (do2 3) 5 > (fail) ERR: value expected in function * : x called from user defined function fail > (define *paths* '()) () > (defun do2 (x) (letex (_x x) (choose (+ _x 2) (* _x 2) (pow _x 2)))) (lambda (x) (letex (_x x) (choose (+ _x 2) (* _x 2) (pow _x 2)))) > (do2 3) 5 > (fail) 6 > (fail) 9 > (fail) @ >
番外編でも書きましたが、newLISP のダイナミック・スコープで、継続を行う時は、newLISP組込letex を使って変数をクロージャに組み込んでおく必要があります。
そうしないと、最初の関数do2 のように、fail を実行した時、エラーとなります。
そして、choose-bind の例。
> (choose-bind x '(marrakesh strasbourg vegas) (format "Let's go to %s." (string x))) "Let's go to marrakesh." > (fail) "Let's go to strasbourg." > (fail) "Let's go to vegas." > (fail) @ >
choose のマクロ展開例のスクリプトには、やはり、letex を使います。
(let (x 2)
(letex (_x x)
(choose
(+ _x 1)
(+ _x 100))))
例によって、展開式すると、
(if '((+ 2 1) (+ 2 100)) (begin (map (lambda (c) (letex (_c c) (push (lambda () _c) *paths*))) (reverse (rest '((+ 2 1) (+ 2 100))))) (+ 2 1)) (fail))
変数x をすべて展開して組み込みますから、“On Lisp” 本書例より複雑になります(汗)。
動作は、
> [cmd] (let (x 2) (letex (_x x) (choose (+ _x 1) (+ _x 100)))) [/cmd] 3 > (fail) 102 > (fail) @ >
同じですが。
長くなってきたので、継続渡しマクロ と共に使った例は、次回に。
以上、如何でしょうか?