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

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

　“問題が正しく定義できれば、半ば解けた同然である。” と言ったのは、アメリカの教育学者John Dewey氏。
　それはさておき、前回の関数descent は、うまく動作していませんが、バックトラックはうまくいっていることが判っています。
　ただ、全ての再帰の道筋が返ってきているだけ。つまり、関数descent が再帰した分だけ n1 が cons され、返ってくる。
　問題点がわかりました。つまり、必要な分だけ再帰で戻ってきてほしいのです。それが、解決方法。
　そこで考えました、末尾再帰を使えば良いのでは！
　（defun は newlisp-utility.lsp に、=defun と =values は onnewlisp.lsp に、kids と choose-bind は 本章（その１）に定義してあります）

(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-tr に引数として渡されます。
　こういう時、リストの末尾に追加できるnewLISP組込push が、便利です。

> (descent 'a 'g)
(a c f g)
> (fail)
@
> (descent 'a 'd)
(a b d)
> (fail)
(a c d)
> (fail)
@
> (descent 'a 'f)
(a c f)
> (fail)
@
> 

　うまくいきました！
　ま、でも、Common Lisp や Scheme で試していたら、“うまく言った” で終わって、進歩しなかったでしょうね。newLISP を選んで正解でした（笑）。
　また、前回書き忘れましたが、前の時と違って、“On Lisp”本書のように括弧が一個なのは、今回が多値対応だからです。
　
　さて、letex で渡している変数が、n1 だけですが、全てを記述すると、

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

　当然、このスクリプトでも動きます。
　と、いうより、こちらが本来の書き方かも（笑）。では、何故前述のスクリプトでも動くのか？
　このスクリプトで n2 は、最後まで変わりませんからね。
　ちなみに、入り口の関数descent は、

(defun descent (x y)
  (descent-tr x y ‘()))

　なら、letex は、いりません。変数 n1、n2 を 変数 x、y に変えてあるのがポイント。つまり、変数補足の問題です。
　これで、Common Lisp での実装 ならぬ newLISP による実装 が完成しました（笑）。

　カット からは、次回に。

　以上、如何でしょうか？

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

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

　さて、“On Lisp” 第20章の 継続渡しマクロ と共に使った例を（=defun、=values、=bind は onnewlisp.lsp に、choose-bind は 本章（その１）に定義してあります定義してあります）。

(=defun two-numbers ()
  (choose-bind n1 '(0 1 2 3 4 5)
    (letex (_n1 n1)
      (choose-bind n2 '(0 1 2 3 4 5)
        (=values '_n1 n2)))))

(=defun parlor-trick (sum)
  (=bind (n1 n2) (two-numbers)
    (if (= (+ n1 n2) sum)
        (list "the sum of" n1 n2)
      (fail))))

　これを実行すると、

> (parlor-trick 7)
("the sum of" 2 5)

　入れ子も出来ます。（multiple-value-list は onnewlisp.lsp に定義してあります）

> [cmd]
(multiple-value-list
  (choose-bind first-name '(henry william)
    (letex (_first-name first-name)
      (choose-bind last-name '(james higgins)
        (=values '_first-name last-name)))))
[/cmd]
(henry james)
> (multiple-value-list (fail))
(henry higgins)
> (multiple-value-list (fail))
(william james)
> (multiple-value-list (fail))
(william higgins)
> (multiple-value-list (fail))
(@)
> 

　letex を使うのが、お約束です。また、*cont* の初期値の values は、以前は、list で代用していましたが、今回は多値対応を使っています。ですから、multiple-value-list で受けないとリストになりません。
　ここまでは、順調でした。
　つまずいたのは、次のスクリプトdescent 。気分も急降下です（笑）。（kids は最初の方に、t は newlisp-utility.lsp に、kids は 本章（その１）に定義してありますに記述してあります。）

(=defun descent (n1 n2)
    (cond ((= n1 n2) (=values n2))
          ((kids n1) (letex (_n1 n1)
                       (choose-bind n (kids '_n1)
                         ;(println '_n1 " " n)
                         (=bind (p) (descent n n2)
                           (=values (cons '_n1 p))))))
          (t ;(println "fail")
             (fail))))

　これを実行すると、

> (descent 'a 'g)
(a b b a c c f g)
> 

　あれれ、余計なものが！
　コメント・アウトしてある println文を動作させてみると、その様子がわかります。

> (descent 'a 'g)
a b
b d
fail
b e
fail
a c
c d
fail
c f
f g
(a b b a c c f g)
> 

　バック・トラックは、うまくいっているのです。ただ、たどった道のりを全て返しているだけで（悲）。
　これは、ダイナミック･スコープによる変数補足を letex を使って回避した副作用なのです。

　そして、その解決方法は、、、次回に。

　以上、如何でしょうか？

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)
@
> 

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

　以上、如何でしょうか？