計算機プログラムの構造と解釈 第二版 P44 問題1.45
はい。この問題をやっている間に、HDがぶっ壊れたりして、
そういう意味でかなり難問でした。
この問題解き終える前に勉強会でやっちゃっておいてあるので、悔しい限りです。
以下、本題。
この問題はこんな感じで進めていく。
1.n乗根を計算するときに、何回平均緩和するか指定できる手続きをつくる。
2.n乗根を計算するのに必要な平均緩和の数を実験で求める
3.平均緩和の回数を自動的に求めて計算してくれる手続きをつくる。
そんな感じで、上の「1」は割と簡単にできたん。
こんな感じ
;;root-prototipe
(define (root-prototipe x m n)
(fixed-point ((repeated average-dump n) (lambda (y) (/ x (expt y (- m 1)))))
1.0))xが根を求める数。
mが何乗の根か、普通のルートだったら、2
nは何回平均緩和するか。
んで、「2」なんだけど、これ大変。
そんで勉強会では、底が2のログのfloorということになっていて、
それがどういうことかというと、
2乗根・3乗根、平均緩和1回でできる。
4乗根から7乗根、平均緩和2回でできる。
8乗根から15乗根、平均緩和3回できる。
16乗根、、、、 平均緩和4回。
って話だったんだけど、
3回の平均緩和で20乗根までいけてしまった！
ま、、いいや、とりあえず、話のまとまりとしては、
2を底とするn(何乗根か？)の対数の小数点以下を切り捨てたもの
っ手感じなのです。
ひとによっては、「2を底とするって、どうやんだよ！」
ってなりそうなんで、書いておくと、
log n ÷ log 2
って感じですね。
だので、ここは、
(floor (/ (log n) (log 2))
見たいな感じなると思われる。
んでは実装。
#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-
(use ggc.debug.trace)
(define (inc x)
(+ x 1))
(define (square x)
(* x x))
(define (compose f g)
(lambda (x)
(f (g x))))
;; fixed-point
(define tolerance 0.00001)
(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))
;; average-dump
(define (average p1 p2)
(/ (+ p1 p2) 2))
(define (average-dump f)
(lambda (x) (average x (f x))))
;; repeated
(define (repeated f n)
(if (= n 1)
(lambda (x)
(f x))
(repeated (compose f f) (- n 1))))
;;root-prototype
(define (root-prototype x m n)
(fixed-point ((repeated average-dump n) (lambda (y) (/ x (expt y (- m 1)))))
1.0))
;;root
(define (root x m)
(fixed-point ((repeated average-dump (floor (/ (log m) (log 2))))
(lambda (y) (/ x (expt y (- m 1)))))
1.0))
;; main
(define (main args)
(display "1回平均緩和")(newline)
(display "(root-prototype ")(display (expt 3 2))(display " 2 1) : ")
(display (root-prototype 9 2 1))(newline)
(display "(root-prototype ")(display (expt 3 3))(display " 3 1) : ")
(display (root-prototype 27 3 1))(newline)
(display "2回平均緩和")(newline)
(display "(root-prototype ")(display (expt 3 4))(display " 4 2) : ")
(display (root-prototype (expt 3 4) 4 2))(newline)
(display "(root-prototype ")(display (expt 3 5))(display " 5 2) : ")
(display (root-prototype (expt 3 5) 5 2))(newline)
(display "(root-prototype ")(display (expt 3 6))(display " 6 2) : ")
(display (root-prototype (expt 3 6) 6 2))(newline)
(display "(root-prototype ")(display (expt 3 7))(display " 7 2) : ")
(display (root-prototype (expt 3 7) 7 2))(newline)
(display "3回平均緩和")(newline)
(display "(root-prototype ")(display (expt 3 8))(display " 8 3) : ")
(display (root-prototype (expt 3 8) 8 3))(newline)
(display "(root-prototype ")(display (expt 3 9))(display " 9 3) : ")
(display (root-prototype (expt 3 9) 9 3))(newline)
(display "(root-prototype ")(display (expt 3 10))(display " 10 3) : ")
(display (root-prototype (expt 3 10) 10 3))(newline)
(display "(root-prototype ")(display (expt 3 11))(display " 11 3) : ")
(display (root-prototype (expt 3 11) 11 3))(newline)
(display "(root-prototype ")(display (expt 3 12))(display " 12 3) : ")
(display (root-prototype (expt 3 12) 12 3))(newline)
(display "(root-prototype ")(display (expt 3 13))(display " 13 3) : ")
(display (root-prototype (expt 3 13) 13 3))(newline)
(display "(root-prototype ")(display (expt 3 14))(display " 14 3) : ")
(display (root-prototype (expt 3 14) 14 3))(newline)
(display "(root-prototype ")(display (expt 3 15))(display " 15 3) : ")
(display (root-prototype (expt 3 15) 15 3))(newline)
(display "3回平均緩和")(newline)
(display "(root-prototype ")(display (expt 3 16))(display " 16 4) : ")
(display (root-prototype (expt 3 16) 16 4))(newline)
(newline)
(display "Mission complete!!!")(newline)
(display "(root ")(display (expt 3 16))(display " 16) : ")
(display (root (expt 3 16) 16))(newline)
(newline)
0)
実行！！
1回平均緩和 (root-prototype 9 2 1) : 3.0 (root-prototype 27 3 1) : 2.9999972321057697 2回平均緩和 (root-prototype 81 4 2) : 3.000000000000033 (root-prototype 243 5 2) : 3.0000008877496294 (root-prototype 729 6 2) : 2.999996785898161 (root-prototype 2187 7 2) : 3.0000041735235943 3回平均緩和 (root-prototype 6561 8 3) : 3.000007243280675 (root-prototype 19683 9 3) : 3.000004241187395 (root-prototype 59049 10 3) : 3.000003467126666 (root-prototype 177147 11 3) : 3.0000041664726727 (root-prototype 531441 12 3) : 3.000002000091472 (root-prototype 1594323 13 3) : 3.000000991913267 (root-prototype 4782969 14 3) : 3.000000466097833 (root-prototype 14348907 15 3) : 3.000000148387647 3回平均緩和 (root-prototype 43046721 16 4) : 3.0001418216956885 Mission complete!!! (root 43046721 16) : 3.0001418216956885
