プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート

SICP 4.3.3 Implementing the Amb Evaluator

LISP Scheme

ここで漸く実装部分。

ノート

普通のschemeの式であれば値が返るか、永久に返って来ないか、エラーで止まる。非決定論的schemeではそれに加えて行き止まりに辿り着いた時に選択ポイントまで戻って評価をやり直すと言う動作が追加される。
バックトラックを実装するのに評価と実行が混ざっている状態では尚更難しい事になる。

Execution procedures and continuations

ここのexecution procedureはanalyzeが返した手続き。
元のanalyzeが返す手続きの引数は環境ひとつのみ。amb評価器では環境に加えて成功したときの継続、失敗したときの継続の二つを引数に取る。

『継続』と言ってもここではcall-with-current-continutionとかを使う訳ではない。引数として手続きを渡すだけ。

評価をする各手続きは必ずどちらかの継続を呼ぶ事が前提で、呼び出し元の手続きに戻る事は想定されていない。この実行モデルでバックトラックを実現する。

成功継続は、値と失敗継続を受け取る。この継続はそのまま評価を続けるが、その先で受け取った値が評価に失敗する事が分かった時には受け取った失敗継続を呼び出す。

失敗継続は選択肢から別の値を選び、受け取った成功継続を呼び出す。成功継続には新たに選んだ値、その値で評価が失敗した時の失敗継続を渡す。ここで渡す失敗継続はまた別の値を選んで成功継続を呼び出すクロージャ。

amb構文で選択肢が無くなった時に評価の失敗が起きる。ここで失敗継続が呼ばれるが、これは直近の選択ポイントで作られた失敗継続が呼ばれ、新たな選択肢を選び直す事になる。入力からtry-againとタイプされた時も同じ挙動。

副作用を持つ操作の評価では、その先で評価に失敗した時の為に副作用を元に戻す為の失敗継続が用意される。この失敗継続は副作用を元に戻した後、最初に呼ばれた時の失敗継続を呼び出す。

失敗継続が作られるのは以下の3つ

  1. amb構文
  2. REPL
  3. 代入構文

失敗継続が呼ばれるのは評価に失敗した時で以下の二つのケース

  1. 空のambが評価されたとき
  2. REPLでtry-againがタイプされたとき。

失敗継続が中継されるとき

  1. 代入構文が作った失敗継続が呼ばれたとき。値を元に戻して元の失敗継続を呼び出す
  2. amb構文が作った失敗継続が呼ばれて、それ以上選択肢が無くなったとき。元の失敗継続を呼び出す
Structure of the evaluator

新しい構文ambを導入。
evalはambevalと名前を変える。ambevalも環境と二つの継続を受け取りanalyzeが返して来た手続きをそれらに適用する。

成功継続は値と失敗継続を引数に取り、失敗継続には引数は無い。
評価手続きは必ず環境、成功継続、失敗継続を受け取り、最後に必ずどちらかの継続を呼び出す。呼び出し元に戻るとは考えない方が良い。スタックの状況がどうなるのか少し気になるが末尾再帰の最適化の様に実はスタックは食わないのかもしれない。

成功継続の呼び出しを普通の手続きからの戻り、失敗継続の呼び出しを例外を投げる様にイメージしても良いかもしれない。実際に戻り値と例外でも実装出来るのかも。

Simple expressions

基本的な評価手続きは値を返す代わりに値を受け取った成功継続に渡す手続きを返す。（この成功継続は基本的にはREPLから来ている筈）
特に失敗継続を用意する様な事は無いので、受け取った失敗継続をそのまま呼び出す成功継続に渡す。

変数が見つからないのはバグであって『評価の失敗』ではないので、errorを呼んで止まりバックトラックする訳ではない。

Conditionals and sequences

条件分岐は、条件部を呼び出すが戻って来た値で分岐する訳ではなく、その呼び出しに渡す成功継続の中で渡された値（条件部評価の結果）で判断するので、新たに成功継続を作る。
新たに作った成功継続でconsequent部、alternative部を呼び出す。ここの呼び出しで渡す成功継続は条件分岐の評価だ最初に受け取った成功継続だが、渡す失敗継続は条件評価から新たな成功継続が受け取った失敗継続を渡す事になる。その間に新しい失敗継続が作られているかもしれない。

シーケンスの場合、また二つの手続きを接続する手続きを数珠繋ぎにして評価結果として返す。
以前と違う所は一つ目の手続き（analyzeされた実行手続き）に新しい成功継続を渡す事。この成功継続から二つ目の手続きを呼び出す。
sequentiallyの引数aは最初はシーケンスの最初の式を実行する手続きだが、再帰で構築された最後の手続きではaは1〜n-1番目迄の式を実行する手続きでbが一番最後の手続きなので、シーケンス全体として受け取った成功継続を最後のbが受け取って呼び出せば良い。
一方失敗継続は式の実行途中で作られた場合にそれを呼び出す必要があるので、毎回成功継続が受け取った失敗継続をその次の呼び出しで渡す。

テキストにはEmpty sequenceのエラーの部分に対してelse部が無い。Racketではエラーとなるので、loopの呼び出しをelse部とする。

Definitions and assignments

defineでは値部を評価してその結果に名前を拘束する必要がある。なので、値部の評価に対して新しい成功継続を渡して、これが呼ばれたら新しい変数に割り当てて、元の成功継続を呼び出す。

前に出て来ている通り代入では失敗継続を作る。（これまでは受け取った失敗継続をそのまま渡していただけ）
最初のlambdaはanalyzeの結果として返す実行用手続き。
二番目のlambdaは値部評価の為の成功継続。この成功継続は変数の値を変更した後、続きの実行の為に上位から受け取った成功継続を呼び出すが、そこに新しい失敗継続を渡す。これが三番目のlambda。
新しい失敗継続はその先の実行で評価が失敗し、手前側の選択ポイント迄戻る途中。変更した変数の値を元に戻し、最初の成功継続が受け取った失敗継続を呼び出す。
上位から受け取った失敗継続は値部評価に渡され、この途中で評価に失敗した時に呼ばれる。

Procedure applications

aprocsはオペランド部を評価する手続きのリスト。
fprocは呼び出す手続きそのものではなく、指定された手続きを呼び出す手続き。なので引数は成功継続と失敗継続。
fprocは実際にはlambdaを評価するか変数テーブルから手続きを引っ張って来てそれを値として成功継続を呼び出す。

引数の評価結果を持つリストを用意するのにget-argsが呼ばれる。
get-argsはaprocsの先頭を呼び出す。ここで渡す成功継続は受け取った値をargsに追加して次の引数の評価をする為にget-argsを再帰呼び出しする。
get-argsはaprocが空になったら最初に渡された成功継続を呼び出す。これが実際の手続き呼び出しを行うexecute-applicationを呼び出す。

実際の手続きの呼び出しは継続の受け渡し以外は以前と変わらない。

Evaluating amb expressions

cprocsはambの選択肢一つ一つを評価する手続きのリスト。
try-nextは渡された選択肢の最初の値（）を評価する手続きを呼び出す。成功継続は上位から受け取った継続。
失敗継続は次の選択肢を以てtry-nextを呼び出す。
try-nextは選択した無くなったら上位から受け取った失敗継続を呼び出す。

Driver loop

ambevalに渡す成功継続は評価結果の値と失敗継続を受け取る。評価結果を表示した後internal-loopに引数として受け取った失敗継続を渡す。
internal-loopは入力がtry-againだった場合にはこの失敗継続を呼び出す。そうすると評価ポイント迄戻って別の選択肢でもう一度評価される。最初に渡した失敗継続が呼ばれる。最初に渡した失敗継続はinternal-loopは呼ばずに最初のdriver-loopを呼び出す。

スタックの事は考えずに成功継続、失敗継続を呼び出す、ループとしてinternal-loopやdriver-loopを呼び出すのはどこかgotoプログラミングを思わせる。規模が大きくなると手に負えなくなりそう。

Exercise 4.50

Racketのshaffleをありがたく使わせて頂き。

(define (ramb? exp) (tagged-list? exp 'ramb))
(define (analyze-ramb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            ((car choices) env
                           succeed
                           (lambda ()
                             (try-next (shuffle (cdr choices)))))))
      (try-next (shuffle cprocs)))))

やはりmaybe-extendがあると収拾がつかないくらい長い文章になってしまうので、シンプルな最初の文法だけで試す。

;;; Amb-Eval input:
;;; Amb-Eval input:
(parse-sentence)

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article a) (noun cat)) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article a) (noun cat)) (verb sleeps))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article a) (noun cat)) (verb eats))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article a) (noun cat)) (verb lectures))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun cat)) (prep-phrase (prep for) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep by) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun class)))))) (prep-phrase (prep with) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article a) (noun professor)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))))))))) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article a) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article a) (noun cat)))))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))))))))) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun cat)) (prep-phrase (prep for) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep by) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun class)))))) (prep-phrase (prep with) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article a) (noun professor)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))))))))) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article a) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article a) (noun cat)))))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))))))))) (verb sleeps))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun cat)) (prep-phrase (prep for) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep by) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun class)))))) (prep-phrase (prep with) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article a) (noun professor)) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun student)))))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))))))))) (prep-phrase (prep to) (noun-phrase (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article a) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article a) (noun cat)))))) (prep-phrase (prep for) (noun-phrase (simple-noun-phrase (article the) (noun cat)) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article a) (noun student)) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep for) (simple-noun-phrase (article the) (noun professor)))))))))) (verb eats))
;;; Amb-Eval input:

直ぐに長い文章になってしまうが、最初の４つは動詞をランダムな順番に選んでいる事が分かる。

Exercise 4.51
(define (analyze exp)
  (cond ((self-evaluating? exp) 
;…中略
        ((assignment? exp) (analyze-assignment exp))
        ((permanent-assignment? exp) (analyze-permanent-assignment exp))
;…以下省略

(define (permanent-assignment? exp)
  (tagged-list? exp 'permanent-set!))
(define (analyze-permanent-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)
               (set-variable-value! var val env)
               (succeed 'ok fail2))
             fail))))

;;; Starting a new problem ;;; Amb-Eval value:
(a b 2)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(a c 3)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b a 4)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b c 6)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c a 7)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c b 8)
;;; Amb-Eval input:
try-again
;;; There are no more values of
(let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (permanent-set! count (+ count 1)) (require (not (eq? x y))) (list x y count))
;;; Amb-Eval input:
(permanent-set! count 0)

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:
(let ((x (an-element-of '(a b c)))
      (y (an-element-of '(a b c))))
  (set! count (+ count 1))
  (require (not (eq? x y)))
  (list x y count))

;;; Starting a new problem ;;; Amb-Eval value:
(a b 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(a c 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b a 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(b c 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c a 1)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(c b 1)
;;; Amb-Eval input:
try-again
;;; There are no more values of
(let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (set! count (+ count 1)) (require (not (eq? x y))) (list x y count))
;;; Amb-Eval input:

set!だとバックトラックする度に元の値、ここでは0に戻してしまうので、表示される時には常に１。

Exercise 4.52
(define (analyze exp)
  (cond ((self-evaluating? exp) 
;…中略
        ((if? exp) (analyze-if exp))
        ((if-fail? exp) (analyze-if-fail exp))
;…以下省略

(define (if-fail? exp) (tagged-list? exp 'if-fail))
(define (if-fail-expression exp) (cadr exp))
(define (if-fail-failure exp) (caddr exp))
(define (analyze-if-fail exp)
  (let ((pproc (analyze (if-fail-expression exp)))
        (failed (analyze (if-fail-failure exp))))
    (lambda (env succeed fail)
      (pproc env
             succeed
             (lambda () (failed env succeed fail))))))

if-failの最初の式を評価した手続きをpproc、二番目の式を評価した手続きをfailedに拘束。
pprocを呼び出して、失敗しなかった場合にはそのままsuccessを呼び出して貰う。
失敗した場合には、failedを呼び出し、その結果をsuccessに受け継いでもらう事で評価結果としてREPLに戻される。
failedの呼び出しで何か失敗したら普通にfailを呼び出して貰う。

even?は定義出来なくもないが面倒なのでプリミティブとして登録。

;;; Amb-Eval input:
(define (require p) (if (not p) (amb)))
(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
           (require (even? x))
           x)
         'all-odd)

;;; Starting a new problem ;;; Amb-Eval value:
all-odd
;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5 8))))
           (require (even? x))
           x)
         'all-odd)

;;; Starting a new problem ;;; Amb-Eval value:
8
;;; Amb-Eval input:
Exercise 4.53
  1. 最初pairsは空。
  2. pにprime-sum-pairの最初の解が割り当てられる。
  3. pairsの先頭にpが挿入される。
  4. (amb)で強制的にバックトラックが起きてprime-sum-pairに戻る。
  5. prime-sum-pairの候補が無くなってバックトラックが起きると、if-failのfail節に入ってpairsが返される。

もう一度prime-sum-pairを動かすのに必要な関数達を引っ張って来て。

;;; Amb-Eval input:
(let ((pairs '()))
  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (permanent-set! pairs (cons p pairs))
             (amb))
           pairs))

;;; Starting a new problem ;;; Amb-Eval value:
((8 35) (3 110) (3 20))
;;; Amb-Eval input:

と言う事で自動的にtry-againしてくれる。

Exercise 4.54
(define (analyze-require exp)
  (let ((pproc (analyze (require-predicate exp))))
    (lambda (env succeed fail)
      (pproc env
             (lambda (pred-value fail2)
               (if (not (true? pred-value))
                   (fail)
                   (succeed 'ok fail2)))
             fail))))

何故態々notを使って順番を入れ替えるのか？とも思うが、戻る方向が上、進む方向が下と言う事だろうか？
requireの定義無しに動作させてみる。

;;; Amb-Eval input:
(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:
(an-element-of '(1 2 3 4))

;;; Starting a new problem ;;; Amb-Eval value:
1
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
2
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
3
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
4
;;; Amb-Eval input:
try-again
;;; There are no more values of
(an-element-of '(1 2 3 4))
;;; Amb-Eval input:

期待通り動いている。