Ex. 4.62

next-to のまねをして定義してみる

① 単一要素リストの last は、そのリスト自体である。
② x が z 内で last である。ならば、x は (cons v z) 内で last である。

rule に直してみる

① (rule (last-pair (?x) (?x)))
② (rule (last-pair (?v . ?z) ?x)
         (last-pair ?z ?x))

実行結果

;;; Query input:
(last-pair (3) ?x)
;;; Query results:
(last-pair (3) (3))
;;; Query input:
(last-pair (1 2 3) ?x)
;;; Query results:
(last-pair (1 2 3) (3))
;;; Query input:
(last-pair (2 ?x) (3))
;;; Query results:
(last-pair (2 3) (3))
;;; Query input:
(last-pair ?x (3))
無限ループ 
→ どこをどう無限ループしているのか？
詳しく見ていないが、
「②の本体 last-pair 評価 → last-pair と②の結論部のユニファイ → ②の本体 last-pair 評価 → ・・・ 」
というループに入っている。と思う
②の本体と②の結論部のユニファイが failed になればこのループは止まるが、failed にならないのであろう

公理的定義を行うとき、定義としてどういう性質を採用するのか。決まった方法はない。問題ごとにカットアンドトライで決めるしかない。また、同値な定義が何種類もあったりすると思われる。この問題くらいなら問題ないが、おおきな問題だと定義の選択は非常に難しいと思われる。

Ex. 4.61

next-to ルールを 「AならばB」の書き方にして、公理的定義にしてみる。

① x next y in (x (cons y u))
② x next y in z ならば x next y in (cons v z)

となる。①はリストの先頭のペアは隣接しているという性質を表す。②は、x, y が z 内で隣接してるなら、x, y は(cons v z)内でも隣接しているという性質を表す。リストの中のリストに入り込むような性質の記述はない。

なので

（?x next-to ?y in (1 (2 3) 4))

の出力は

1 next (2 3)
(2 3) next 4

である。

（?x next-to 1 in (2 1 3 1))

の出力は

2 next 1
3 next 1

である。

ところで、この問題になんか意味ある？

p.269 append-to-form の説明がなんだか分かりにくかったので整理。

まず、p269 8行目の説明がわかりにくい。

規則は一種の論理的包含と見ることができる:値のパターン変数への代入が本体を満足すれば、それは結論を満足する。
従って質問言語を、規則に基づいて論理的推論を実行する能力があると見ることができる。

ワケ　　　　　ワカ　　　　　ラン♪

論理的包含というのは "A ならば B" ということだ。つまり "A ならばB" と rule が何か関係していると言っている。のだが、rule のどこが A で どこが B に関係してるのか全然わからない。(長ったらしいだけで分からん説明)

とっとと答えを言うと、

「A ならば B」 
   ⇳
(rule B
      A)

という関係があるということだ。

たしかに、A が正しいときは B を出力し、Aが間違っているときは何も出力しないというのは、「A ならば B」 というルールを使って推論を実行しているようにも見える。

この関係にあてはめると、append の定義(前のブログでまとめる前の定義)

② (append v y) = z ならば (append (cons u v) y) = (cons u z)

は、rule を使って

(rule (append (cons u v) y) = (cons u z)
      (append v y) = z)

と書ける。もちろんこのままでは、ruleの文法に合わないので修正する。

(append a b) = c というのは (append-to-form a b c)と同じ意味である。
(cons a b) というのは (a . b)と同じ意味である。
ruleに出てくる変数には ? をつける。

なので

(rule (append-to-form (?u . ?v) ?y (?u . ?z))
      (append-to-form ?v ?y ?z))

となる。

また、単一の言明 A については

   A
   ⇳
(rule A)

という関係があるので、これを使って、appendの定義

①(append '() y) = y

は

(rule (append '() y) = y)

と書ける。また文法に合うように修正して

(rule (append-to-form '() ?y ?y))

となる。

p.269(とp262)の append の定義が分かりにくいので整理する

① 任意のリスト y について、空リストと y を append すると y になる
② 任意のu,v,y,zについてv,yをappendしてzになるなら (cons u v) と y をappend すると(cons u z) になる。

この手の"性質を列挙した定義"を公理的定義という。

公理的定義に出てくる変数には必ず"何である"という説明が必要だが、まず ② はこの説明が不足している。

正しくは

② 任意のリスト若しくは任意の単一オブジェクト u、  (← u は本当になんでもよい)
   任意のリスト v,y,z について  (← v,y,zはリストに限る)
   v,y をappendして z になるなら (cons u v) と y をappend すると、(cons u z) になる。

次に ②の長ったらしくて何を言っているかわからない説明部分を整理してみる。

②の説明部分の整理
(append v y) = z ならば (append (cons u v) y) = (cons u z)  ... (a)

"ならば"の左辺を右辺に代入すると

②の説明部分の整理
(append (cons u v) y) = (cons u (append v y))  ... (b)

となる。もちろん逆に (b) から (a) も言えるので (a) と (b) は同値である。

結局、z はあってもなくてもよいただの中間変数であることがわかる。

まとめると append の公理的定義は

① 任意のリスト y について、(append '() y) = y
② 任意のリスト若しくは任意の単一オブジェクト u、
   任意のリスト v , y について 
    (append (cons u v) y) = (cons u (append v y))

となる。(①もちょっと整理してみた。意味は同じ)

この定義だと、意味も明白に分かる。②の言わんとすることは cons してから append しても、append してから cons しても結果は同じといっている。つまり append の性質として cons と append の交換可能性を 述べているのである。

Ex. 4.60

(lives-near (Hacker Alyssa P) (Fect Cy D))
(lives-near (Fect Cy D) (Hacker Alyssa P))

理由は、どっちもパターンを満足するからである。

解決案 : 「人名がアルファベット順にならぶ」という条件でフィルタする

;;; Query input:
(and (lives-near ?p1 ?p2)
     (lisp-value person< ?p1 ?p2)) ;; アルファベット順のもののみ

;;; Query results:
(and (lives-near (Aull DeWitt) (Reasoner Louis)) 
     (lisp-value person< (Aull DeWitt) (Reasoner Louis)))
(and (lives-near (Aull DeWitt) (Bitdiddle Ben)) 
     (lisp-value person< (Aull DeWitt) (Bitdiddle Ben)))
(and (lives-near (Fect Cy D) (Hacker Alyssa P)) 
     (lisp-value person< (Fect Cy D) (Hacker Alyssa P)))
(and (lives-near (Bitdiddle Ben) (Reasoner Louis)) 
     (lisp-value person< (Bitdiddle Ben) (Reasoner Louis)))

"person<" 関数は親Schemeで定義しておく。

;; 親Schemeで定義
(define (person->string a1)
  (if (null? a1)
      ""
      (string-append (symbol->string (car a1)) (person->string (cdr a1)))))
(define (person< p1 p2)
  (string<? (person->string p1) (person->string p2)))

Ex. 4.59

;;; Query input:
;;a
(meeting ? (Friday . ??))
;;; Query results:
(meeting administration (Friday 1pm))

アリッサは驚かなかった。何を？

;; b
(rule (meeting-time ?person ?day-and-time)
      (or (and (job ?person (?sect . ?work))
	       (meeting ?sect ?day-and-time))
	  (meeting whole-company ?day-and-time)))

;;; Query input:
;;c
(meeting-time (Hacker Alyssa P) (Wednesday . ?))
;;; Query results:
(meeting-time (Hacker Alyssa P) (Wednesday 3pm))
(meeting-time (Hacker Alyssa P) (Wednesday 4pm))

Ex. 4.58

wheel とか big-shot とか、、、言いたいだけちゃうの。というのは置いといて。

「監督を持たない人」 というのは、「全員」から「監督を持つ人」を引けばよい。"引く"は not でフィルターすればよい。

(rule (big-shot ?x)
      (and (job ?x (?job . ?) )       ;; 部門で働く人
	   (not (and (supervisor ?x ?BOSS)   ;; 監督を持つ人
		     (job ?BOSS (?job . ??)))))) 

;;; Query input:
(big-shot ?)
;;; Query results:
(big-shot (Scrooge Eben))
(big-shot (Warbucks Oliver))
(big-shot (Bitdiddle Ben))

部門というのは (computer programmer) の computer の部分を指すらしい。

答の確認→ http://eli.thegreenplace.net/2008/02/08/sicp-section-441/

Ex. 4.57

「...person1の仕事をする誰かがperson-2の仕事が出来...」 ?(ﾟДﾟ) 、、、これは、「person1の仕事はperson-2の仕事が出来る(can-do-job)」というだけのことでは、、、"誰か"さんまったく関係ないじゃん! 。というのは置いといて。

(rule (replaceable ?taro ?hana)
      (and (or (and (job ?taro ?sigoto) ;; taroズ と 仕事 の一覧
		    (job ?hana ?sigoto)) ;; taroズ と同じ仕事の hanaちゃんズ
	       (and (job ?taro ?taro-sigoto) ;; taroズ と 仕事の一覧
		    (job ?hana ?hana-sigoto) ;; hanaちゃんズ と仕事の一覧
		    (can-do-job ?hana-sigoto ?taro-sigoto))) ;; 条件 hanaちゃんの仕事は taroより高級
	   (not (same ?taro ?hana))))

rule はデータベースのデータと同じ扱いなので、p.263のDBに混ぜておくこと。rule を Query input : に入力してもむだなので注意。(自分だ)。

ch4-query.scmソースだと (define microshaft-data-base... に混ぜておけばOK。

(あぁ、p.275 assert! を使うと、Query input : からDBの追加とかできんのね、、、12/4)

not に注意。notは論理演算子ではない。フィルターである。上の行で得たリストをフィルターするのが not の機能。なので

(and (not (xxx))
     (...))

と not を先頭にもってくると null リストが返ってくる。

この rule の実行結果

;;; Query input:
;; a
(replaceable (Fect Cy D) ?x)  ;; Cy Dの仕事ができる人は？
;;; Query results:
(replaceable (Fect Cy D) (Bitdiddle Ben))
(replaceable (Fect Cy D) (Hacker Alyssa P))

;;;; Query input:
;;b
(and (replaceable ?x ?y)  ;; 同じ仕事ができて
     (salary ?y ?y$)
     (salary ?x ?x$)
     (lisp-value < ?y$ ?x$))  ;; 給料の安い人
;;; Query results:
(and (replaceable (Warbucks Oliver) (Aull DeWitt)) 
     (salary (Aull DeWitt) 25000) 
     (salary (Warbucks Oliver) 150000) 
     (lisp-value < 25000 150000))
(and (replaceable (Hacker Alyssa P) (Fect Cy D)) 
     (salary (Fect Cy D) 35000) 
     (salary (Hacker Alyssa P) 40000) 
     (lisp-value < 35000 40000))

(改行はマニュアル)

(あれ？ taroとhanaが逆か → http://eli.thegreenplace.net/2008/02/08/sicp-section-441/ まぁいいか。 )

ruleは、 SQL よりかなり高級な機能。SQLの劣化版というだけでもないのか。

Ex. 4.56

;;a
(and (supervisor ?who (Bitdiddle Ben))
     (address ?who ?))
;;b
(and (salary (Bitdiddle Ben) ?$)         ;; Benの給料取得
     (salary ?who ?$$)                   ;; 全人物、給料の一覧を取得
     (lisp-value < ?$$ ?$))              ;; 条件でフィルタする
;;c
(and (job ?who ?all)                     ;; 全人物、ジョブの一覧を取得する
     (not (job ?who (computer . ?any)))  ;; not で上の一覧をフィルターする。
     (supervisor ? ?who))                ;; 人物をキーに外部結合する

最初 lisp-value 使うと user-initial-environment の未定義エラーでた。

ch4-query.scmに

(define user-initial-environment '())

を追加

Ex. 4.55

a. (supervisor ? (Bitdiddle Ben))
b. (job ?x (accounting . ?))   ← ドットのまわりの空白は必須。
c. (address ?x (Slumerville . ?))  ← ？が２つあるときは区別するためにパターン変数が必要

質問システムっても、SQLの劣化版のような気がするが、動かしてみると意外とおもしろい。

http://mitpress.mit.edu/sicp/code/index.html に ch4-query.scm のソースがある。

ch4-query.scm を gosh で動かすには少し変更が必要。

;;;ファイルの先頭に追加
(define false #f)
(define true #t)
(define user-initial-environment '()) ;; 2009-11-27追加 lisp-value で使う
;;p188脚注
(define the-empty-stream '())
;;; p.189
(define-syntax cons-stream
  (syntax-rules ()
    ((_ a b) (cons a (delay b)))))
;;p188
(define (stream-null? x) (null? x))
;;p189
(define (stream-car x) (car x))
(define (stream-cdr x) (force (cdr x)))

(define (list->stream l)
  (if (null? l)
      the-empty-stream
      (cons-stream (car l) (list->stream (cdr l))) )) ;;; http://inst.eecs.berkeley.edu/~instcd/inst-cd/classes/cs61a/drscheme/berkeley.ssから拾ってきた

(define (extend variable value frame)
  (cons (make-binding variable value) frame))  ;; goshのextendと混乱するので先に上書きする。

・・・ch4-query.scmの本文・・・

;;;最後に追加
(initialize-data-base microshaft-data-base)
(query-driver-loop)

メタ関数スパゲッティについて

Ex. 4.54

(require (a ...))の継続を考える。s0、f0 は require に渡される適当な継続として。

a ⇒ f0 (aが#fのとき)
a → s0 (aが#tのとき)

なので

(define (analyze-require exp)
  (let ((pproc (analyze (require-predicate exp))))
    (lambda (env succeed fail)
      (pproc env   ;; pproc には上の継続列の (a...)が入る
	     (lambda (pred-value fail2)  ;; pred-value には pprocの実行結果が入る
	       (if (not pred-value)
		   (fail)
		   (succeed 'ok fail2)))
	     fail))))

以上。やっとamb評価器おわり。疲れた。

いつも参考にさせて頂いているSICPのサイト

Eli Bendersky's website

さかもっちゃんちゃんこ

Serendip Web Studio

Ex. 4.53

結構準備がたいへん。

amb評価器も少し変更
(define primitive-procedures
  (list (list 'car car)
        ...
	(list 'remainder remainder) ;; prime?で使うので
        ...

amb評価器に事前に喰わせておくソース

;;; Amb-Eval input:
;;p.246
(define (require p)
  (if (not p) (amb)))
;;p.245
(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))
;; p.28
(define (divides? a b)
  (= (remainder b a) 0))
;;p.15
(define (square x) (* x x))
;;p.28
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
	((divides? test-divisor n) test-divisor)
	(else (find-divisor n (+ test-divisor 1)))))
;;p.28
(define (smallest-divisor n)
  (find-divisor n 2))
;;p.28
(define (prime? n)
  (= n (smallest-divisor n)))
;;p.245
(define (prime-sum-pair list1 list2)
  (let ((a (an-element-of list1))
	(b (an-element-of list2)))
    (require (prime? (+ a b)))
    (list a b)))

これで準備完了。

;;; Amb-Eval input:
;;p260 Ex.4.53
(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))

いちいち try-again しなくても、ambで探索し発見したアイテムを全部まとめて入手できる。

ambの発見物でリストを作るのは permanent-set! の役目。if-fail がないと作ったリストを取り出せない。

Ex. 4.52

(if-fail (a ...)
         (b ...))

という式の継続処理を考える。 適当な s0, f0 を if-fail の引数として

a → s0      (a が成功継続を選んだとき)
a ⇒ b → s0 (a が失敗継続を選んだとき)

と動作すればよいと思われる。つまり、単に a を実行すればよい。実行時の aの成功継続に s0 を渡し、a の失敗継続に (b→ s0)を渡すだけ。

(define (if-fail? exp) ; 追加
  (tagged-list? exp 'if-fail))

(define (if-fail-consequent exp) (cadr exp)) ; 追加
(define (if-fail-alternative exp) (caddr exp)) ; 追加

(define (analyze-if-fail exp) ; 追加
  (let ((cprocs (analyze (if-fail-consequent exp))) ; TRUE節
	(aprocs (analyze (if-fail-alternative exp)))) ; ELSE節
    (lambda (env succeed fail)
      (cprocs env  ; if-fail? の TRUE節の式を実行する
	      succeed ; 成功継続は通常どおり
	      (lambda () ; 失敗継続
		(aprocs env succeed fail)))))) ; 失敗継続の中身は(ELSE節の式 → succeed)合成関数

(define (analyze exp)
  (cond ((self-evaluating? exp) 
        ...
        ((if-fail? exp) (analyze-if-fail exp)) ; 追加
        ...

(define primitive-procedures
  (list (list 'car car)
        ...
	(list 'even? even?) ; 追加
        ...

これで、p260の例は正しいのだが

;;; 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 4 5 ))))
	 (require (even? x))
	 x)
	 'all-odd)
;;; Starting a new problem 
;;; Amb-Eval value:
4   ← ここで偶数が見つかっているのに
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
all-odd ← 最後に「全部奇数」というメッセージがでるのはおかしい。

このように、リストに偶数があろうがなかろうが、最後に all-odd の表示を実行してしまうのである。

これを修正しようとして、望ましい動作を考えてみると、

(例1)...(an-element-of '(1 3 5))...のときの継続処理
1 → require ⇒ 3 → reauire ⇒ 5 → require ⇒ all-odd

であり、一方

(例2)...(an-element-of '(1 3 4 5))...のときの継続処理
1 → require ⇒ 3 → reauire ⇒ 4 → x → driver-loop ⇒ 5 → require ⇒ 終了(all-oddを表示せずに終了)

という継続処理が必要である。

この継続列の最後の部分に注目すると

(例1) require ⇒ all-odd
(例2) require ⇒ 終了(all-oddを表示せずに終了）

となっている。(例1)と(例2)の require の失敗継続が異なっている。

これを実現するには、(例2)で4が見つかった時点で、成功継続の引数に渡す失敗継続から、'all-odd を消し去らねばならない。

これはなかなか難しい。なぜなら現状、if-failのTRUE節は一つの式であり、ELSE節側からこの式が一度でも成功するか否かを判定する方法がないからである。(ELSE節側とTRUE節間で通信する手段がない)。

現状では、ELSE節側(all-odd側)は自分を失敗継続として、TRUE節(成功継続側)に渡すだけの仕組みしかないのである。成功継続がわも set! 式以外は、失敗継続をそのまま使うだけの実装になっている。

これを改善するためには、ELSE節側つまり失敗継続側で、TRUE節つまり成功継続側の成功、失敗をモニターできるような機構を追加しなければならないと思われる。

たぶん評価器全体をかなり変更しないと実装できない。たとえば、すべての式で、成功、失敗どちらの継続を選択したかの履歴を失敗継続に埋め込んでいって、if-elseの失敗継続は自分に関係のある継続の履歴を見ることができるようにするとか。これはかなり面倒そうである。

もっとうまい手があるか？エラーメッセージを "no-more-even" にするとか。根本は何も解決してないけれど。

Ex. 4.51

p.257 analyze-assignment を改造する。失敗継続に埋め込まれている環境の巻き戻し処理を取り去ればよい。

(define (permanent-assignment? exp)  ;; 追加
  (tagged-list? exp 'permanent-set!))

;; p.257 analyze-assignmentとほとんど同じ
(define (analyze-permanent-assignment exp) ;; 追加
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)        ; *1*
               (let ((old-value
                      (lookup-variable-value var env))) 
                 (set-variable-value! var val env)
                 (succeed 'ok
                          (lambda ()    ; *2*  ;; このλは失敗継続
                            ;;; 環境の巻き戻し処理を消すだけ
                            ;;;(set-variable-value! var
                        ;;;                     old-value
                        ;;;                     env)
                            (fail2)))))
             fail))))

;; p.234 analyze
(define (analyze exp)
  (cond ((self-evaluating? exp) 
        ...
        ((permanent-assignment? exp) (analyze-permanent-assignment exp)) ;; 追加
        ...

permanent-set! の代わりに set! を使うと、(a b 1), (a c 1), ... と常に1 が返る。バックアップ、バックトラックするたびに count の値の変更が巻き戻されて 0 に戻るから。

permanent-set! をつかうと (amb 1 2 3) の引数の合計 6 を求めたりもできる。

しかし、この手の機能は、ストリーム処理で十分こなせる。また、ストリームで処理すべきである。permanent-set!みたいな機能を入れるなら、わざわざ継続を使って amb の実装をした意味がない。

Ex. 4.50

p.258 analyze-amb を改造する。選択肢のリストをランダムにシャッフルする。

(use gauche.sequence)

(define (ramb? exp) (tagged-list? exp 'ramb))  ; 追加
(define (ramb-choices exp) (shuffle (cdr exp))) ; 追加。選択肢のリストをシャッフルする。

;;; p.258 analyze-amb とほぼ同じ
(define (analyze-ramb exp) ; 追加
  (let ((cprocs (map analyze (ramb-choices exp))))  ; ここを変えるだけ
  ... 以下は p.258 analyze-amb とまったく同じ

(define (analyze exp)  ;; p.234 analyze
  (cond ((self-evaluating? exp) 
    ...
    ((ramb? exp) (analyze-ramb exp))  ; 追加
    ...

gosh だと、shuffle 関数があるので簡単。shuffle 関数ない場合の自作例は以下のとおり（性能悪し)

;;; p.132 脚注
(define (rand-update x)
  (modulo (+ (* x 1103515245) 12345) 2147483647))
(define random-init 12345) ;;; 任意
;;; p.132
(define rand
  (let ((x random-init))
    (lambda ()
      (set! x (rand-update x))
      x)))
;;;シャッフルコア (バブルソート的に隣同士をランダムに入れ替える)
(define (shuffle-1 x) 
  (if (null? (cdr x))
      x
      (if (odd? (rand))
	  (cons (car x) (shuffle-1 (cdr x)))
	  (cons (cadr x) (shuffle-1 (cons (car x) (cddr x)))))))
;;;シャッフル関数(適当に１００回くらい入れ替えを実行する)
(define (shuffle x)
  (define (loop n x)
    (if (= 1 n)
	x
	(loop (- n 1)(shuffle-1 x))))
  (loop 100 x))

アリッサの問題というのは、p.253 Ex.4.49の脚注によると、単語を文法どおりに組み合わせて自動的に文書を作ろうとしたが、文法の許す再帰性のためいくつかの文章間で振動してしまうということ（らしい。間違ってるかも。）ランダムに選択するならこの振動は回避できるらしい。(げげ、4.49 飛ばしてた。忘れてた。)

しかし、よく考えると、ramb でリストをランダムにしてもアリッサの問題の助けにはあまりならない。

rambでリストをランダムにして振動を回避しても、ramb を複数重ねた探索ツリーを深さ優先で探索する限り、似たような文が吐き出されるという状況は改善されないと思われるから。

本当の解決は、探索ツリーの上下左右、いたるところを飛び回るような探索をしなければならないが、、、これはちょっと難しいかも。

analyze-ambについて

p258 analyze-amb の動作を確認しよう。

(begin (amb1 1 2)
       3
       (amb2))

という例を考える。

(1) 継続処理列の確認

begin の処理する継続処理の列は

amb1 → 3 → amb2

である。合成λパックは

(amb1 → (3 → amb2))

となる。しかし我々の望む継続処理は

(amb1返値1 → (3 → amb2返値null)) ⇒ (amb1返値2 → (3 → amb2返値null)) ⇒ (amb1返値null) ⇒ f0
 ①                 ②                 ③                ④                 ⑤              ⑥

である。青い矢印 ⇒ のところで、継続処理が begin の用意したものを越えて進んでいる。

先に答えを言ってしまえば、赤い矢印は成功継続処理で、青い矢印は失敗継続処理である。amb が begin の用意した成功継続の枠を破って、失敗継続を呼び出している。

図から、

amb は自分のリストが 
  null のときは失敗継続処理を継続させる。
  null 以外のときは成功継続処理を継続させる。

ということが分かる。

(2) 継続処理の出処の確認

また図より、継続処理列中の各 amb が受け取る継続処理がどんなものか想像してみよう。

①amb1の受け取る成功継続は (3 → amb2)、失敗継続は (デフォルトのf0)
②amb2の受け取る成功継続は (デフォルトのs0)、失敗継続は (amb1'(2) → 3 → amb2)
③amb1の受け取る成功継続は (3 → amb2)、失敗継続は (デフォルトのf0)
④amb2の受け取る成功継続は (デフォルトのs0)、失敗継続は (amb1'())
⑤amb1の受け取る成功継続は (デフォルトのs0)、失敗継続は (デフォルトのf0)

という感じかと思われる。

各継続の出処を考えよう。①③の成功継続は begin が用意したものだ。また、デフォルトs0、f0 はbeginの引数である。

出処不明なのは、②④の失敗継続である。これは一体だれが作ったのか？

先に答えを言ってしまうと、②amb₂の失敗継続は①amb₁が作る。④amb₂の失敗継続は③amb₁が作る。

作り方は、「①のリストのcdr + ①の成功継続」、「③のリストのcdr + ③の成功継続」という感じで作る。この作業は p258 analyze-ambのtry-nextの中で行っている。

try-next はこのように失敗継続の作成のほか、成功継続の本体としての役目、 さらにまた失敗継続の中の再帰関数としての役目もある。

ambは一種のループだから、ループを実現するための再帰が存在する筈である。それがこのtry-nextの再帰である。

(3) 継続処理の伝搬方法

(i)失敗継続の伝搬方法

そして、①amb₁で作られた失敗継続は、λパック、若しくは成功継続の引数として、3 そして ②amb₂ へと伝えられていく。(失敗継続のたらいまわし)。

失敗継続の中身は、再帰 try-next であるが、これは伝搬中は発動しない。たらいまわし先(amb2のリストがnullの場合)で発動する。大回りな再帰処理とも見れる。

(ii)成功継続の伝搬方法

③の成功継続はbeginの作ったものだが、beginが直接渡す相手は①である。③にまで伝搬するのにはトリックがある。

①amb₁ は begin から貰った成功継続を、自分が作る失敗継続の中に埋め込むのである。(p258 analyze-ambのtry-nexの中にsucceedが埋め込まれている。そしてtry-next自身が失敗継続として使われている。)。この失敗継続は、たらいまわしによって③に伝搬される。このとき埋め込まれた成功継続も一緒に伝搬する。

実行を追いかけると以上の動作をしていることが確認できる筈である。

しかし今回は f を無視できないので、若干ややこしさが倍増している。env は無視している。

(λbegin s0 f0)
 ↓
((λ(s f)                     ← begin の作る合成関数
    (λamb1                   ← amb1 と (3 → amb2) の合成
     (λ(v f1)               ← λamb1の成功継続
	(λ3λamb2 s f1))     ←  (3 → amb2)の合成部分
     f)) 
 s0 f0)
 ↓
(λamb1
 (λ(v f1)
    (λ3λamb2 s0 f1))
 f0)
 ↓
((λ(s f)                       ← p.258 analyze-amb でλamb1を展開
    (define (try-next choices)  ← try-next の定義
      (if (null? choices)       ← ambのリストによって失敗継続と、成功継続を振り分ける
	  (f)                   ← ambのリストがnullのときは失敗継続を継続させる(=呼び出す)
	  ((car chices)         ← ambのリストがnull以外のときは成功継続を継続させる(=呼び出す)
	   s                    ← ここで引数の成功継続s(中身は(3→amb2))を try-next に埋め込んでいる
	   (λ() (try-next (cdr choices))))))
    (try-next '(λ1 λ2)))    ← λamb1の展開はここまで。'(λ1 λ2)はamb1のリスト'(1 2)のλパック化リスト
 (λ(v0 f1)                  ← λamb1に渡す成功継続 
    (λ3λamb2 s0 f1))        ← 成功継続の中身は(3 → amb2)合成関数である。
 f0)                         ← λamb1に渡す失敗継続
 ↓
(define (try-next choices)  ← amb1の最初の実行時のtry-next定義
  (if (null? choices)
      (f0)                  ← (f0もtry-nextに埋め込まれています。⑥で使います)
      ((car chices) 
       (λ(v0 f1) 
	  (λ3λamb2 s0 f1))  ← try-nextに(3→amb2)が埋め込まれました
       (λ() (try-next (cdr choices)))))) ← 失敗継続で、try-nextを再帰する。
(try-next '(λ1 λ2))       ← try-next実行
 ↓
(if (null? '(λ1 λ2))      ← ambのリストが
    (f0)                    ←    null なら失敗継続 f0 を継続させる
    (λ1                    ←    null 以外なら成功継続(1→(3→amb2))を継続させる
     (λ(v0 f1) 
	(λ3λamb2 s0 f1))
     (λ() (try-next '(λ2))))) ← λ1の失敗継続にλamb1の作ったtry-nextがたらいまわしされています。
 ↓
(λ1                            ← λ1 はλamb1のリスト'(1 2)の最初の式1のλパックである
 (λ(v0 f1)
    (λ3λamb2 s0 f1))
 (λ() (try-next '(λ2))))
 ↓
((λ(s f) (s 1 f))             ← λ1 
 (λ(v0 f1)                    ← 成功継続 
    (λ3λamb2 s0 f1))          ← (3→amb2)合成関数
 (λ() (try-next '(λ2))))     ← 失敗継続。λamb1の作ったものがたらいまわしされています。再帰された try-next はたらいまわし先で発動します。
 ↓
((λ(v0 f1)                     ← 成功継続実行
    (λ3λamb2 s0 f1))
 1                             ← amb1 の返値1実行。(引数は先に評価される)
 (λ() (try-next '(λ2))))     ← 成功継続にλamb1の作った失敗継続がたらいまわしされています 
 ↓
(λ3λamb2 s0 (λ() (try-next '(λ2))))) ← (3→amb2)にλamb1の作った失敗継続がたらいまわしされています

以上で、 ① → ② の部分をみた。

一番最後の行で、合成関数 (3 → amb2) に amb1 で作った失敗継続 (λ(try-next '(λ₂)))がたらいまわしされているのが確認できる。

また少し上に遡るが、この失敗継続の中の try-next には、(3 → amb2)合成関数が埋め込まれているのが確認できる。

さらに実行を進めると、② → ③ の部分を確認できる筈だが、、、疲れたので省略

(s0について。s0 は begin の全体の成功継続である。s0 もちゃんと try-nextに埋め込まれているが、上の例だと amb2 が常にnil なので s0 に継続が移動することはない。amb2 が nil 以外を返す例なら s0 に進む。この場合 amb1 をループさせるのは p.259 driver-loop の役目となる。)

継続を使ったambの実装

ambの実装であるが、これが妙に難しい。なぜか？

1. 継続の説明がない。継続を利用してamb を実装している。しかし、継続自体の説明はない。
2. 継続の実装方法の説明がない。ambの実装とともにいつのまにか継続の実装も終了している。
3. 最大の原因は、amb評価器のソースがスパゲッティになっているから! (高度なテクニックとかではなく、単にスパゲッティソースになっている。かなり酷い。)

なので、本文に入る前に①継続とは何か、および②継続の実装方法について自力で見通しをつけておかなければならない。

③スパゲッティなソースは、根性で読むのみ!(若しくは、一切読まないのも可)。

スパゲッティの中でも、analyze-application の動作が極めてややこしい。これだけ順を追って追いかけてみる。(analyze-amb より analyze-application の方が酷いスパゲッティになっている。)

あと注意は、amb評価器は、メタ関数とリスト処理だけで継続を実装している。スタックの操作や、call/cc の登場を期待して読むとちょっとあてが外れる。(なお、call/cc を使ったほうがよっぽどわかりやすいソースになるらしい‥・)

【1】

①継続とは何か。

ある処理の継続とは、その処理より未来の処理とその時の環境すべてのことである。

こう言われると、何がなんやらわからない。未来の処理とはなにか、PCの電源OFFまでのことか？10年後までの処理を含むのか？すべての環境とはなにか、PCのメモリのすべてのことか？、PCの現在時刻も含むのか？LANアドレスも含むのか？

なので、もう少し具体的な、コーディングできそうな定義が欲しい。

(1) 未来の処理とは?

合成関数を考える。

F(1) = w(z(y(1)))

合成関数中の各要素の未来の処理とはそれぞれ

1の未来の処理 → w・z・y
yの未来の処理 → w・z
zの未来の処理 → w

である。未来の処理のことを継続処理という。

1の継続処理 → w・z・y
yの継続処理 → w・z
zの継続処理 → w

である。以上で継続(処理)の定義終了である。

各継続処理を1列に並べてみると

1 → w・z・y、y → w・z、z → w

右からとなり同士をくっつけていくと

1 → y → z → w

という継続処理の列が得られる。こうして見ると、継続というのは単なる処理の実行順であり、フローチャートと同じである。

この図を元に、もう一度 1の継続処理を考える。

1 → (y → z → w)

と書くことができる。(y → z → w)という処理は、ようするに合成関数 w・z・y のことである。

同様に、yの継続処理は

y → (z → w)

と書ける。(z → w) は合成関数 w・z のことである。

この手順は繰り返すことができる。つまり、継続を２つづつ合成して、全体を1つの合成関数に まとめることができる。

(1 → (y → (z → w)))

こんな感じ。

もっと複雑な場合 v(z(y(1 2)),w(3))でも同じことができる。継続処理の列

1 → 2 → y → z → 3 → w → v

を2つづつまとめて

(((((1 → 2) → y) → z) → (3 → w)) → v)

となる。まとめる順番は、1.引数をまとめる、2.引数と関数をまとめる。としている。

(2)その時の環境すべてとは？

Schemeには大域変数が存在する。大域変数の保存先は環境である。

図中の環境というのは、実態は単なる変数名と値のリストである。（→こんなの ((a b c) (1 2 3)) )

継続で必要な環境とは、この大域環境のことである。

(1)、(2) を合わせて、結局Schemeでは、F における y の継続とは、「合成関数 (z → w) ＋大域環境」ということになる。

説明しにくいので、継続の合成関数のことを"継続処理"、継続の大域環境のことを"継続環境"と呼ぶことにする。

継続＝「継続処理(合成関数のこと) ＋継続環境(大域環境のこと)」

ここで１つ心配がある。継続環境の保存方法である。なぜなら、継続処理 (z → w) が継続環境(大域環境)を変更することがあるからである。y の終了時点での継続環境をどのように維持するか？

1. 継続環境のスナップショットを保存する。
2. 若しくは、継続環境を変更するときは、変更履歴を保存する。(必要に応じて、履歴を巻き戻すと、元の環境を再現できる）

SICPでは、2. の方法が採用されている。(p.257 analyze-assignment)

【2】

②継続の実装

ユーザの入力した式を、継続処理の列にバラして、その列を合成して1つの合成関数にまとめる。というのが実装の最終目標である。

なので、実装の中心的な処理は「２つの継続処理を1つに合成する」ということになる。3つ以上の継続の合成は、２つの合成を繰り返し適用すればよい。

で、２つの継続を合成する方法だが、例えば sin関数 と cos関数 の合成は簡単である。(sin (cos x)) しかし、(print "abc") と (sin 1.5) を合成するにはどうするか？

どんな継続でも、同じ手順で合成できるようにしたい。そのために工夫がいる。

(1) 式のλパック

最初に、式をλでパックすることを考える。これは、前の章4.1.7の評価器ですでに実施されていた。

式1 → 評価器(eval→analyze)→(λ(env) 1)→親Schemeで実行

amb 評価器では、このλパックを拡張して、引数に継続処理を渡すようにする。

式1 → 評価器(eval→analyze)→(λ(env s f) (s 1 f))→親Schemeで実行

s, f には継続処理が渡される。例えば s に w・z合成関数 、f にダミー関数、envに空リスト'()を渡して実行する。

((λ(env s f) (s 1 f)) '() (w・z合成関数) (dダミー関数))
↓親Schemeで実行
((w・z) 1 d)

というような感じ。引数に継続処理を渡すようにしても、継続処理 1→z→w つまり w(z(1))がうまく実行される。

(2) λパック２つを1つに合成する手順

例として、即値式を２つならべただけの複文を合成する場合を考える。

(begin 1
       2)

継続処理列は

1 → 2

である。これを合成して

(1 → 2)

という合成関数を作りたいのである。具体的な作り方を見てみよう。

式1、式2を直接合成するのではなく、式のλパック、λ1、λ2 を合成する。

式1 のλパックは (λ(env s f) (s 1 f))である。図にしてみると、こんな感じになる。

(λ(env s f)(s 1 f))

残念ながら、このままでは引数が多すぎてなにが何やらさっぱりである。なので、s の動きだけ追いかける。

式1のλパック

(λ(s)(s 1))

同じく式2のλパック

(λ(s)(s 2))

式1のλパックと式2のλパックの合成

NG!

とできればいいのだが、これはNGである。λパックの関数形と継続処理 s の関数形が異なるので、直接接続できない。

λパックの関数形 → (λ(env s f) ...) p.255 14行目
継続処理sの関数形 → (λ(val f) ...) p.255 15行目

ややこしいので、s と val にだけ注目する。

λパックの関数形 → (λ(s) ...)
継続処理sの関数形 → (λ(val) ...)

λ2をλ1に接続するには、λ2を継続処理の形に変換して、それから接続すればよい。

(手順1)
まず、λ2に適当に s0 を与えて実行形にする。

((λ(s)(s 2)) s0)

(手順2)
これを λで囲って継続処理の形にする。これで、λ2パックを継続処理の形に変換できた。

(λ(val)
  ((λ(s)(s 2)) s0))

(手順3)
この継続処理をλ1に接続する。接続するというのは引数に渡すことである。

((λ(s)(s 1))
  (λ(val)
    ((λ(s)(s 2)) s0)))

(手順4)
最後に全体をλで囲ってλパックにする。 このとき、合成λパックの引数 s0 をλ2の継続処理に埋め込んでおく。そうしとけば、最後に実行されて具合がよい。(合成λパックの継続処理の列 λ1 → λ2 → s0 )

(λ(s0)
  ((λ(s)(s 1))
    (λ(val)
      ((λ(s)(s 2)) s0))))

以上がλパック2個を合成して、λパック1個にする手順である。

まとめると合成λパックの基本形は

(λ(s0)           ← 合成したλ
  (λ1            ← 合成元のλ1
    (λ(val)      ← λ2を継続処理に変換するためのλ
      (λ2        ← 合成元のλ2
         s0))))   ← 合成λの継続処理

という形になる。

3個以上の合成は、2個の合成を繰り返し適用する。

この合成λパックが、元々の継続処理 1 → 2 を再現することを確かめよう。

確かめるために s0に適当な継続 (λ(val) 'success) を与えて、この合成λパックを実行してみよう。(λパックを実行するのは親Scheme)

(λ合成 (λ(val)'success))
  ↓
(λ1 (λ(val) (λ2 (λ(val)'success))))
  ↓
((λ(s)(s 1)) (λ(val) (λ2 (λ(val)'success))))
  ↓
((λ(val) (λ2 (λ(val)'success))) 1)  ← ここで 1 実行 (引数は先に評価される)
  ↓
(λ2 (λ(val)'success))
  ↓
((λ(s)(s 2))(λ(val)'success))
  ↓
((λ(val)'success) 2)  ← ここで 2 実行 (引数は先に評価される)
  ↓
'success  ← 最後に s0 の本体実行

ちゃんと、1 → 2 → 'success という順番に実行されるのが確認できる。

(3) 継続環境の保存方法

継続環境の保存方法はどうなったか？これは継続処理 f に継続環境の巻き戻し処理を埋め込んでおけばよい。そうすれば 継続処理 f の実行時には巻き戻しが実行されて、継続環境が前の状態に復元する。p.257 analyze-assignment. なお、amb評価器では、巻き戻しは継続処理 f にのみ合成されている。継続処理 s で巻き戻しが必要になることがないので。

(4) 継続処理を合成する範囲

評価器は何処から何処まで継続処理の列を管理し合成したらいいのか？

トップレベルのカッコ始まり　( から カッコ終わり ) までである。本当は何処から何処まででもいいのだろうが、これは amb評価器の仕様である。(p.259 driver-loop の read 関数)

継続処理の管理開始
(......
......
...)
継続処理の管理終了
↑
この間の継続処理は管理しない
↓
継続処理の管理開始
(..........
.........)
継続処理の管理終了

トップレベルのカッコで囲まれた式というのは、

複文
(begin (a ...)
       (b ...)
       (c ...))
if文
(if ((d ...))
    (e ...))
関数実行
(f 1 2)

などである。おのおの継続処理の列は、

複文の継続処理列は、式a → 式b →式c
if文の継続処理列は、条件式 d → TRUE節 e
関数実行の継続処理列は、引数1 → 引数2 → 関数f

となる。amb評価器は、それぞれの継続処理列を合成する。

複文の継続処理列の合成 → p.256 analyze-sequence
if文の継続処理列の合成 → p.256 analyze-if
関数実行の継続処理列の合成 → p258 get-args と p.257 analyze-application

p.256 analyze-sequence の作る合成関数は、上で見た基本形そのものである。

p.256 analyze-if、p258 get-args と p.257 analyze-applicationの作る合成関数は、基本形を少し変形したものになる。(s0の部分が変形される)

【3】

③ analyze-application の動作

では、非常にややこしい p.257 analyze-application の動作を考えよう。

まず、analyze-application の入力は、関数の実行形式、例えば (y 1 2)である。

(y 1 2)の継続処理列は

1 → 2 → y

である。analyze-application はこれを合成するのだが、２つの部分に分けて合成している。

① 引数の合成 (1 → 2)。 p.258 get-args
② 引数と関数の合成((1 → 2) → y)。 p.257 analyze-application

まず、① get-args から見ていく。

get-args の関数形は、

(get-args (aprocs env s f) ...) p.258 get-args 

である。ややこしいので、env と f を無視すると

(get-args (aprocs s) ...)

となる。aprocs には (y 1 2) の引数の部分 (1 2) のλパックのリスト (λ1 λ2) が渡される。s0を適当な継続として、get-args の実行形は

(get-args '(λ1 λ2) s0)

となる。このまま実行を追いかけてみよう。 p.258 get-args を繰り返し適用して、

(get-args '(λ1 λ2) s0)
  ↓
(λ1
   (λ(val1)
      (get-args '(λ2) (λ(val2) (s0 (cons val1 val2))))))
  ↓
(λ1
   (λ(val1)
      (λ2
         (λ(val3)
            (get-args '() (λ(val4) ((λ(val2)(s0 (cons val1 val2))) (cons val3 val4))))))))
  ↓
(λ1
   (λ(val1)
      (λ2
         (λ(val3)
            ((λ(val4) ((λ(val2) (s0 (cons val1 val2))) (cons val3 val4))) '()) )))))

となる。最終的に get-args は、

(get-args '(λ1 λ2) s0)の中身
   (λ1
      (λ(val1)
         (λ2
            (λ(val3)...s0...))))

という形に展開される。これは、λ1とλ2の合成形になっている。つまり、get-argsは、継続処理の引数部分 1 → 2 の合成関数になっている。ただし、基本形と違ってλ2の継続に s0 のほか val1、val2、val3、val4 が埋め込まれていてかなり複雑になっている。(そして動作が読みにくい)

実行させて、get-args が継続処理列 1 → 2 を再現し、さらに関数 y に引数リスト(1 2)をうまく渡せることを確認しよう。

λ1 を (λ(s)(s 1))、λ2 を (λ(s)(s 2)) として実行をすすめる。

((λ(s)(s 1))
   (λ(val1)
      ((λ(s)(s 2))
         (λ(val3)
            ((λ(val4) ((λ(val2) (s0 (cons val1 val2))) (cons val3 val4))) '()) )))))
  ↓
((λ(val1)
   ((λ(s)(s 2))
      (λ(val3)
	  ((λ(val4)((λ(val2)(s0(cons val1 val2)))(cons val3 val4)))'())))) 1)  ← ここで 1 実行
  ↓
((λ (s) (s 2))
    (λ(val3)
	  ((λ(val4)((λ(val2)(s0(cons 1 val2)))(cons val3 val4)))'())))
  ↓
((λ(val3)
	  ((λ(val4)((λ(val2)(s0(cons 1 val2)))(cons val3 val4)))'())) 2)  ← ここで 2 実行
  ↓
((λ(val4)((λ(val2)(s0 (cons 1 val2)))(cons 2 val4))) '())
  ↓
((λ(val2)(s0 (cons 1 val2)))(cons 2 '()))
  ↓
((λ(val2)(s0 (cons 1 val2))) '(2))
  ↓
(s0 (cons 1 '(2)))
  ↓
(s0 '(1 2))  ← ここで s0 実行

まあ大方の予想通りとなっている。λ2の複雑な継続処理のおかげで、最後が単純な(s0) でなく、(s0 '(1 2)) となっている。 引数を実行したあとの継続処理は、関数 y の実行である。つまり、s0 には (exec y) 的なものが渡される。結局

(exec y '(1 2))

みたいな感じになって、めでたく (y 1 2) が実行されるはずである。

最後に、この引数と 関数 y を合成する部分を確認しよう。 といっても、get-args に比べるととても簡単である。

これを処理するのは ② p.257 analyze-application である。

analyze-application の返すλパックを見てみよう。例によって、f と env は無視して、 s と val だけ追いかける。

(λ(s0)
  (pproc
    (λ (val1)
      (get-args aprocs
          (λ (val2) (execute-application val1 val2 s0))))))

こんな形である。pproc には、(λ(s) (s (lookup-variable-value 'y))))が渡される。(p.255 analyze-variableの結果) 。 aprocs は上で見たように、'(λ1 λ2) というリストが渡される。なので

(λ(s0)
  ((λ(s)(s (lookup-variable-value 'y))) 
    (λ (val1)
      (get-args '(λ1 λ2)  ← get-args は(1 → 2)の合成λパック
          (λ (val2) (execute-application val1 val2 s0))))))

となる。これは、((1 → 2) → y)というλパックの合成になっている。基本形と違って s0 の埋め込み部分に execute-application...という処理が追加されている。追加処理の効果を確かめるため、実行を追いかけよう。

と、その前に適当に y を定義しておく。

(define (y a b) (+ a b))

これを、amb評価器に渡すと、p.257 analyze-definition → p.256 analyze-lambda → p223 make-procedure という処理を経て、大域環境に (y ('procedure (a b) (+ a b)))というエントリが追加される。

で、元に戻って実行を進める。見やすくするために、lookup-variable-value は lookup、execute-application は exec と表記する。

(λ(s0) 
  ((λ(s)(s (lookup 'y)))  ← lookup は lookup-variable-value のこと 
    (λ(val1)
      (get-args '(λ1 λ2)
        (λ(val2) (exec val1 val2 s0))))))  ← exec は execute-application のこと
  ↓
((λ(s)(s (lookup 'y))) 
  (λ(val1)
    (get-args '(λ1 λ2)
      (λ(val2) (exec val1 val2 s0))))) 
  ↓
((λ(val1)
  (get-args '(λ1 λ2)
    (λ(val2) (exec val1 val2 s0)))) (lookup 'y)) ← ここで (lookup 'y) の実行
  ↓
((λ(val1) 
  (get-args '(λ1 λ2)
    (λ(val2) (exec val1 val2 s0)))) '('procedure (a b) (+ a b)) ) 
  ↓
(get-args '(λ1 λ2)
    (λ(val2) (exec '('procedure (a b) (+ a b)) val2 s0))) 
  ↓
((λ(val2) (exec '('procedure (a b) (+ a b)) val2 s0) '(1 2))  ← get-args の実行は上で追いかけたとおり。
  ↓
(exec '('procedure (a b) (+ a b)) '(1 2) s0)  

となって最終的に、(exec y '(1 2)) 的なものが実行される。

以上。

構文解析のプログラム例である。ここでは amb と require が、これまでと違った使いかたがされている。 例えば、require を単体で使ったり、amb の引数に amb や require を使ったりなどである。

require を単体で使った場合

...
require
...

require 失敗時の戻り先は、前に amb がないので、プログラムの先頭まで戻る。そのまま終了する。
require 成功時はそのまま下の式を実行して最後まで行って終了する。
この場合、駆動ループは(require false)を発行するが、やはり amb がないので先頭まで戻って終了するだけである。

本文には出てこないが amb を単体で使った場合

...
amb
...

プログラムはとりあえず最後まで実行して終了する。
その後、駆動ループが、(require false) を発行して、処理を amb に戻す。
これの繰り返し

つぎは、 amb の引数から require を実行するとき

(amb 1 (require1 ...) 2)
  ...
  (require2 ...)
  ...

ここで、amb が引数を遅延するかどうかについて、、、 amb は構文だが、引数は遅延する。バックトラックしたときに必要な引数のみ force する。

なお、amb評価器は、関数の引数は遅延しない。

require1 の失敗時の戻り先は、amb である。 amb は引数を遅延するから、amb を実行してから、require1 を実行するという順番になるから。
require2 の失敗時の戻り先は、amb である。

次に、 amb の引数から amb を実行するとき

(amb1 1 (amb2  10  20)  2)
  ...
  (require1 ...)
  ...

amb1 が 1 、2 を返しているときは、require1 の戻り先は amb1 である。
amb1 が amb2 を実行して 10 、20 を返しているときは、require1 の戻り先は amb2 である。 この場合、require1 の前に実行されているのは、amb2 だからである。
amb2 のリストが無くなったときの戻り先(バックアップ先)は、amb1 である。

結局、これは (amb1 1 10 20 2) と同じ探索をしたことになる。

つぎは、 amb の引数から amb と require を実行するとき

(amb1 1 (amb2  10 (require2 ...) 20)  2)
  ...
  (require1 ...)
  ...

require2 の戻り先は amb2 である。
require1 の戻り先は、上と同じ
amb2の戻り先(バックアップ先)も、上と同じ

次に、parse-verb-phrase の動作の解析

再帰関数になっているので、最初の2, 3回の動作を確認する

(parse-verb-phrase)
  ↓
(maybe-extend (parse-word verb))
  ↓
(amb '('verb eats) (thunk (maybe-extend (list '('verb eats) (parse-prepostional-phrase)))))

ここで見やすくするために、'('verb eats) は動詞と書き、(parse-prepostional-phrase)は前置詞句と書く、また thunk は省略する。あと (list 動詞 前置詞句) は 動詞＋前置詞句と書く。

(parse-verb-phrase)
...
  ↓
(amb 動詞 (maybe-extend 動詞＋前置詞句))
  ↓
(amb 動詞 (amb 動詞＋前置詞句 (maybe-extend 動詞＋前置詞句+前置詞句)))
  ↓
(amb 動詞 (amb 動詞＋前置詞句 (amb 動詞＋前置詞句＋前置詞句 (maybe-extend ...))))
...

という感じになる。これは、

動詞句 = 動詞 + [前置詞句]*

という構文解析の実装そのものである。

Ex. 4.45

この章で作られた構文解析の文法は以下の通りである。

文 = 動詞句 + 名詞句
動詞句 = 動詞 + [前置詞句]*
名詞句 = 単純名詞句 + [前置詞句]*
前置詞句 = 前置詞 + 名詞句
単純名詞句 = 冠詞 + 名詞
名詞 = student | professor | cat | class
動詞 = studies | lectures | eats | sleeps
冠詞 = the | a
前置詞 = for | to | in | by | with

これを元に手作業で構文解析をすると

(①The professor) (② lectures) (③ to th students) (④ in the class) (⑤ with the cat)
1. ① + (② + (③ + (④ + ⑤)))
2. ① + (② + (③ + ④) + ⑤)
3. ① + (② + (③ + ④ + ⑤))
4. ① + (② + ③ + (④ + ⑤))
5. ① + (② + ③ + ④ + ⑤)

の5通り。

これ以外、例えば ① + (② + ((③ + ④) + ⑤)) は、((③ + ④) + ⑤) の部分に当てはまる文法がない。

Ex. 4.46

前問の文章、
(①The professor) (② lectures) (③ to th students) (④ in the class) (⑤ with the cat)
を構文解析してみる。

動詞句の解析、(parse-verb-phrase) の結果は、

(amb ② (amb ②+③ (amb ②+③+④ (amb ②+③+④+⑤  (mayby ..(require false).. ) ))))

という感じになる。amb が引数を、右から先に評価し、左にバックトラックしていくとすると、 この amb が辿る順序は、

1回目 ②+③+④+⑤
2回目 ②+③+④
3回目 ②+③
4回目 ②

となる。1回目 ②+③+④+⑤ が返されたときの文全体の解析結果は

①+(②+③+④+⑤)

となる。これは正しい。

2回目 ②+③+④ が返されたとき、文全体の解析結果は

①+(②+③+④)

となる。⑤はどこにもつかない。なぜなら、2回目 ②+③+④ が返されたとき、*unparsed* は空になっているからだ。⑤は1回目に解析されたとき *unparsed* から消されているからだ。なお、2回目の②+③+④の部分は、maybe の引数で与えられている。*unparsed*から取り出すのではない。

結局 *unparsed* が空なので、構文解析は終了し、⑤なしの間違った結果になる。正しくは①+(②+③+(④+⑤)) という結果にならないといけない。

amb が右から左に評価する場合、⑤を*unparsed*から取り出す操作が各回で必要になってしまう。しかし、*unparsed*から⑤を取り出せるのは1回だけなので、うまくいかない。

*unparsed* から語を取り出せるのは1回だけということを考慮してプログラムを作らないといけない。こんな考慮が必要なのは、amb が処理を戻すとき、大域変数を元に戻さないためである。

Ex. 4.38

まだ amb 評価器が実装されていないので、図を描いて解くことにする。

人間がやるので、当然ツリーの枝刈りを実施する。 枝刈りが効果的になるように、なるべく条件の多い人物を左側にもってくる。

こんな感じ。解は5組ある。

Ex. 4.39

最初の問について。条件の順番を変えたからと言って、解が変化することはない。同じである。
あたりまえの感じだが、一応証明。

(証)

1. プログラムは、ツリーを全部調べて、条件がすべてTRUEになる解を全部見つける。①
2. 条件の順番を入れかえたプログラムを作った場合、このプログラムも、 ツリーを全部調べて、条件がすべてTRUEになる解を全部見つける。②

ここで、①と②の解は同じでないと仮定する。例えば①の解Aが②の解になっていないとする。
②の解でないということは、解Aは、②の順番でならんだ条件のうちのどれかでFALSEになるということである。しかし、順番を変えても、TRUEだった条件がFALSEに変わることはない(条件の交換則)、ので解Aは②の順番でならんだ条件の全てでTRUEである。仮定から矛盾する2つの結論が得られたので、この仮定は間違っている。①と②の解は同じである。

次の問いは、計算効率についてである

ここでの amb と require の並び

amb1
amb2
amb3
amb4
amb5
  require1
  require2
  require3
  require4
  require5
  require6
  require7

こうなっている。この場合、条件の順番を変えたところで、枝刈りは発生しないので、探索するツリーの大きさは変わらない。なので、効率は変わらない。同じである。

なお、require1～require7の適用は、ANDと同じなので、しょっちゅう偽になる条件を上のほうにしたほうが若干効率が上がる。しかし、これはツリーの枝刈りとは関係ない話。

Ex. 4.40

今度は、ツリーの枝刈りをするよう工夫しろという問題である。

ツリーの枝刈りは、amb と require を入れ子にすれば実現できる。

amb1
  require1
  amb2
  amb3
  amb4
  amb5
    require2
    require3
    require4
    require5
    require6
    require7

こうすると、require1 が失敗すると、require1以下の行は実行されずに amb1 がバックトラックする。つまり require1 の失敗時は、amb2～amb5 は探索を実施しない。これは require1 でツリーを枝刈りしたことになる。

なので、枝刈りをする効率のよいプログラムは、こんな風になる。

(define (multiple-dwelling)
  (let ((fletcher (amb 1 2 3 4 5)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (let ((cooper (amb 1 2 3 4 5)))
      (require (not (= cooper 1)))
      (require (not (= (abs (- fletcher cooper)))))
      (let ((miller (amb 1 2 3 4 5)))
        (require (> miller cooper))
        (let ((baker (amb 1 2 3 4 5)))
          (require (not (= baker 5)))
          (let ((smith (amb 1 2 3 4 5)))
            (require (not (= (abs (- smith flethcer)))))
            (require (distinct? (list baker cooper fletcher miller smith)))
            (list 'fletcher fletcher 'cooper cooper 
                  'miller miller 'baker baker 'smith smith)))))))

amb と require だけ抜き出すと

amb of fletcher
  require
  require
  amb of cooper
    require
    require
    amb of miller
      require
      amb of baker
        require
        amb of smith
          require
          require

こんな感じになっている。

Ex. 4.41

方針: 2.2.3章のフィルタを使う。可能な居住リストを作って、条件でフィルターする。

居住リストというのは、こういうの

( (1 1 1 1 1) (1 1 1 1 2) (1 1 1 1 3) ... )

これを、...bakerさんは5階には住まない...などの条件でフィルタする。プログラムはこんな感じ

(define (filter ... p.66

(define (enumerate-tree ... p.67

(define (flatmap ... p.71

; リスト2つからペアのリストつくる
; (1 2) と (1 2) → ( (1 1) (1 2) (2 1) (2 2) )
(define (pairs lst1 lst2)
  (map enumerate-tree 
       (flatmap (lambda (i) (map (lambda (j) (list i j)) lst1)) lst2)))

; 5以下の整数を4つ掛けて120になるのは 2*3*4*5 しかないので
(define (distinct? lst)
  (and (= (apply * lst) 120)
       (= (apply min lst) 1)))

;居住条件
(define (dwelling? x)
  (let ((baker (car x))
        (cooper (cadr x))
        (fletcher (caddr x))
        (miller (cadddr x))
        (smith (car (cddddr x))))
    (and (distinct? (list baker cooper fletcher miller smith))
         (not (= baker 5))
         (not (= cooper 1))
         (not (= fletcher 5))
         (not (= fletcher 1))
         (> miller cooper)
         (not (= (abs (- smith fletcher)) 1))
         (not (= (abs (- fletcher cooper)) 1)))))

;居住リスト
(define dwelling-list 
  (pairs (pairs (pairs (pairs '(1 2 3 4 5) '(1 2 3 4 5)) 
                       '(1 2 3 4 5)) 
                '(1 2 3 4 5)) 
         '(1 2 3 4 5)))

;居住リストを居住条件でフィルタする
(filter dwelling? dwelling-list)

この問題の意図は、amb評価器は、ストリームを利用しても実装できるということである。4.3.3章では、継続を利用してamb評価器を実装している。しかし、この問題のように amb式をストリームに置き換えるようなamb評価器を作ることも可能な感じがする。実際、4.4章の質問システムはストリームで作っている。

Ex. 4.42

うその条件の表現は、条件を or でつなげばいいだけ。

(A or B) and (C or D)...とする。AとBはどちらかが本当でどちらかが嘘、CとDはどちらかが本当でどちらかが嘘、、、という風に。解は、(A or B)=TRUE 、 (C or D)=TRUE 、、、となるから、ちょうどうまく本当の条件だけを辿ってくる。

なお、require を縦にならべるのは、条件をANDでつないでいるのと同じこと。

プログラムは、

(let ((betty (amb 1 2 3 4 5))
      (ethel (amb 1 2 3 4 5))
      (joan (amb 1 2 3 4 5))
      (kitty (amb 1 2 3 4 5))
      (mary (amb 1 2 3 4 5)))
  (require (or (= kitty 2) (= betty 3)))
  (require (or (= ethel 1) (= joan 2)))
  (require (or (= joan 3) (= ethel 5)))
  (require (or (= kitty 2) (= mary 4)))
  (require (or (= mary 4) (= betty 1)))
  (list 'betty betty 'ethel ethel 'joan joan 'kitty kitty 'mary mary))

となる。なお各人が2つとも本当のことを言ったり、2つとも嘘を言ったりしないことは 問題文で保証されているから、プログラムではそれを考慮する必要はない。 むしろ、問題文が仕様とするなら、仕様通り、正確に、各人は1つの本当と1つの嘘を言うという前提でプログラムを作るべきである。

Ex. 4.43

いかに amb が高性能といえども、さすがに自然言語の問題文を、そのままプログラムに入力するわけにはいかない。やはり人間様がある程度整理してあげないといけない。

娘候補は5人いる、Mary, Gabrielle, Lorna, Rosalind, Melissa である。

父親候補も5人、Downing, Hall, Barnacle, Paker, Moor である。

"ヨットを持っている"というのは、プログラムに必要な条件ではない。 他にもいろいろ書かれているが、使う条件は、"一人づつ娘を持つこと"、"ヨットの名前" と "Moore父娘の苗字" の件だけである。

(let ((father-of-mary (amb 'downing 'hall 'barnacle 'paker 'moor))
      (father-of-gabrielle (amb 'downing 'hall 'barnacle 'paker 'moor))
      (father-of-lorna (amb 'downing 'hall 'barnacle 'paker 'moor))
      (father-of-rosalind (amb 'downing 'hall 'barnacle 'paker 'moor))
      (father-of-melissa  (amb 'downing 'hall 'barnacle 'paker 'moor)))
  (require (eq? father-of-mary 'moor))
  (require (not (eq? father-of-gabrielle 'barnacle)))
  (require (not (eq? father-of-lorna 'moor)))
  (require (not (eq? father-of-rosalind 'hall)))
  (require (not (eq? father-of-melissa 'downing)))
  (require (eq? father-of-melissa 'barnacle))
  (require (not (eq? father-of-gabrielle 'parker)))
  (require (distinct? father-of-mary
                      father-of-gabrielle
                      father-of-lorna
                      father-of-rosalind
                      father-of-melissa)
  (list 'father-of-lorna father-of-lorna)) 

問題文の最後の条件、"Gabrielleの父親はParker博士の娘の名前をつけたヨットを持つ"という条件についての説明、、、

とりあえず、そのまま書き下してみる。Parker博士の娘をAとして

(and (eq? father-of-A 'parker) (not (eq? father-of-A father-of-gabrielle)))

となる。A を娘5人で展開すると

(or (and (eq? father-of-mary 'parker) (not (eq? father-of-mary father-of-gabrielle)))
    (and (eq? father-of-gabrielle 'parker) (not (eq? father-of-gabrielle father-of-gabrielle)))
    (and (eq? father-of-lorna 'parker) (not (eq? father-of-lorna father-of-gabrielle)))
    (and (eq? father-of-rosalind 'parker) (not (eq? father-of-rosalind father-of-gabrielle)))
    (and (eq? father-of-melissa 'parker) (not (eq? father-of-melissa father-of-gabrielle))))

となる。これをこのままプログラムに組み込んでも良いが、少し整理してみる。

式をよく見ると、問題の他の条件や、恒等式により真偽が決まっている部分式がある。

(not (eq? father-of-mary father-of-gabrielle)) = TRUE ← 5人の父親は別々の娘を持つという条件より
(not (eq? father-of-gabrielle father-of-gabrielle)) = FALSE ← 恒等式
...

とかである。これらの真偽の決まった式をTRUE、FALSEと置き換えて整理すると、

(or (eq? father-of-mary 'parker)
    (eq? father-of-lorna 'parker)
    (eq? father-of-rosalind 'parker)
    (eq? father-of-melissa 'parker))

となる。これは、Gabrielle以外の娘のうちの誰かの父親がParkerであるということである。 それは、即ち、Gabrielleの父親はParkerではないというのと同じことである。

(not (eq? father-of-gabrielle 'parker))

ということで、最終的にこの条件をプログラムの条件として使っている。

次に、プログラムの効率良くする。効率を良くするには、ツリーを枝刈りすることである。 枝刈りは amb と require を入れ子にして実現する。その際、なるべく効きそうな条件を上の方に持ってくると効果的である。

(let ((father-of-mary (amb 'downing 'hall 'barnacle 'paker 'moor)))
  (require (eq? father-of-mary 'moor))
  (let ((father-of-melissa  (amb 'downing 'hall 'barnacle 'paker 'moor)))
    (require (eq? father-of-melissa 'barnacle))
    (require (not (eq? father-of-melissa 'downing)))
    (let ((father-of-gabrielle (amb 'downing 'hall 'barnacle 'paker 'moor)))
      (require (not (eq? father-of-gabrielle 'barnacle)))
      (require (not (eq? father-of-gabrielle 'parker)))
      (let ((father-of-lorna (amb 'downing 'hall 'barnacle 'paker 'moor))
            (father-of-rosalind (amb 'downing 'hall 'barnacle 'paker 'moor)))
        (require (not (eq? father-of-lorna 'moor)))
        (require (not (eq? father-of-rosalind 'hall)))
        (require (distinct? father-of-mary
                            father-of-gabrielle
                            father-of-lorna
                            father-of-rosalind
                            father-of-melissa)
        (list  'father-of-lorna father-of-lorna)))))

Mary ann と Mooreの苗字が同じという条件が無い場合は、上のプログラムから

  (require (eq? father-of-mary 'moor))

を削除すればよい。

Ex. 4.44

こまの座標を amb で表して、こまの置き場所の制限を require で書き下せばよい。

こまの置き場所の制限： ｘ 座標がバラバラであること。ｙ座標がバラバラであること。斜め座標１がバラバラであること。斜め座標2がバラバラであること。の4つ

(let ((queen1-x (amb 1 2 3 4 5 6 7 8))
      (queen1-y (amb 1 2 3 4 5 6 7 8))
      (queen2-x (amb 1 2 3 4 5 6 7 8))
      (queen2-y (amb 1 2 3 4 5 6 7 8))
      (queen3-x (amb 1 2 3 4 5 6 7 8))
      (queen3-y (amb 1 2 3 4 5 6 7 8))
      (queen4-x (amb 1 2 3 4 5 6 7 8))
      (queen4-y (amb 1 2 3 4 5 6 7 8))
      (queen5-x (amb 1 2 3 4 5 6 7 8))
      (queen5-y (amb 1 2 3 4 5 6 7 8))
      (queen6-x (amb 1 2 3 4 5 6 7 8))
      (queen6-y (amb 1 2 3 4 5 6 7 8))
      (queen7-x (amb 1 2 3 4 5 6 7 8))
      (queen7-y (amb 1 2 3 4 5 6 7 8))
      (queen8-x (amb 1 2 3 4 5 6 7 8))
      (queen8-y (amb 1 2 3 4 5 6 7 8)))
  (require (distinct? queen1-x queen2-x queen3-x queen4-x 
                      queen5-x queen6-x queen7-x queen8-x))
  (require (distinct? queen1-y queen2-y queen3-y queen4-y 
                      queen5-y queen6-y queen7-y queen8-y))
  (require (distinct? (+ queen1-x queen1-y) (+ queen2-x queen2-y) 
                      (+ queen3-x queen3-y) (+ queen4-x queen4-y)
                      (+ queen5-x queen5-y) (+ queen6-x queen6-y) 
                      (+ queen7-x queen7-y) (+ queen8-x queen9-y)))
  (require (distinct? (- queen1-x queen1-y) (- queen2-x queen2-y) 
                      (- queen3-x queen3-y) (- queen4-x queen4-y)
                      (- queen5-x queen5-y) (- queen6-x queen6-y) 
                      (- queen7-x queen7-y) (- queen8-x queen9-y)))
  (list (list queen1-x queen1-y)(list queen2-x queen2-y)
        (list queen3-x queen3-y)(list queen4-x queen4-y)
        (list queen5-x queen5-y)(list queen6-x queen6-y)
        (list queen7-x queen7-y)(list queen8-x queen8-y))) 

斜め座標は、

斜め座標1 = x + y
斜め座標2 = x - y 

となる。式の形は、45°回転の座標変換だが、図をみればそんな解釈も特に必要ない。

もっと大きい盤にしたい場合は、Ex. 4.35(p.248)で作った an-integer-between を使って

...
(queen1-x (an-integer-between 1 30))
(queen1-y (an-integer-between 1 30))
...

などどすればよい。なお、クィーンのこまの数は8個固定で、盤が大きくなってもこまの数は増やす必要はない。

あと、上のプログラムでｘ座標、y座標、斜め座標1、斜め座標2の条件を別々に固めてしまっているが、これで大丈夫なのか？ということについて、、、

エイトクィーンのルールの通りに条件を書き下すと、(こまの数を3つに減らして書く)

こうなる。一方、プログラムで使った条件を書き下すと

となる。エイトクィーンの条件は重複した部分があるので、それを整理すると、プログラムで使った条件と同じになる。