SICP 4.2.2 Ex. 4.27 Ex. 4.28 Ex. 4.29 Ex. 4.30 Ex. 4.31

  • 投稿日:
  • カテゴリ:

Ex. 4.27

(define w (id (id 10)))
;;; L-Eval input:
count
;;; L-Eval value:
<応答> 1

define は関数でなく、構文である。従って引数を遅延したりしない。(id (id 10))は即座に評価され、結果がwに割り付けられる。

で、(id (id 10)) の評価だが、今度は id が関数なので引数は遅延される。つまり内側の (id 10) はthunk化されるだけで実行されない、外側の id は、この thunk を引数に貰って実行される。

外側のid の実行時に count が +1 される。また実行結果は (thunk (id 10)) である。これが w に割り付けられる。

;;; L-Eval input:
w
;;; L-Eval value:
<応答> 10
;;; L-Eval input:
count
;;; L-Eval value:
<応答> 2

w に割り付けられた値 (thunk (id 10)) は、画面表示の際に force されるので、(id 10)の実行結果 10 が表示される。このとき、count は +1する。

Ex. 4.28

引数が関数の場合を考慮している。あまりいいサンプルではないが、こんなメタ関数を考える。

(define (f g) (g 1))

f を使ってみる。

(f  (lambda (x) (+ x 1)) )

これを評価すると、引数を遅延して(つまり thunk化して)、f を評価し、 結果こうなる。

((thunk (lambda (x) (+ x 1))) 1)

このように、引数が関数の場合、演算子に thunk がつく。これを評価すると、apply でこける。こけないように、演算子の thunk をとりたいのだが、eval では thunk をとることはできない。それで、actual-value を使って thunk を取っている。

Ex. 4.29

ありきたりだが、n! を計算する関数を考えてみる

(define (factorial n)
  (if (= n 0)
      1
      (* n (factorial (- n 1))))))

引数 n が関数の本体の3箇所で使われている。 引数 n は3回計算されるのである。もし n がメモ化されているなら、 3回のうち2回はメモで済むことになり、実行が早くなる。

実際 (factorial 3) を実行した場合の展開の様子を追ってみると

(factorial 3)
   ↓
...
   ↓
(* 3 (factorial (- 3 1)))
   ↓
(* 3 
   (if (= (thunk (- 3 1)) 0)
       1
       (* (thunk (- 3 1)) (factorial (- (thunk (- 3 1)) 1))))
   ↓
...

となる。太字はもともと1つの引数であり、同一のオブジェクトである。 これが、3箇所に現れて計算されている。メモ化されているなら計算の手間を2回省くことができる。(正確には引数3もthunk化されるが、説明のため(- 3 1)だけthunk化した)

注意すべきは、関数の返り値 (factorial 2) とかがメモ化されるということではないことである。メモ化機能は、thunk に関する機能であり、thunk 化されるのは関数の引数だけである。結局、メモによる省力化は、関数の引数に効くのである。

次の問題

(define (square x)
  (* x x))
;;; L-Eval input:
(square (id 10))
;;; L-Eval value:
<応答> 100  ← メモ化しても、しなくても同じ

;;; L-Eval input:
count
;;; L-Eval value:
<応答> 1 ← メモ化
<応答> 2 ← メモ化しないとき

最初のsquare の評価結果は、

(* (thunk (id 10))  (thunk (id 10)))

となる。太字は、2箇所に現れているが、元々1つの引数だったので、同一のオブジェクトである。* は基本手続きなので、引数は直ちに force され、結果が掛け算される。

メモ化してる場合、
左の(thunk (id 10)) は実行されて10が返る。このときcount + 1 を実行する。
右の(thunk (id 10)) はメモの10が返る。このとき count は変わらない 。

メモ化しない場合、
左の(thunk (id 10)) は実行されて10が返る。このときcount + 1 を実行する。
右の(thunk (id 10)) は実行されて10が返る。このときcount + 1 を実行する。

Ex. 4.30

まず Cy さんの心配は何かをハッキリさせる。

(define (f x)
  (g x)
  (h x))

という関数を考えてみる。で、(f 1)を実行すると、

(f 1)
  ↓
( (g (thunk 1))  ← ①
  (h (thunk 1)))  ← ②

となる。返り値は ② である。 返り値②は呼び出し側でforce される可能性があるが、 途中式の①は thunk化されたまま、force される機会はない。

つまり、途中式①が表示や代入の副作用を持っていたとしても、発動する機会がないことになる。 これが Cy さんの心配である。

また Cy さんは、これを改良するために、途中式①を eval ではなく、 actual-value で評価しようと主張している。

a. Benさんのfor-eachを見てみる

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

begin の中の①式が途中式となっている。この for-each を使った例は、

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

となる。これを評価すると、途中式①は

( (lambda (x) (newline)(display x)) (car items) )

となる。評価は再帰的に行われるので、これがさらに eval で評価される。結局

( (newline) (display (thunk (car items))) )

となる。newline は引数がないので、そのまま実行されて改行表示する。 また、display は基本手続きなので、引数は直ちに force されて、結果が表示される。

ここで注意は、遅延評価は引数を遅延(thunk化)するが、関数の本体はすぐに実行するのである。あくまで引数を遅延するだけで、本体の実行を遅延する訳ではない。

付け加えて、関数が基本手続きの場合は、引数の遅延も行わない。むしろ直ちに 引数を force して関数本体を実行する。

ということで、この例では、①は途中式だったのに、 基本関数ということで、うまく force されたのである。

b. 今度は途中式が基本関数でない場合である。
関数 p1 の中の(set! ・・・) が途中式になっている。
関数 p2 の中の e が途中式になっている。

(p1 1)を評価すると

(p1 1)
  ↓
( (set! x (cons x:(thunk 1) '(2))) 
  x )

となる。太字は変な書き方だが、変数 x には (thunk 1) が割り当てられていることを示しているつもりである。

(set! ・・・) は途中式となるが、set! は関数ではなく構文なので、引数を遅延しないし、 さらに、consは基本関数なので、これは引数を force する。結局この途中式は完全に実行されて、実行結果 (1 2) が x に代入される。なので最終的に返される値は

(1 2)

となる。Cyさんの改良を入れた場合も途中式を実行すだけなので同じ結果である。 次に (p2 1) を評価すると、

(p2 1)
  ↓
(p (set! x (cons x:(thunk 1) '(2)))) ← p は引数を遅延する
  ↓
( (thunk (set! x (cons x:(thunk 1) '(2)))) ← 途中式。実行されない。
  x:(thunk 1) )

今回は、Cy さんの心配どおり、途中式が実行されない。x には(thunk 1) が割り当てられたままである。なので、最終的に返される値は

1

となる。Cyさんの改良をいれた場合、途中式が実行されるので、最終的に返される値は

(1 2)

となる。

c. a.の例は、たまたま基本関数 display を使っているので、eval で評価したときも遅延しない。actual-value で評価した場合はもちろん遅延しない、どちらにしても遅延しないので結果は同じになる。

d. Cyさんの動作のほうがまし。 上の例 (p2 1) で (1 2) が返るのが自然。1が返るのは俄かには理解しがたい。

しかし、Cyさんの方法にも難点はあり、結局、どちらの方式も実はあまりうまくない。

本文の方式の難点は、途中式は評価されない、ということをプログラム中に考慮しなければならず難しいということである。

一方Cyさんの方式の難点は、途中式を force するので引数の遅延が破れる。つまり途中式で使われる引数は遅延しない、使われない引数はそのまま遅延される。ということをプログラム中に考慮しなければならず、やっぱりこっちも難しいのである。

ということで、残念ながら、どちらの方式もややこしい。

ここでの例では、(thunk (set! ...)) を引数に渡すことによってこの難点が表面化しているので、引数に (set! xxx) を渡さないようにして、回避するのがいいかもしれない。

Ex. 4.31

関数定義の仮引数に修飾子がついた場合に評価器を対応させる問題である
(なお、この問題は、前問 Ex. 4.30 とは何の関係もない)

考慮すべきは以下の2点。

  1. 仮引数は、環境に登録する際の変数名に使われるので(b lazy)みたいなリストのままでは不味い。
  2. なので、lazy とかは取って、(f a b c d) としてしまうわけであるが、あとで評価するときに lazy などの条件を使いたいので、取った lazy をどこかに保存しておかないといけない

上の2つ目の保存場所であるが、一番修正が少なくなるよう考慮して、procedure 文の中に入れるのがましなように思われる。

元々の procedure 文 はこんな形をしている。

(procedure (x y) ((+ x y)) the-global-environment) 

これを、こんな風に変える。

(procedure (x y) (() lazy) ((+ x y)) the-global-environment) 

なお、この procedure 文を生成する元の関数は

(define (f x (y lazy))
  (+ x y))

である。実装は、まず239頁辺りの遅延のための評価器の修正をした上で、以下のコードを追加する。少し長い、、

;; make procedure
(define (make-procedure parameters body env)
  ;; unmodify parameter ex. (x lazy) -> x
  (define (unmodify a)
    (if (symbol? a) a (car a)))
  ;; take modifier ex. (x lazy) -> lazy
  (define (modifier a)
    (if (symbol? a) '() (cadr a)))
  (let ((p (map unmodify parameters))
        (m (map modifier parameters)))
        ;; procedure format: (procedure (x y) (() lazy) ((* x y)) the-global-environment)
        (list 'procedure p m body env)))

(define (procedure-body p) (cadddr p))

(define (procedure-parameters p) (cadr p))

(define (procedure-environment p) (car (cddddr p)))

(define (procedure-modifier p) (caddr p))

(define (apply procedure arguments env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedures 
          procedure 
          (list-of-arg-values arguments env)))
        ((compound-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters procedure)
           (list-of-delayed-args arguments 
                                 (procedure-modifier procedure) ;; changed
                                 env)
           (procedure-environment procedure))))
        (else
         (error
          "Unknown procedure type -- APPLY" procedure))))

(define (delay-memo-it exp env)
  (list 'thunk-memo exp env))

(define (list-of-delayed-args exps modifier env)
  (if (no-operands? exps)
      '()
      (let ((m (first-operand modifier))
            (o (first-operand exps)))
        (cons (cond ((eq? m 'lazy)
                     (delay-it o env))
                    ((eq? m 'lazy-memo)
                     (delay-memo-it o env))
                    ((null? m)
                     (actual-value o env))
                    (else (error "Unkonwn modifier -- LIST-OF-DELAYED-ARGS" m)))
            (list-of-delayed-args (rest-operands exps)
                                  (rest-operands modifier)
                                  env)))))

(define (thunk-memo? obj)
  (tagged-list? obj 'thunk-memo))

(define (force-it obj)
  (cond ((thunk-memo? obj)
         (let ((result (actual-value
                        (thunk-exp obj)
                        (thunk-env obj))))
           (set-car! obj 'evaluated-thunk)
           (set-car! (cdr obj) result)
           (set-cdr! (cdr obj) '())
           result))
        ((evaluated-thunk? obj)
         (thunk-value obj))
        ((thunk? obj)
         (actual-value (thunk-exp obj)(thunk-env obj)))
        (else obj)))

こんな感じ。