2013年5月12日日曜日

開発環境

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション)の1(手続きによる抽象の構築)、1.3(高階手続きによる抽象)、1.3.4(値として返される手続き)の問1.44、問1.45、問1.46を解いてみる。

その他参考書籍

問題 1.44.

コード

sample.scm

(define (compose f g)
  (lambda (x)
    (f (g x))))

(define (repeated f n)
  (if (= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define tolerance 0.00001)

(define (smooth f)
  (lambda (x) (/ (+ (f (- x tolerance))
                    (f x)
                    (f (+ x tolerance)))
                 3)))

(define (n-fold-smoothed f n)
  (repeated (smooth f) n))

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> 
; 平滑化しても変わらない関数なので結果は5、100
((n-fold-smoothed (lambda (i) i) 10) 5)
((n-fold-smoothed (lambda (i) i) 10) 100)

;Value: 5.

1 ]=> 
;Value: 100.

1 ]=>
; squareは平滑化する回数が増える程2における値が大きくなる手続き
((n-fold-smoothed square 1) 2)

;Value: 4.000000000066667

1 ]=> ((n-fold-smoothed square 2) 2)

;Value: 16.0000000006

1 ]=> ((n-fold-smoothed square 3) 2)

;Value: 256.0000000192667

1 ]=> ((n-fold-smoothed square 4) 2)

;Value: 65536.00000986461

1 ]=> ((n-fold-smoothed square 5) 2)

;Value: 4294967297.292974

問題 1.45.

コード

sample.scm

(define (expt b n)
  (cond ((= n 0) 1)
        ((even? n) (square (expt b (/ n 2))))
        (else (* b (expt b (- n 1))))))

(define tolerance 0.00001)

(define (average a b)
  (/ (+ a b) 2))

(define (average-dump f)
  (lambda (x) (average x (f x))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (compose f g)
  (lambda (x)
    (f (g x))))

(define (repeated f n)
  (if (= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

n乗根するのに、何回の平均緩和が必要かnに具体的な数字(5, 6…)を代入して実験。評価の結果が約2になるように、2のn乗の平方根を求める事に。時間がかかったら中断して平均緩和の回数を一回増やす。

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> 
(define (n-root n i)
  (display (expt 2 n))
  (fixed-point ((repeated average-dump i) (lambda (y) (/ (expt 2 n) (expt y (- n 1))))) 1.0))

;Value: n-root

1 ]=> (n-root 2 1)
4
;Value: 2.000000000000002

1 ]=> (n-root 3 1)
8
;Value: 1.9999981824788517

1 ]=> (n-root 4 1)
16^C
Interrupt option (? for help): 
;Quit!

1 ]=> (n-root 4 2)
16
;Value: 2.0000000000021965

1 ]=> (n-root 5 2)
32
;Value: 2.000001512995761

1 ]=> (n-root 6 2)
64
;Value: 2.0000029334662086

1 ]=> (n-root 7 2)
128
;Value: 2.0000035538623377

1 ]=> (n-root 8 2)
256^C
Interrupt option (? for help): 
;Quit!

1 ]=> (n-root 8 3)
256
;Value: 2.000000000003967

1 ]=> (n-root 9 3)
512
;Value: 1.9999997106840102

1 ]=> (n-root 10 3)
1024
;Value: 2.0000011830103324

1 ]=> (n-root 11 3)
2048
;Value: 1.9999976006547362

1 ]=> (n-root 12 3)
4096
;Value: 1.999997691470309

1 ]=> (n-root 13 3)
8192
;Value: 2.0000029085658984

1 ]=> (n-root 14 3)
16384
;Value: 1.9999963265447058

1 ]=> (n-root 15 3)
32768
;Value: 2.0000040951543023

1 ]=> (n-root 16 3)
65536^C
Interrupt option (? for help): 
;Quit!

1 ]=> (n-root 16 4)
65536
;Value: 2.000000000076957

1 ]=> (n-root 17 4)
131072
;Value: 2.0000000561635765

1 ]=> (n-root 18 4)
262144
;Value: 2.0000005848426476

1 ]=> (n-root 19 4)
524288
;Value: 2.0000003649180282

1 ]=> (n-root 20 4)
1048576
;Value: 1.999999063225966

1 ]=> (n-root 21 4)
2097152
;Value: 2.000001254054255

1 ]=> (n-root 22 4)
4194304
;Value: 1.9999986334227027

1 ]=> (n-root 23 4)
8388608
;Value: 1.999997131591442

1 ]=> (n-root 24 4)
16777216
;Value: 1.999997814692085

1 ]=> (n-root 25 4)
33554432
;Value: 1.9999977429539466

1 ]=> (n-root 26 4)
67108864
;Value: 1.999997554120725

1 ]=> (n-root 27 4)
134217728
;Value: 1.9999966641661142

1 ]=> (n-root 28 4)
268435456
;Value: 1.9999957943905209

1 ]=> (n-root 29 4)
536870912
;Value: 1.9999957104786468

1 ]=> (n-root 30 4)
1073741824
;Value: 2.000004490765405

1 ]=> (n-root 31 4)
2147483648
;Value: 1.9999951809750396

1 ]=> (n-root 32 4)
4294967296^C
Interrupt option (? for help): 
;Quit!

1 ]=> (n-root 32 5)
4294967296
;Value: 2.000000000000006

結果から、

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
0 1   2       3                     4       

と予想。この予想(n乗根を求めるには、2^k <= nとなる最大の数k回の平均緩和が必要)に従ってn乗根を計算する単純な手続きを実装。

コード

sample.scm

(define (expt b n)
  (cond ((= n 0) 1)
        ((even? n) (square (expt b (/ n 2))))
        (else (* b (expt b (- n 1))))))

(define tolerance 0.00001)

(define (average a b)
  (/ (+ a b) 2))

(define (average-dump f)
  (lambda (x) (average x (f x))))

(define (fixed-point f first-guess)
  (define (close-enough? v1 v2)
    (< (abs (- v1 v2)) tolerance))
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next)
          next
          (try next))))
  (try first-guess))

(define (compose f g)
  (lambda (x)
    (f (g x))))

(define (repeated f n)
  (if (= n 1)
      (lambda (x) (f x))
      (compose f (repeated f (- n 1)))))

(define (n-root n i)
  (display (expt 2 n))
  (fixed-point ((repeated average-dump i) (lambda (y) (/ (expt 2 n) (expt y (- n 1))))) 1.0))

(define (n-root n x)
  (define (times k)
    (if (< (expt 2 k) n)
           (times (+ k 1))
           k))
  (fixed-point ((repeated average-dump (times 0)) 
               (lambda (y) (/ x (expt y (- n 1))))) 
               1.0))

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> (n-root 2 4)

;Value: 2.000000000000002

1 ]=> (n-root 2 9)

;Value: 3.

1 ]=> (n-root 2 16)

;Value: 4.000000000000051

1 ]=> (n-root 2 25)

;Value: 5.

1 ]=> (n-root 3 8)

;Value: 2.000002163438156

1 ]=> (n-root 3 27)

;Value: 3.000001464168659

1 ]=> (n-root 3 125)

;Value: 5.0000009507962755

1 ]=> (n-root 3 (expt 6 3))

;Value: 6.00000158066566

1 ]=> (n-root 4 16) 

;Value: 2.0000000000021965

1 ]=> (n-root 4 81)

;Value: 3.000000000000033

1 ]=> (n-root 4 256)

;Value: 4.000000000000006

1 ]=> (n-root 4 625)

;Value: 5.000000000004688

1 ]=> (n-root 5 32)

;Value: 2.000002548192768

1 ]=> (n-root 5 243)

;Value: 3.000003432225565

1 ]=> (n-root 5 1024)

;Value: 4.000002684062862

1 ]=> (n-root 5 3125)

;Value: 5.000002380470409

1 ]=> (n-root 10 1024)

;Value: 2.0000044972691784

1 ]=> (n-root 10 (expt 3 10))

;Value: 3.000003467126666

1 ]=> (n-root 10 (expt 4 10))

;Value: 4.00000516979069

1 ]=> (n-root 10 (expt 5 10))

;Value: 5.000002719450093

1 ]=> (n-root 2 2)

;Value: 1.4142135623746899

1 ]=> (n-root 100 (expt 11 100))

;Value: 11.000002407983663

1 ]=> ^D
End of input stream reached.
Moriturus te saluto.

とりあえず合ってるっぽい。

問題 1.46.

コード

sample.scm

(define (iterative-improve good-enough? improve)
  (define (iterative-improve-inner guess)
    (if (good-enough? guess)
        guess
        (iterative-improve-inner (improve guess))))
  iterative-improve-inner)

(define (sqrt x)
  (define (good-enough? guess)
    (< (abs (- (square guess) x)) 0.001))
  (define (improve guess)
    (average guess (/ x guess)))
  (define (average x y)
    (/ (+ x y) 2))
  ((iterative-improve good-enough? improve) 1.0))

(define (fixed-point f first-guess)
  ((iterative-improve (lambda (guess)
                        (< (abs (- guess (f guess))) 0.00001))
                      f) first-guess))

関数の不動点を求める手続き(fixed-point)に関しては、修正前は最後の真となる評価の予想値と改良後の値の後者の改良後の値、反復改良法を使った修正後では最後の真となる評価の予想値と改良後の値の前者の予想値を返すので、結果は1.3.3節の場合と微妙に異なる。

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> (sqrt 9)              

;Value: 3.00009155413138

1 ]=> (sqrt (+ 100 37))

;Value: 11.704699917758145

1 ]=> (sqrt (+ (sqrt 2) (sqrt 3)))

;Value: 1.7739279023207892

1 ]=> (square (sqrt 1000))

;Value: 1000.000369924366

1 ]=> (fixed-point cos 1.0)

;Value: .7390893414033928

1 ]=> (fixed-point (lambda (y) (+ (sin y) (cos y)))
                   1.0)

;Value: 1.2587228743052672

0 コメント:

コメントを投稿