プログラミング再入門

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

SICP 4.3.2 Examples of Nondeterministic Programs

LISP Scheme

ノート

非決定論的プログラムの例。
組み合わせ生成とフィルタリングする部分をシステム側に隠す事で、プログラムはより抽象化されて問題をストレートに表現出来る。

Logic Puzzles

『ニコリ』の推理パズル。
プリミティブにequal?を足してmemberを定義。absもプリミティブに足して実行。

;;; Amb-Eval input:
(define (require p) (if (not p) (amb)))
(define (member obj lst)
  (cond ((null? lst) #f)
        ((equal? obj (car lst)) lst)
        (else (member obj (cdr lst)))))
(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))
(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

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

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

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

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem ;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(multiple-dwelling)
;;; Amb-Eval input:

解は一つしか無いらしい。

Exercise 4.38
;;; Amb-Eval input:
(define (require p) (if (not p) (amb)))
(define (member obj lst)
  (cond ((null? lst) #f)
        ((equal? obj (car lst)) lst)
        (else (member obj (cdr lst)))))
(define (distinct? items)
  (cond ((null? items) true)
        ((null? (cdr items)) true)
        ((member (car items) (cdr items)) false)
        (else (distinct? (cdr items)))))
(define (multiple-dwelling)
  (let ((baker (amb 1 2 3 4 5))
        (cooper (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller (amb 1 2 3 4 5))
        (smith (amb 1 2 3 4 5)))
    (require
     (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

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

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

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

;;; Starting a new problem ;;; Amb-Eval value:
ok
;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem ;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(multiple-dwelling)
;;; Amb-Eval input:

解は５個見つかる。

Exercise 4.39

全てのrequireは一塊に書いてあり、各条件はANDで結合されているのと等価なので、その順番によって答えが変わる事は無い。
requireに渡している条件式の評価に時間が掛かるものがある場合、その順番によって計算時間に影響がある。
テキストの例では一番時間が掛かると思われるdistinct?が最初に来ていて、これは全ての組み合わせに対して呼び出される。このdistinct?の呼び出し回数を減らす方が計算時間は短くなる筈。

ambevalの時間を計れる様にして試してみる。
distinct?を呼び出す回数を測りたいのだがset!はバックトラックが起きるともとの値に戻してしまうので計測が出来ない。
元のコードで計測。

;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
9380.698974609375 [msec]
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:

凡そ9.4秒掛かっている。
distinct?を最後にする。

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

実行結果

;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
3460.27490234375 [msec]
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:

凡そ3.5秒にまで速くなった。

元のコードではdistinct?を呼び出す回数は55=3125回。
これがbacker!=5、cooper!=1、fetcher!=5、fetcher!=1、miller>cooperだけで、4×4×3×3×5=720回に減り、更に二つの条件で減っている筈である。

これまたtry-againに掛かった時間を計測するのが難しいので、ここでは最初の解が見つかる所までの時間しかはかれなかった。

Exercise 4.40

distinct?の手前では55=3125通り。distinct?によって絞られて5!=120通り。

It is very inefficient to generate all possible assignments of people to floors and then leave it to backtracking to eliminate them.

veryかどうかの判断は難しいが、バックトラックに時間が掛かっている様であれば組み合わせの回数を減らすべき。

却下される事が予め分かっている様な組み合わせは最初から作らない方が得策。
baker!=5なので(amb 1 2 3 4)で良い。
cooperも同じく(amb 2 3 4 5)。
fletcherは(amb 2 3 4)。
millerはcooperより上の階なので(amb 3 4 5)、そうするとcooperは(amd 2 3 4)。
cooperが2では無い時には無駄な候補を生成してしまうので、cooperの階数からan-integer-betweenで生成する。
smithの条件はややこしいのでrequireを残すしか無い。
fletcherとcooperは互いが2階と4階の組み合わせが生成されるので、この組み合わせを却下する為にrequireは残す必要がある。
これでプログラムを作り直すと。

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

実行する。

;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
1005.8408203125 [msec]
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
943.3330078125 [msec]
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
(multiple-dwelling)

;;; Starting a new problem 
966.682861328125 [msec]
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again

25439.947021484375 [msec]
;;; There are no more values of
(multiple-dwelling)
;;; Amb-Eval input:

１秒前後くらいで答えが出るので10倍くらい速くなった。

based upon generating only those possibilities that are not already ruled out by previous restrictions.

と言う意味ではmillerの部分しか応えていない。そもそも自明な部分を最初から削除するだけで随分速くなる。

Exercise 4.41

2.2.3のNested Mappingsで登場するpermutationsを利用する。これで1〜5の全ての組み合わせを生成する。この組を(backer cooper fletcer miller smith)の住んでいる階を表しているものとして条件でフィルターする。最初の組み合わせの時点で重複は無いのでdistinct?の条件は不要。

(define (multiple-dwelling)
  (define (backer a) (car a))
  (define (cooper a) (cadr a))
  (define (fletcher a) (caddr a))
  (define (miller a) (cadddr a))
  (define (smith a) (cadddr (cdr a)))
  (filter (lambda (a)
            (and (not (= 5 (backer a)))
                 (not (= 1 (cooper a)))
                 (not (= 5 (fletcher a)))
                 (not (= 1 (fletcher a)))
                 (> (miller a) (cooper a))
                 (not (= (abs (- (smith a) (fletcher a))) 1))
                 (not (= (abs (- (fletcher a) (cooper a))) 1))))
          (permutations '(1 2 3 4 5))))

実行結果

> (multiple-dwelling)
'((3 2 4 5 1))
> (map (lambda (name floor) (list name floor))
       '(backer cooper fletcher miller smith)
       (car (multiple-dwelling)))
'((backer 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
>
Exercise 4.42

Kittyは2番、Maryは4番との記述しか無いが、これが正しいとは限らない。同様にそれぞれ自分の順位と他人一人の順位を述べているが、どちらの記述が正しいかは分からないので、記述から取り得る順位を絞り込むのは難しそう。
次に記述のどちらかしか正しくない事をどう表現するのかと考えたら、xorを使ってrequireすれば良いらしい。条件が二つとも揃ったらfalseで、どちらか片方だけtrueの時にtrueになる。
R5RSにxorは無い様だが、Racketにはあるのでちょっと甘えてプリミティブに登録。

(define (lairs)
  (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 (xor (= kitty 2) (= betty 3)))
    (require (xor (= ethel 1) (= joan 2)))
    (require (xor (= joan 3) (= ethel 5)))
    (require (xor (= kitty 2) (= mary 4)))
    (require (xor (= mary 4) (= betty 1)))
    (require
     (distinct? (list betty ethel joan kitty mary)))
    (list (list 'Betty betty)
          (list 'Ethel ethel)
          (list 'Joan joan)
          (list 'Kitty kitty)
          (list 'Mary mary))))

プログラムは全く問題文そのままなので驚く。付け足したのは『当たり前だけど必要』なdistinct?のみ。
実行結果。

;;; Amb-Eval input:
(lairs)

;;; Starting a new problem ;;; Amb-Eval value:
((Betty 3) (Ethel 5) (Joan 2) (Kitty 1) (Mary 4))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(lairs)
;;; Amb-Eval input:

Ethelが一番の大嘘つき。

Exercise 4.43

問題文をそのままrequireの条件文に翻訳してみると

    (require (eq? (father 'Mary-Ann) 'Moore))
    (require (not (eq? (daughter 'Moore) (yacht-name 'Moore))))
    (require (not (eq? (daughter 'Downing) (yacht-name 'Downing))))
    (require (not (eq? (daughter 'Hall) (yacht-name 'Hall))))
    (require (not (eq? (daughter 'Barnacle) (yacht-name 'Barnacle))))
    (require (not (eq? (daughter 'Parker) (yacht-name 'Parker))))
    (require (eq? (yacht-name 'Barnacle) 'Gabrielle))
    (require (eq? (yacht-name 'Moore) 'Lorna))
    (require (eq? (yacht-name 'Hall) 'Rosalind))
    (require (eq? (yacht-name 'Downing) 'Melissa))
    (require (eq? (father 'Melissa) 'Barnacle))
    (require (eq? (yacht-name (father 'Gabrielle)) (daughter 'Parker)))

こんな感じ。
このfather、yacht-name、daughterの3つの関数がサポート出来るデータ構造を考える。

(define (find proc lst)
  (cond ((null? lst) #f)
        ((proc (car lst)) (car lst))
        (else (find proc (cdr lst)))))
(define (assq obj lst)
  (find (lambda (f) (eq? (car f) obj)) lst))

(define (lornas-father)
  (let ((data (list (list 'Moore    (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa)))
                    (list 'Downing  (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa)))
                    (list 'Hall     (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa)))
                    (list 'Barnacle (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa)))
                    (list 'Parker   (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa))))))
    (define (daughter name) (car (car (cdr (assq name data)))))
    (define (yacht-name name) (car (cdr (car (cdr (assq name data))))))
    (define (father name) (car (find (lambda (f) (eq? (car (car (cdr f))) name)) data)))
    (require
     (distinct? (list (daughter 'Moore) (daughter 'Downing) (daughter 'Hall) (daughter 'Barnacle) (daughter 'Parker))))
    (require (eq? (father 'Mary-Ann) 'Moore))
    (require (not (eq? (daughter 'Moore) (yacht-name 'Moore))))
    (require (not (eq? (daughter 'Downing) (yacht-name 'Downing))))
    (require (not (eq? (daughter 'Hall) (yacht-name 'Hall))))
    (require (not (eq? (daughter 'Barnacle) (yacht-name 'Barnacle))))
    (require (not (eq? (daughter 'Parker) (yacht-name 'Parker))))
    (require (eq? (yacht-name 'Barnacle) 'Gabrielle))
    (require (eq? (yacht-name 'Moore) 'Lorna))
    (require (eq? (yacht-name 'Hall) 'Rosalind))
    (require (eq? (yacht-name 'Downing) 'Melissa))
    (require (eq? (father 'Melissa) 'Barnacle))
    (require (eq? (yacht-name (father 'Gabrielle)) (daughter 'Parker)))
    (father 'Lorna)))

ただ、これは流石に無駄が多くいつまで経っても実行が終わらない。
分かりきっている条件は削る。

(define (lornas-father)
  (let ((data (list (list 'Moore    (list 'Mary-Ann 'Lorna))
                    (list 'Downing  (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) 'Melissa))
                    (list 'Hall     (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) 'Rosalind))
                    (list 'Barnacle (list 'Melissa 'Gabrielle))
                    (list 'Parker   (list (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa) (amb 'Mary-Ann 'Gabrielle 'Lorna 'Rosalind 'Melissa))))))
    (define (daughter name) (car (car (cdr (assq name data)))))
    (define (yacht-name name) (car (cdr (car (cdr (assq name data))))))
    (define (father name) (car (find (lambda (f) (eq? (car (car (cdr f))) name)) data)))
    (require
     (distinct? (list (daughter 'Moore) (daughter 'Downing) (daughter 'Hall) (daughter 'Barnacle) (daughter 'Parker))))
    (require (not (eq? (daughter 'Downing) (yacht-name 'Downing))))
    (require (not (eq? (daughter 'Hall) (yacht-name 'Hall))))
    (require (not (eq? (daughter 'Barnacle) (yacht-name 'Barnacle))))
    (require (not (eq? (daughter 'Parker) (yacht-name 'Parker))))
    (require (eq? (yacht-name (father 'Gabrielle)) (daughter 'Parker)))
    (father 'Lorna)))

実行結果。

;;; Amb-Eval input:
(lornas-father)

;;; Starting a new problem ;;; Amb-Eval value:
Downing
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
Downing
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
Downing
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
Downing
;;; Amb-Eval input:
try-again
;;; There are no more values of
(lornas-father)
;;; Amb-Eval input:

何か条件を削り過ぎたのか、他の部分の解は確認していないが、この結果は4通りの解があるが、何れにしてもLornaの父はDowningである。

Exercise 4.44

色々と使えない標準手続きがあるのでExercise 2.42とは少し違う解き方をする。

  1. ボードのサイズを引数に開始
  2. 一つの列を作る手続きを呼ぶ
    1. an-integer-betweenを使ってクイーンの位置を決める←ここがamb
    2. その位置からの手筋にそれまでに置いたクイーンが乗っていないかをチェックする←ここがrequire
    3. （手筋に乗っていなければ）その列の位置として再帰する

と言う考え方。
手筋のチェック（safe）も単純で、１列ずつ戻りながら手筋にクイーンが乗っていないかをチェックするだけ。orの構文を作っていないのでcondで条件を全部並べる。

(define (safe? pos board)
  (define (attack a b c board)
    (if (null? board)
        #t
        (let ((q (car (cdr (car board)))))
          (cond ((= a q) #f)
                ((= b q) #f)
                ((= c q) #f)
                (else (attack (- a 1) b (+ c 1) (cdr board)))))))
  (attack (- pos 1) pos (+ pos 1) board))
  
(define (queens n)
  (define (add-row k board)
    (if (= k 0)
        board
        (let ((pos (an-integer-between 1 n)))
          (require (safe? pos board))
          (add-row (- k 1)
                   (cons (list k pos)
                         board)))))
  (add-row n null))

実行結果

;;; Amb-Eval input:
(queens 4)

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

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

;;; Starting a new problem ;;; Amb-Eval value:
((1 5) (2 3) (3 1) (4 6) (5 4) (6 2))
;;; Amb-Eval input:
(queens 7)

;;; Starting a new problem ;;; Amb-Eval value:
((1 6) (2 4) (3 2) (4 7) (5 5) (6 3) (7 1))
;;; Amb-Eval input:
(queens 8)

;;; Starting a new problem ;;; Amb-Eval value:
((1 4) (2 2) (3 7) (4 3) (5 6) (6 8) (7 5) (8 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((1 5) (2 2) (3 4) (4 7) (5 3) (6 8) (7 6) (8 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((1 3) (2 5) (3 2) (4 8) (5 6) (6 4) (7 7) (8 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((1 3) (2 6) (3 4) (4 2) (5 8) (6 5) (7 7) (8 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((1 5) (2 7) (3 1) (4 3) (5 8) (6 6) (7 4) (8 2))
;;; Amb-Eval input:

４×４で鏡像関係を含めて2解、５×５では10解。８×８でもそれぞれの解は数秒程度で出て来る。96解もあるので以下省略。

Parsing natural language

自然言語処理。
名詞、動詞、冠詞のリストを用意。
文章は以下の様に表現出来る。

(sentence (noun-phrase (article the) (noun cat))
          (verb eats)

これは手続き呼び出しではなく全部シンボルのリスト。
文をパースする手続きparse-sentenceは「シンボルsentenceと名詞句、動詞をパースした結果」と定義する。
名詞句をパースする手続きparse-noun-phraseは「シンボルnoun-phraseと、冠詞、名詞をパースした結果」と定義する。
パースを始める時に文章は*unparsed*にセットされる。
parse-wordは*unparsed*の先頭の単語をword-listから見つけて、その品詞と見つけた単語をリストにする。ここ迄の所ambのバックトラックは使っていない。
自前でmemqを定義して実行してみる。

;;; Amb-Eval input:
(parse '(the cat eats))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun cat)) (verb eats))
;;; Amb-Eval input:

parse-sentenceの(parse-word verbs)の部分を(parse-verb-phrase)に拡張。

parse-verb-phrase内のmaybe-extendは最初は(parse-word verbs)の結果（期待しているのは('verb 'eats)とか）をambの候補として、失敗したらタグをverb-phraseに切り替えて、引数としてprepositional-phraseのパース結果を加えてmaybe-extendを呼び直す。prepositional-phraseは前置詞+名詞で一致したものが返って来るので、この部分は動詞で終わっているか、オプションとして「前置詞付きの目的語」にも一致する様になっている。

名詞句も同様に前置詞付きの形容詞句をオプショナルで付ける。

;;; Amb-Eval input:
(parse '(the student with the cat sleeps in the class))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))) (verb-phrase (verb sleeps) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))
;;; Amb-Eval input:
(parse '(the professor lectures to the student with the cat))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures to the student with the cat))
;;; Amb-Eval input:

二つ目の文章は、二つの解釈が出来る事が示されている。動詞「lectures」に一塊の名詞句「to the student with the cat」が付いていると言う解釈と、動詞句「lectures to the student」に副詞句「with the cat」が付いていると言う解釈。

Exercise 4.45

実行結果。

;;; Amb-Eval input:
(parse '(the professor lectures to the student in the class with the cat))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures to the student in the class with the cat))
;;; Amb-Eval input:

括弧を整理すると
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb-phrase
(verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student))))
(prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))
(prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
|

要は目的語部分のグルーピングの問題。
lecturesの目的語はto the studentのみ。それに副詞句in the classが付き全体で動詞句を形成。その動詞句にwith the catと言う副詞句が付く。『教授は教室で猫を抱きながら生徒に教える。』

(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student))))
  (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class))
                                      (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))

目的語は変わらないが、in the classとwith the catが一つの副詞句になっている。『教授は猫が住んでる教室で生徒に教える。』

(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb-phrase (verb lectures)
               (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student))
                                                   (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))))
  (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))

目的語としてto the studentとin the classがグループになった。『教授は猫を抱きながら教室内にいる生徒に教える。』

(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb lectures)
  (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student))
                                                   (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))
                                      (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))

目的語全体がthe student in the classとwith the catの両方にtoが付く形。『教授は教室内の生徒と猫に教える』

(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb lectures)
  (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student))
                                      (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) 
                                                                          (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))))))

the studentと言う目的語にin "the class with the cat"と言う副詞句。『教授は猫がいる教室にいる生徒に教える。』

Exercise 4.46

parse-sentence等で解釈後のリストを形成する時にparse-***と言う手続きを引数に並べているが、この引数の並びは文章に単語、あるいは句が出現する順番に一致しているので左から順に評価しないと文章が解釈出来ない。

Exercise 4.47

一旦は普通に解釈して、try-againが呼ばれて別の解釈をしようとして(parse-word verbs)が失敗したときが問題。ambは構文なので既にambの解釈に入っているので、(parse-word verbs)が失敗すると次に(parse-verb-phrase)を呼び出してしまう。これはまた(parse-word verbs)を呼び出して失敗してと無限ループに陥る。
元の定義では(phase-word verbs)がamb構文に入る前に呼ばれているので、ここで失敗するともっと前迄バックトラックする。
amb内の式の順番を入れ替えると、parse-verb-phaseに入って来ると最初にまた無条件にparse-verb-phraseを呼んでしまうので明らかに無限ループに陥る。

;;; Amb-Eval input:
(parse '(the cat eats))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun cat)) (verb eats))
;;; Amb-Eval input:
try-again
. . user break
>

返って来ない。
順番を入れ替える。

(define (parse-verb-phrase)
  (amb (list 'verb-phrase
             (parse-verb-phrase)
             (parse-prepositional-phrase))
       (parse-word verbs)))

こういう事か？
動かしてみる。

;;; Amb-Eval input:
(parse '(the cat eats))

;;; Starting a new problem . . user break
>

最初から全然返って来ない。

Exercise 4.48

副詞の追加は以下の通り。

(define (parse-verb-phrase)
  (define (maybe-extend verb-phrase)
    (amb verb-phrase
         (maybe-extend (list 'verb-phrase
                             verb-phrase
                             (parse-adverb-phrase)))))
  (maybe-extend (parse-word verbs)))

(define (parse-adverb-phrase)
  (amb (parse-word adverbs)
       (parse-prepositional-phrase)
       (list 'adverb-phrase
             (parse-word adverbs)
             (parse-prepositional-phrase))))

(define adverbs '(adverb enthusiastically))

動作確認。

;;; Amb-Eval input:
(parse '(the professor lectures))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb lectures))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures))
;;; Amb-Eval input:
(parse '(the professor lectures in the class))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures in the class))
;;; Amb-Eval input:
(parse '(the professor lectures enthusiastically))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (adverb enthusiastically)))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures enthusiastically))
;;; Amb-Eval input:
(parse '(the professor lectures enthusiastically in the class))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (adverb enthusiastically)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (adverb-phrase (adverb enthusiastically) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures enthusiastically in the class))
;;; Amb-Eval input:

形容詞の追加。

(define (parse-simple-noun-phrase)
  (amb (list 'simple-noun-phrase
             (parse-word articles)
             (parse-word nouns))
       (list 'noun-with-adjective
             (parse-word articles)
             (parse-word adjectives)
             (parse-word nouns))))

(define adjectives '(adjective smart cute little))

動作確認。

;;; Amb-Eval input:
(parse '(the cat eats))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun cat)) (verb eats))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the cat eats))
;;; Amb-Eval input:
(parse '(the cute cat eats))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (noun-with-adjective (article the) (adjective cute) (noun cat)) (verb eats))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the cute cat eats))
;;; Amb-Eval input:
(parse '(the cute cat in the class eats))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (noun-phrase (noun-with-adjective (article the) (adjective cute) (noun cat)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (verb eats))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the cute cat in the class eats))
;;; Amb-Eval input:

複合文。andで繋いでもう一つ文章がある形。

(define (parse-sentence)
  (define (maybe-extend sentence)
    (amb sentence
         (maybe-extend (list 'compound-sentence
                             sentence
                             (parse-word conjunctions)
                             (parse-single-sentence)))))
  (maybe-extend (parse-single-sentence)))

(define (parse-single-sentence)
  (list 'sentence
         (parse-noun-phrase)
         (parse-verb-phrase)))

(define conjnctions '(conjunction and))

動作確認

;;; Amb-Eval input:
(parse '(the professor lectures))

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun professor)) (verb lectures))
;;; Amb-Eval input:
(parse '(the professor lectures and the cat eats))

;;; Starting a new problem ;;; Amb-Eval value:
(compound-sentence (sentence (simple-noun-phrase (article the) (noun professor)) (verb lectures)) (conjunction and) (sentence (simple-noun-phrase (article the) (noun cat)) (verb eats)))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(parse '(the professor lectures and the cat eats))
;;; Amb-Eval input:

まぁ、この文法では駄目パターンが沢山ある訳だが。。。

Exercise 4.49

parse-wordはword-listの一致した単語をリストにして返していたが、word-listの中から順に選んで返す様にする。

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

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(compound-sentence (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(compound-sentence (compound-sentence (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies))) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(compound-sentence (compound-sentence (compound-sentence (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies))) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies))) (conjunction and) (sentence (simple-noun-phrase (article the) (noun student)) (verb studies)))
;;; Amb-Eval input:

複合文が延々と続くので、複合文無しにする。


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

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb-phrase (verb studies) (adverb enthusiastically)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb-phrase (verb-phrase (verb studies) (adverb enthusiastically)) (adverb enthusiastically)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb-phrase (verb-phrase (verb-phrase (verb studies) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb-phrase (verb-phrase (verb-phrase (verb-phrase (verb studies) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (simple-noun-phrase (article the) (noun student)) (verb-phrase (verb-phrase (verb-phrase (verb-phrase (verb-phrase (verb studies) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)) (adverb enthusiastically)))
;;; Amb-Eval input:

どうも、maybe-extendがあるとそこから抜け出せなくなる。

parse-sentenceとparse-noun-phaseを最初のに戻してみる。


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

;;; Starting a new problem ;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun student)) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun student)) (verb lectures))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun student)) (verb eats))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun student)) (verb sleeps))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun professor)) (verb studies))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun professor)) (verb lectures))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(sentence (noun-phrase (article the) (noun professor)) (verb eats))
;;; Amb-Eval input:

まぁこんな感じか。