newLISP で On Lisp する．．．第２２章（その４）

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

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

(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 から行ける先をリストで返します。本章（その１）で定義している関数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 の実装例は載っていません。
　なので、割愛？ いえいえ、そんなことは、ありません（笑）。
　本章（その１）で定義した非決定的オペレータ・マクロ 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 と本章（その２）で定義した、（=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” 本書にもあるように、“元の実装で大抵は、十分だ。” ということで、真の非決定性 は、このあたりで終わります。

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

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

　以上、如何でしょうか？

newLISP で On Lisp する．．．第２２章（その１）

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

　番外編から始まった 第２２章 非決定性 の本体の始まりです（笑）。

　最初の 概念 は飛ばして、探索 から。
　まずは手慣らしに、決定的なツリーによる探索 の 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))

　変数ｘ をすべて展開して組み込みますから、“On Lisp” 本書例より複雑になります（汗）。
　動作は、

> [cmd]
(let (x 2)
  (letex (_x x)
  (choose
    (+ _x 1)
    (+ _x 100))))
[/cmd]
3
> (fail)
102
> (fail)
@
> 

　同じですが。
　長くなってきたので、継続渡しマクロ と共に使った例は、次回に。

　以上、如何でしょうか？