SICP 4.3.2

4.45

The professor lectures to the student in the class with the cat

和訳と英語の対応がややこしいのでいったんまとめる。

文　sentence ::= verb-phrase + noun-phrase
動詞句　verb-phrase ::= verb + prep-phrase
名詞句　noun-phrase ::= simple-noun-phrase + prep-phrase
前置詞句　prep-phrase ::= preposition + noun-phrase
単純名詞句　simple-noun-phrase ::= article + noun
名詞　noun ::= student|professor|cat|class
動詞　verb ::= studies|lectures|eats|sleeps
冠詞　article ::= the|a
前置詞　preposition ::= for|to|in|by|with

1. the professor
2. lectures
3. to the students
4. in the class
5. with the cat

として構文解析すると以下のようになる。 なお、意訳すると差分が不明瞭になるので直訳する。

(1) 1 + (2 + (3 + (4 + 5)))

教授は 生徒(教室(猫が居る)にいる)に 教える

(2) 1 + (2 + (3 + 4) + 5)

教授は 生徒(教室に居る)に 猫と教える

(3) 1 + (2 + (3 + 4 + 5))

教授は 生徒(教室に猫といる)に 教える

(4) 1 + (2 + 3 + (4 + 5))

教授は 教室(猫が居る)で 生徒に 教える

(5) 1 + (2 + 3 + 4 + 5)

教授は 猫と 教室で 生徒に 教える

4.46

unparsed から car で先頭要素を取り出して評価しているため、 amb も先頭要素から順に評価するようにしないと正しく動作しない。

構文解析器が、被演算子を右から左へ評価する場合を考える。

(define (parse input)
  (set! *unparsed* input)
  (let ((sent (parse-sentence)))
    (require (null? *unparsed*))
    sent))

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

ここまでは特に問題なし。

parse-noun-phrase で問題が起きる。

(define (parse-noun-phrase)
  (define (maybe-extend noun-phrase)
    (amb noun-phrase
         (maybe-extend (list 'noun-phrase
                             noun-phrase
                             (parse-prepositional-phrase)))))
  (maybe-extend (parse-simple-noun-phrase)))

  (define (parse-simple-noun-phrase)
    (list 'simple-noun-phrase
          (parse-word articles)
          (parse-word nouns)))

左から右に評価する場合は noun-parse が先に評価される。これは問題ない（本文中の動き）。 右から左に評価する場合は、 maybe-extend が先に評価される。 maybe-extend の中では、 parse-prepositional-phraseが評価される。

(define (parse-prepositional-phrase)
  (list 'prep-phrase
        (parse-word prepositions)
        (parse-noun-phrase)))

ここで、 parse-word により unparsed が更新され、空になってしまうと、

(require (null? *unparsed*))

に引っかからなくなってしまい、後続のパターンが評価できなくなってしまう。

4.47

parse-verb-phrase が無限ループするため終了しない。

Louis の定義

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

は、まず parse-word が評価される。

(define (parse-word word-list)
  (require (not (null? *unparsed*)))
  (require (memq (car *unparsed*) (cdr word-list)))
  (let ((found-word (car *unparsed*)))
    (set! *unparsed* (cdr *unparsed*))
    (list (car word-list) found-word)))

word-list には verbs が渡されるので、 unparsed の先頭要素が動詞であれば (list verb 見つけた動詞) が返され、 unparsedにはcdr(見つけた動詞を除いた残りの文)が set! される。 unparsed の先頭要素が動詞以外の場合は require にヒットしないので ambの次の要素が評価される。（unparsedは更新されない） しかし、amb の次の要素は parse-verb-phrase であるため、最初に戻ってまた unparsed が動詞外の場合に入ってしまう。 結果、無限ループになるのでプログラムは終了しない。

4.48

副詞(adverb)句、形容詞(adjective)句をそれぞれ追加する。

(define adverbs '(adverb 副詞を列挙))
(define adjectives '(adjective 形容詞を列挙))

副詞句は、 parse-adverb-phrase を追加し、parse-verb-phrase から呼び出す。

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

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

形容詞句は、 parse-simple-article-phrase と parse-article-phrase に追加。

(define (parse-simple-article-phrase)
  (list 'simple-article-phrase
        (parse-word articles)
        (parse-word adjectives)))

(define (parse-article-phrase)
  (define (maybe-extend article-phrase)
    (amb article-phrase
         (maybe-extend (list 'article-phrase
                             article-phrase
                             (parse-word adjectives)))))
  (maybe-extend (parse-word articles)))

4.49

unparsed を処理していた部分で単語を出力するようにする。

(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (amb (cdr items))))

(define (parse-word word-list)
  (list (car word-list)
        (an-element-of (cdr word-list))))

(define (generate-sentence)
  (parse-sentence))

動作するambの実装がまだないので出力分は省略。

SICP 4.3.1-4.3.2

4.35

(define (an-integer-between low high)
  (require (< low high)
  (amb low (an-integer-between (+ low 1) high))

4.36

3.69では　3つの値すべてに integersを入れて、filterによってすべての三角形を見つけようとしていた。 http://syagi.hatenablog.com/entry/2017/07/22/211415

問題文でも同じように

define (a-pythagorean-triple-starting-from low)
  (let ((i (an-integer-starting-from low)))
    (let ((j (an-integer-starting-from i)))
      (let ((k (an-integer-starting-from j)))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

とすると、 kが無限のため、 i と j の再試行が永遠に行われない。 そのため、 i と j を有限にして、 kがj、jがiの範囲を決定するようにする。 (iやjの範囲をtryし終えたら、上位のambが範囲を更新する )

(define (a-pythagorean-triple-starting-from low)
  (let ((k (an-integer-starting-from low)))
    (let ((i (an-integer-between low k)))
      (let ((j (an-integer-between i k)))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

4.37

形として、 4.35は

amb1
amb2
amb3
require1

4.37(Ben)は

amb4
amb5
require2
require3

という形になっている。 requireの数が異なるが、評価しなければいけない可能性の数は amb1,2,3 で出来る木 vs amb4,5 で出来る木 となる。

木の大きさは後者の方が小さいので、Benの方が効率が良い。

4.38

各人の可能性は | Baker | 1 | 2 | 3 | 4 | | Cooper | | 2 | 3 | 4 | 5 |(Fletherと隣接しない)| | Flether | | 2 | 3 | 4 | |(Cooperと隣接しない)| | Miller | | | 3 | 4 | 5 |(Cooperより上)| | Smith | 1 | 2 | 3 | 4 | 5 |

Fletcherが可能性が一番少ないのでここを起点に解く

|F|2| |4| | | |C|4| |2| | | |M|5| |3|5| | |B|1|2|1|1|3| |S|2|1|5|3|1|

5通り

4.39

順序は解に影響しない。 条件の順番が変わっても、木の枝を切り落とす順序が変わるだけで、全体としてできあがる木は同じになるため。

解を見出す時間には影響する。 影響としては、偽が多く発生する条件が前にある方が効率よくなる。 （require評価がANDなので、後段の評価が不要となる。) ただし、評価する木の大きさが変わるわけではないのでおそらく僅差。 （現時点では実行できないので検証はしない）

よって効率の良いプログラムは

(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 (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

直感的には3.37とだいぶ異なるが、人間はそもそもすべての可能性を考慮しないためだと思われる。 （無意識に distinctしてるし、 fletcherは 2 3 4 しか考慮しない）

4.40

一瞬日本語でおｋ・・・と思ったが

前半部

要求前はすべての人が全ての階を選びうるので、 階数^人数 要求語は順列問題になるので、 階数P人数 = 階数!/人数!

後半部

階を選択する前に制限を課す = requireに合致したときだけ amb を評価する　なので

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

3.38で自分が評価した順番と同じになったので気持ちいい。 ちなみに an-integer-between とか使えばもっと減る？かと思ったが、 結局内部でrequireを呼ぶので意味がないと気づいた。

4.41

5人が取り得る組み合わせをfilterする。 順列を生成する部分は省略。 https://qiita.com/nakataSyunsuke/items/15c151ea88a44e7c4a8e あたりが流用できるはず

;居住条件
(define (dwelling? x)
  (let ((baker (car x))
        (cooper (cadr x))
        (fletcher (caddr x))
        (miller (cadddr x))
        (smith (car (cddddr x))))
    (and
         (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
  permutations '(1 2 3 4 5))
;https://qiita.com/nakataSyunsuke/items/15c151ea88a44e7c4a8e

(filter dwelling? dwelling-list)

4.42

女子生徒なのに彼ら、という訳。

以下の前提を置く - 5人全員が本当のことをいっている場合以外は矛盾が生じて順位が重複する。 (例えば全員が順位を1つずつずらして言えば矛盾が生じなくなってしまうが、そういうケースはそんざいしないと仮定)

各自の発言を xor で結び、それをANDでつなげて、矛盾が起きなかった組み合わせが真実。 （はじめ orでつなげば良いかと思ったが、両方真実になってしまうケースが出る）

(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)))
  (list 'betty betty 'ethel ethel 'joan joan 'kitty kitty 'mary mary))

4.43

父,娘 (Moore, MaryAnn) (Barnacle, Melissa) ; not Downing (g_father, Gabrielle) ; not Barnacle, Parker (l_father, Lorna) ; not Moore (r_father, Rosalind) ; not Hall

条件を整理して

(let ((father-of-mary (amb 'downing 'hall 'barnacle 'paker 'moor))
  (require (eq? father-of-mary 'moor)) ; maryの姓が不明ならここを削除
  (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 'parker)))
      (require (not (eq? father-of-gabrielle 'barnacle)))
      (let ((father-of-rosalind (amb 'downing 'hall 'barnacle 'paker 'moor)))
         (require (not (eq? father-of-rosalind 'hall)))
         (let ((father-of-lorna (amb 'downing 'hall 'barnacle 'paker 'moor)))
           (require (not (eq? father-of-lorna 'moor)))
           (require (distinct? father-of-mary
                      father-of-gabrielle
                      father-of-lorna
                      father-of-rosalind
                      father-of-melissa)
  (list 'father-of-lorna father-of-lorna))

4.44

座標の順列を用意して、 requireで同じ動線に配置されないようにすれば良い 縦横は単に x y の distinct 斜めは x y の和（右上から左下）、差（左上から右下）のdistinct

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

SICP 4.2.2-4.2.3

4.27

(define count 0)

(define (id x)
  (set! count (+ count 1))
  x)

(define w (id (id 10)))

;;; L-Eval input:
count
;;; L-Eval value:
1

;;; L-Eval input:
w
;;; L-Eval value:
10

;;; L-Eval input:
count
;;; L-Eval value:
2

ちなみに作用的順序の場合は wを定義した時点で (id (id 10))がすべて評価されるので、 count は最初から2になる

4.28

4.29

フィボナッチ数の計算

(square (id 10)) の評価

メモ化なし

;;; L-Eval input:
(square (id 10))
;;; L-Eval value:
100
;;; L-Eval input:
count
;;; L-Eval value:
2

メモ化あり

;;; L-Eval input:
(square (id 10))
;;; L-Eval value:
100
;;; L-Eval input:
count
;;; L-Eval value:
1

4.30

a

問題中の式

(define (for-each proc items)
  (if (null? items)
      'done
      (begin (proc (car items))
             (for-each proc (cdr items)))))

(for-each (lambda (x) (newline) (display x))
          (list 57 321 88))

最初のbeginまで評価すると

(begin ((lambda(x) (newline) (display x)) 57)
       (for-each (lambda(x) (newline) (display x))
                 '(321 88)))

ここで、元々の評価器なら、newlineがevalされ、displayがforceされる。 つまり、　(改行) 57 と印字される。 以下同じ繰り返しなので、正しく動く。 Benの場合もこの場合は同じ。

b

(define (p1 x)
  (set! x (cons x '(2)))
  x)

(define (p2 x)
  (define (p e)
    e
    x)
  (p (set! x (cons x '(2)))))

元々の場合 p1は基本手続きなので遅延無く評価されるため、 (p1 1) は　(1 2) を出力する。

p2の p は複合手続きなので引数(set! x (cons x '(2))が遅延され実行されない。

Ｃｙの場合は、両方評価される。 (p2 1) は (1 2) を出力する。

c

すべて基本手続きを使っており、元々遅延していないから

d

好きかどうかと言われても・・・

4.31

lazy や lazy-memo を解釈する処理を追加する。 lazyやlazy-memo月居ていた場合にそれぞれ別のタグをつけておいて、 force-itで解釈して処理を分岐する。

実装する気力が無かったのでカンニング。 いくつか実装方針がある模様。

http://sioramen.sub.jp/blog/2008/02/sicp-422.html

では、 仮引数がpair であればその中をみてタグをつける

wat-aro.hatenablog.com

では、procedure文の形を変えて中に保存している。 コードの変更は後者のが少ないが、実装的には前者のがわかりやすい気がした。

4.32

ググったところ、 car部も遅延されているので未定義の関数を格納したリストを定義できる　らしい

4.33

クオートされた式を評価する機構が無いので、これを追加してやれば良い。 クオートをどう解釈するか一瞬悩んだが、quoted?ってのがあるらしい。

;eval に追加
((quoted? exp) (eval-quote exp env))
;前後は略

(define (eval-quote exp env)
  (if (list? (cadr exp))
      (eval (make-quotation-list (cadr exp)) env)
      (cadr exp)))

(define (make-quotaiton-list obj)
   (if (null? obj)
       '()
       (let ((first-list (car obj))
             (rest-list  (cdr obj)))
            (list 'cons
                  (list 'quote first-list)
                  (make-quotation-list rest-list)))))

3.34

何のことか分からなかったのでカンニング。

http://wat-aro.hatenablog.com/entry/2016/01/10/204424

が、ちょっとついていけなかった。

SICP 4.1.7-4.2.1

4.22

問題4.6では、 let->combinationを実装することで実現している。 ここでも同じアプローチを使う。

let->combination は 4.6 で定義済みなので、 analyze手続きに 以下を追記する

(define (analyze exp)
  (cond ((self-evaluating? exp)
         (analyze-self-evaluating exp))
         ;;(中略)
        ((let? exp) (analyze (let->combination exp))) ;; 追記
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

4.23

本文の定義

(define (analyze-sequence exps)
  (define (sequentially proc1 proc2)
    (lambda (env) (proc1 env) (proc2 env)))
  (define (loop first-proc rest-procs)
    (if (null? rest-procs)
        first-proc
        (loop (sequentially first-proc (car rest-procs))
              (cdr rest-procs))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
        (error "Empty sequence -- ANALYZE"))
    (loop (car procs) (cdr procs))))

Alyssaの定義

(define (analyze-sequence exps)
  (define (execute-sequence procs env)
    (cond ((null? (cdr procs)) ((car procs) env))
          (else ((car procs) env)
                (execute-sequence (cdr procs) env))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
        (error "Empty sequence -- ANALYZE"))
    (lambda (env) (execute-sequence procs env))))

並びが一つの場合

本文の実装

loop に評価される rest-procs がnilになる。 そのため、 first-procそのものが返ってくる。

alyssaの実装

lambda式 (lambda (env) (execute-sequence procs env))　が返ってくる

並びが2つの場合

本文の実装

説明しにくいが、 loopによって 順次 sequectially 手続きが適用された lambda 式が返ってくる 要は 各式に対して (loop (sequentially first-proc (car rest-procs)) (cdr rest-procs)))) によって、 (lambda (env) (proc1 env) (proc2 env))) が順次適用された結果が返ってくる。

alyssaの実装

1つの場合と同じなので、 式のリスト(procs)が含まれた lambda式 (lambda (env) (execute-sequence procs env))　が返ってくる

2つの比較

まとめると、 本文の実装は

(begin
 <procA>
 <procB>
 <procC>)

のような入力に対して、

(lambda (env)
  (lambda (env)
    (lambda (env) (<eval-procA> env))
    (<eval-procB> env))
  (<eval-procC> env))

という手続きが作られる。

Alyssaの場合は

(labmda (env)
  (execute-sequence
    (list
      (lambda (env) (<eval-procA> env))
      (lambda (env) (<eval-procB> env))
      (lambda (env) (<eval-procC> env)))))

という手続きになる。 この結果、個々のシーケンスの解釈が実行時に都度行われてしまう。

つまり本文にある

lambda式の解析は, 効率に大きな利益をもたらす: lambdaの評価の結果の手続きが多数回作用されようとも, lambda本体は一回だけ解析される.

この恩恵が失われてしまうことになる。

4.24

試してないが、未分離のモノより分離したモノの方が、構文解析の処理が減る分早くなるはず。

4.25

停止しない。

作用的順序では n=1の場合にも (factorial (- n 1)) を評価してしまうため、再帰が終わらない。

正規順序の場合、 n=1 のときには　(factorial (- n 1)) が評価されないので、正常動作する。

4.26

unless->if を作って実装する

; analyze に ((unless? exp) (analyze (unless->if exp))) を追加

(define (unless? exp) (tagged-list? exp 'unless))

;;(unless condition usual-value exceptional-value)
(define (unless-condition exp) (cadr exp))
(define (unless-usual-value exp) (caddr exp))
(define (unless-exceptional-value exp)
  (if (null? (cdddr exp))
      #f ;; exceptional-valueを省略した場合
      (cadddr exp)))

;;(unless condition usual-value exceptional-value)
;;  ->  (if condition exceptional-value usual-value)
(define (unless->if exp)
  (make-if (unless-condition exp)
           (unless-exceptional-value exp)
           (unless-usual-value exp)))

SICP 4.1.6

4.16

a

(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
            (if (eq? '*unassigned* (car vars))
              (error "Unassigned variable --" var))
              (car vals))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

b

方針が思いつかなかったのでカンニング

(define (scan-out-defines body)
  (define (make-variable-clauses body)
    (if (definition? (car body))
        (cons (list (definition-variable (car body))
                    ''*unassigned*)
              (make-variable-clauses (cdr body)))
        '()))
  (define (definition->assignment-body body)
    (if (definition? (car body))
        (cons (make-assignment (definition-variable (car body))
                               (definition-value (car body)))
              (definition->assignment-body (cdr body)))
        body))
  (if (definition? (car body))
      (list (apply-in-underlying-scheme
             make-let
             (cons (make-variable-clauses body)
                   (definition->assignment-body body))))
      body))

c

実行回数が少なくなるので、make-procedure に組み込むべき。

組み込みは　引数の body にあらかじめ scan-out-defines を適用してやればok

(define (make-procedure parameters body env)
  (list 'procedure parameters (scan-out-defines body) env))

4.17

ギブ

4.18

(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)

本文中の掃き出し方だと

(define solve
  (lambda (f y0 dt)
     (let (( y '*unassigned*)
           (dy '*unassigned*))
          (set! y (integral (delay dy) y0 dt))
          (set! dy (stream-map f y))
          y)))

問題文の掃き出し方だと

(define solve
  (lambda (f y0 dt)
    (let ((y '*unassigned*)
          (dy '*unassigned*))
         (let ((a (integral (delay dy) y0 dt))
               (b (stream-map f y)))
              (set! y a)
              (set! dy b))
         y)))

本文中の掃き出し方は問題なし。

問題文の掃き出し方の場合、

(b (stream-map f y)))

この時点で anassigned の y が評価されてしまうので動かない.

4.19

議論対象の処理

(let ((a 1))
  (define (f x)
    (define b (+ a x))
    (define a 5)
    (+ a b))
  (f 10))

Benの主張

a -> 1
x-> 10
b -> + a x -> 11
a -> 5
(f 10) -> + a b -> 16

Alyysaの主張

(define b (+ a x))

の時点で、a が未定義のためエラーになる

Evaの主張

a -> 1
x -> 10
a -> 5, b -> + a x -> 15
(f 10) -> + a b -> 20

Schemeでは Alyysa の主張とおなじ結果になった。 ただ、define を数学的な「定義」と見なすなら、Evaの言う同時というのが自然な気もする。

Evaの主張に合わせて変更するとしたら、すべての define に delay を挿入すれば良い？ （define の時点で評価させないようにするため）

参考　URL　 http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E5%86%85%E9%83%A8define%E3%81%AE%E8%A9%95%E4%BE%A1%E9%A0%86

2.20

(letrec
  ((var1 exp1) (var2 expr2) ...)
  body)

は

(lambda <vars>
  (let ((var1 *unassigned*) (var2 *unassigned) ... )
    (set! var1 exp1)
    (set! var2 exp2)
    ...
    body))

と変換される。

よって

a

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
  ;; ...
  ((letrec? exp) (eval (letrec->let exp) env))
  ;; ...
  ))
(define (letrec? exp) (tagged-list? exp 'letrec))
(define (letrec-inits exp) (cadr exp))
(define (letrec-body exp) (cddr exp))
(define (letrec->let exp)
  (let ((vars (map car (let-inits exp)))
        (exps (map cdr (let-inits exp)))
        (body (let-body exp)))
       (cons 'let
         (cons (map (lambda(x) (list x ''*unassigned*)) vars)
               (append (map (lambda (x y) (cons 'set! (cons x y))) vars exps)
                       body)))))

b

let で 評価される環境には定義された関数自身が存在しないので、再帰的な定義が出来ない。

4.21

a

((lambda (n)
   ((lambda (fact)
      (fact fact n))
    (lambda (ft k)
      (if (= k 1)
          1
          (* k (ft ft (- k 1)))))))
 10)

ややこしいので (lambda (fact) (fact fact n)) を a (lambda (ft k) (if ... )) を b とすると

((lambda (n) (a b)) 10)
=> ((lambda (n) (b b n)) 10)
=> (b b 10)
=> (* 10 (b b 9))
=> (* 10 (* 9 (b b 8)))
...

フィボナッチ

((lambda (n)
   ((lambda (fib)
      (fib fib n))
    (lambda (ft k)
      (cond ((= k 0) 0)
            ((= k 1) 1)
            (else (+ (ft ft (- k 1)) (ft ft (- k 2))))))))
 5)

b

(define (f x)
  ((lambda (even? odd?)
     (even? even? odd? x))
   (lambda (ev? od? n)
     (if (= n 0) true (od? ev? od? (- n 1))))
   (lambda (ev? od? n)
     (if (= n 0) false (ev? ev? od? (- n 1))))))

SICP 4.1.3-5

4.11

教科書の実装ではフレームは

 ((var1 var2 var3) (val1 val2 val3))

となっているのを

((var1 val1) (var2 val2) (var3 val3))

と実装し直す。

#lang racket

;変更なし
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())

;変更あり
(define (make-frame variables values)
  (map cons variables values))

(define (make-binding var val) (cons var val))
(define (add-binding-to-fram! var val frame)
  (set! frame (cons (make-binding var val) frame)))
(define (first-binding frame) (car frame))
(define (rest-bindings frame) (cdr frame))
(define (binding-var binding) (car binding))
(define (binding-val binding) (car binding))
(define (set-binding-val! binding val) (set-cdr! binding val))

;frame-vars と frame-vals を定義しても良いが、こっちの方が綺麗なので直す
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan frame)
      (if (null? frame)
          (env-loop (enclosing-environment env))
          (let ((binding (first-binding frame)))
              (if (eq? var (binding-var binding))
                  (binding-val binding)
                  (scan (rest-bindings frame))))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan frame)
      (if (null? frame)
          (env-loop (enclosing-environment env))
          (let ((binding (first-binding frame)))
            (if (eq? var (binding-var binding))
                (set-binding-val! binding val)
                (scan (rest-bindings frame))))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan frame)
      (if (null? frame)
          (add-binding-to-frame! var val frame)
          (let ((binding (first-binding frame)))
            (if (eq? var (binding-var binding))
                (set-binding-val! binding val)
                (scan (rest-bindings frame))))))
    (scan frame)))

4.12

scan と env-loop を抜き出す。

どちらも、対応する bindingを見つけたらそれを返す。 見つけられなかったら #f を返す。

教科書の実装と4.11の実装、両方に対応する抽象化をしたかったが断念。。。

(define (env-loop env var)
   (if (eq? env the-empty-environment)
        #f
        (let ((result (scan (first-frame env) var)))
          (if (result)
              result ;binding
              (env-loop (enclosing-environment env) var)))))

(define (scan frame var)
   (if (null? frame)
       #f
       (let ((binding (first-binding frame)))
         (if (eq? var (binding-var binding))
             binding
             (scan (rest-bindings frame))))))

(define (lookup-variable-value var env)
  (let ((result (env-loop env)))
     (if result
         (binding-val result)
         (error "Unbound variable" var))))

(define (set-variable-value! var val env)
  (let ((result (env-loop env var)))
     (if result
         (set-binding-val! result val)
         (error "Unbound variable -- SET " var))))

(define (define-variable! var val env)
  (let ((result (scan (first-frame env) var)))
    (if (result)
        (set-binding-val! result val)
        (add-binding-to-frame! var val (first-frame env)))))

4.13

仕様を以下のように定める - 4.11 の実装をベースに行う - 渡された環境のみを操作する（外側の環境の変数は別の環境が依存している可能性があるので危険）

(define (unbind! var frame)
  (define (scan-to-unbind frame)
    (if (null? frame)
        (error "Unbound variable -- UNBOUND " var)
        (let ((binding (first-binding frame)))
           (if (eq? var (binding-var binding))
               (rest-bindings frame)
               (cons (binding (scan-to-unbind (rest-bindings frame))))))))
  (set! frame (scan-to-unbind frame)))

4.14

Louis がやったこと

(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
        (list 'map map) ;mapを基本手続きとして追加
        ))

mapの呼ばれ方は

(map proc args...)

だが、 procもargsも引数とリストとして受けとってしまうのでうまくいかない。

4.15

設問どおり、 halts? の存在を仮定して、以下の処理を考える。

; (define (halts? p a)
;    (if ((p a)が停止する)
;        #t
;        #f
(define (run-forever) (run-forever))

(define (try p)
  (if (halts? p p)
      (run-forever)
      'halted))

ここで、

(try try)

を評価すると、

1. (try try) が停止する場合 -> (halts try try) は 真 -> run-forever が実行されるため、(try try)は停止しない

2. (try try) が停止する場合 -> (halts try try) は 偽 -> 'halted が返却されるため、 (try try)は停止する

よって、矛盾が生じるため、背理法で hatls の存在は否定される。

SICP 4.1.1-2

4.1

もともとの list-of-values

(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (cons (eval (first-operand exps) env)
            (list-of-values (rest-operands exps) env))))

cons の引数をあらかじめ評価してやれば良いので

左から右

(define (list-of-values-left-to-right exps env)
  (if (no-operands? exps)
      '()
      (let ((first-eval (eval (first-operand exps) env)))
        (cons first-eval
              (list-of-values-left-to-right (rest-operands exps) env)))))

右から左

(define (list-of-values-right-to-left exps env)
  (if (no-operands? exps)
      '()
      (let ((first-eval (list-of-values-right-to-left (rest-operands exps) env)))
        (cons  (eval (first-operand exps) env)
               first-eval))))

4.2

もともとのeval

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))

Louisが修正したeval

(application? が assignment?の前に来る)

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        (else
         (error "Unknown expression type -- EVAL" exp))))

4.2a

(define x 3) に対する挙動

define を関数として認識してしまい、うまく動かないのではないか。

代入のシンボルをシンボルとして認識できず、関数として解釈してしまう。

4.2b

applicaiton で評価したいときは必ず call がつく、と前提できるので、applicationの処理を変える。

(define (application? exp)(tagged-list? exp 'call))

演算子についても callがつくので追従して直す。

具体的には、carにあるcallを無視するようにする。

(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))

4.3

パス

4.4

(define (eval-and exp env)
  (define (eval-and-iter exp result)
    (if (null? exp)
        result
        (let ((first-eval (eval (car exp) env)))
          (if (true? first-eval)
              (eval-and-iter (cdr exp) 'true)
              'false))))
  (eval-and-iter exp 'true))

(define (eval-or exp env)
  (if (null? exp)
      'false
      (let ((first-eval (eval (car exp) env)))
        (if (true? first-eval)
            'true
            (eval-or (cdr exp) env)))))

4.5

expand-clauses の if分作成前に => を含む構文を評価する

(define (expand-clauses clauses)
  (if (null? clauses)
      'false                          ; else節なし
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-else-clause? first)
            (if (null? rest)
                (sequence->exp (cond-actions first))
                (error "ELSE clause isn't last -- COND->IF"
                       clauses))
            (make-if (cond-predicate first)
                     (if (eq? (car (cond-actions first)) '=>)
                         (list (cadr (cond-actions first)) (cond-predicate first))
                         (sequence->exp (cond-actions first))
                     (expand-clauses rest))))))

4.6

#lang racket
(define (let? exp)
  (tagged-list? exp 'let))

;(let ((var1 exp1) (var2 exp2) ...) body)
(define (let-variables exp) (map car (cadr exp)))
(define (let-expressions exp) (map cdr (cadr exp)))
(define (let-body exp) (cddr exp))

;((lambda (var1 var2 ...) body) exp1 exp2 ...)
(define (let->combination exp)
   (if (null? (let-parameters exp))
       '()
       (cons
         (make-lambda (let-variables exp) (let-body))
         (let-expressions exp))))

4.7

(let* ((var1 exp1) (var2 exp2) ...) body)

は

(let ((var1 exp1))
  (let* ((var2 exp2) ...) body))

と展開できる。

よって

(define (let*->nested-lets exp)
  (define (iter params)
    (if (null? params)
        (let*-body exp)
        (make-let (car params) (iter (cdr params)))))
  (iter (let*->parameters exp)))

あるいは

(define (let*-parameters exp) (cadr exp))
(define (let*-body exp) (cddr exp))
(define (let*->nested-lets exp)
  (define (iter params result)
    (if (null? params)
        result
        (iter (cdr params)
              (make-let (list (car params)) result))))
  (iter (reverse (let*-parameters exp)) (let*-body exp)))

4.8

ギブ

4.9

ギブ

4.10

ギヴ