1.3.4 (練習問題1.40~1.46)
sec-1.3.4. 返り値としての手続き (a) 平均緩和法を使った平方根と三乗根
; [sec-1.3.4-a]
(define (sec-1.3.4-a)
(print "(average-damp square) 10))")
(print ";==> " ((average-damp square) 10))
(print "(sqrt-1.3.4-a 5)")
(print ";==> " (sqrt-1.3.4-a 5))
(print "(cube-root-1.3.4-a 125)")
(print ";==> " (cube-root-1.3.4-a 125))
#t)
(define (average-damp f)
(lambda (x) (average x (f x))))
(define (average a b)
(/ (+ a b) 2))
(define (sqrt-1.3.4-a x)
(fixed-point (average-damp (lambda (y) (/ x y))) 1.0))
(define (cube-root-1.3.4-a x)
(fixed-point (average-damp (lambda (y) (/ x (square y)))) 1.0))
; from sec-1.3.3.
(define (fixed-point f first-guess)
(define tolerance 0.00001)
(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))
gosh> (sec-1.3.4-a)
(average-damp square) 10))
;==> 55
(sqrt-1.3.4-a 5)
;==> 2.236067977499978
(cube-root-1.3.4-a 125)
;==> 4.999997738179904
#t
sec-1.3.4. (b) 微分の近似と不動点探索によるニュートン法
; [sec-1.3.4-b]
(define (sec-1.3.4-b)
(print "((derive cube) 5) ; exact value = 75")
(print ";==> " ((derive cube) 5))
(print "(sqrt-1.3.4-b 5)")
(print ";==> " (sqrt-1.3.4-b 5))
#t)
(load "./sec-1.3.4-a")
(define (derive g)
(lambda (x) (/ (- (g (+ x dx)) (g x)) dx)))
(define dx 0.00001)
(define (cube x) (* x x x))
(define (newton-transform g)
(lambda (x) (- x (/ (g x) ((derive g) x)))))
(define (newtons-method g guess)
(fixed-point (newton-transform g) guess))
(define (sqrt-1.3.4-b x)
(newtons-method
(lambda (y) (- (square y) x))
1.0))
((derive cube) 5) ; exact value = 75
;==> 75.00014999664018
(sqrt-1.3.4-b 5)
;==> 2.2360679775020436
#t
sec-1.3.4. (c) 抽象化とファーストクラス手続き
; [sec-1.3.4-c.scm]
(define (sec-1.3.4-c)
(print "(sqrt-1.3.4-c-ad 25)")
(print ";==> " (sqrt-1.3.4-c-ad 25))
(print "(sqrt-1.3.4-c-nt 25)")
(print ";==> " (sqrt-1.3.4-c-nt 25))
#t)
(load "./sec-1.3.4-b")
(define (fixed-point-of-transform g transform guess)
(fixed-point (transform g) guess))
(define (sqrt-1.3.4-c-ad x)
(fixed-point-of-transform
(lambda (y) (/ x y))
average-damp
1.0))
(define (sqrt-1.3.4-c-nt x)
(fixed-point-of-transform
(lambda (y) (- (square y) x))
newton-transform
1.0))
gosh> (sec-1.3.4-c)
(sqrt-1.3.4-c-ad 25)
;==> 5.0
(sqrt-1.3.4-c-nt 25)
;==> 5.0
#t
ex-1.40. ニュートン法による x^3 + ax^2 + bx + c = 0 の零点の近似値
; [ex-1.40.scm]
(define (ex-1.40)
(print "(newtons-method (cubic 5 4 3) 1.0)")
(print ";==> " (newtons-method (cubic 5 4 3) 1.0))
(print "((cubic 5 4 3) -4.220692819987309)")
(print ";==> " ((cubic 5 4 3) -4.220692819987309))
#t)
(load "./sec-1.3.4-b")
; x^3 + ax^2 + bx +c.
(define (cubic a b c)
(lambda (x) (+ (* x x x) (* a x x) (* b x) c)))
gosh> (ex-1.40)
(newtons-method (cubic 5 4 3) 1.0)
;==> -4.220692819987309
((cubic 5 4 3) -4.220692819987309)
;==> 2.4513724383723456e-13
#t
ex-1.41. (((double (doube double)) inc) 5)
; [ex-1.41.scm]
(define (ex-1.41)
(print "((double inc) 0)")
(print ";==> " ((double inc) 0))
(print "(((double (double double)) inc) 5)")
(print ";==> " (((double (double double)) inc) 5))
(newline)
(print "((double inc) 0)")
(print ";==> " ((double inc) 0))
(print "(((double double) inc) 0)")
(print ";==> " (((double double) inc) 0))
(print "(((double (double double)) inc) 0)")
(print ";==> " (((double (double double)) inc) 0))
#t)
; f :: a -> a
; double :: (a -> a) -> (a -> a)
(define (double f)
(lambda (x) (f (f x))))
(define (inc x) (+ x 1))
gosh> (ex-1.41)
((double inc) 0)
;==> 2
(((double (double double)) inc) 5)
;==> 21
((double inc) 0)
;==> 2
(((double double) inc) 0)
;==> 4
(((double (double double)) inc) 0)
;==> 16
#t
3つめが 8 かと思ったら 16 だった・ω・；
のでちょっと手で展開してみた…
lambda がかっこだらけでわけわからないので適当に記法をでっちあげつつ(←
[1]
double = [\f -> [\x -> (f (f x))]]
[2]
(double double)
> (double-a double-b)
>> double-a = [\g -> [\x -> (g (g x))]]
>> double-b = [\h -> [\y -> (h (h y))]]
(double-a double-b)
([\g -> [\x -> (g (g x))]] double-b)
[\x -> (double-b (double-b x))]
.
[\x -> (double-b ([\h -> [\y -> (h (h y))]] x))]
[\x -> (double-b [\y -> (x (x y))])]
[\x -> ([\h -> [\y -> (h (h y))]] [\y -> (x (x y))])]
[\x -> ([\h -> [\z -> (h (h z))]] [\y -> (x (x y))])]
[\x -> [\z -> ([\y -> (x (x y))] ([\y -> (x (x y))] z))]]
[\x -> [\z -> ([\y -> (x (x y))] (x (x z)))]]
[\x -> [\z -> (x (x (x (x z))))]]
[\f -> [\z -> (f (f (f (f z))))]]
[3]
(double (double double))
(double-a (double-b double-c))
>> double-a = [\f -> [\x -> (f (f x))]]
>> (double-b double-c) = [\g -> [\y -> (g (g (g (g y))))]]
(double-a [\g -> [\y -> (g (g (g (g y))))]])
([\f -> [\x -> (f (f x))]] [\g -> [\y -> (g (g (g (g y))))]])
[\x -> ([\g -> [\y -> (g (g (g (g y))))]] ([\g -> [\y -> (g (g (g (g y))))]] x))]
[\x -> ([\g -> [\y -> (g (g (g (g y))))]] [\y -> (x (x (x (x y))))])]
[\x -> [\y -> ([\y -> (x (x (x (x y))))] ([\y -> (x (x (x (x y))))] ([\y -> (x (x (x (x y))))] ([\y -> (x (x (x (x y))))] y) )))]]
[\x -> [\y -> ([\y -> (x (x (x (x y))))] ([\y -> (x (x (x (x y))))] (x (x (x (x (x (x (x (x y)))) )))) ))]]
[\x -> [\y -> ([\y -> (x (x (x (x y))))] (x (x (x (x (x (x (x (x (x (x (x (x y)))) )))) )))) )]]
[\x -> [\y -> (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x (x y)))) )))) )))) ))))]]
なるほど…？＝ヮ＝；
めがしぱしぱ＝ω＝；
ex-1.42. ((compose square inc) 6)
; [ex-1.42.scm]
(define (ex-1.42)
(print "((compose square inc) 6)") ; 49.
(print "#==> " ((compose square inc) 6))
#t)
(define (inc x) (+ x 1))
(define (compose f g)
(lambda (x) (f (g x))))
gosh> (ex-1.42)
((compose square inc) 6)
#==> 49
#t
ex-1.43. n 回適用
; [ex-1.43.scm]
(define (ex-1.43)
(print "((repeated square 2) 5)") ; 625.
(print "#==> " ((repeated square 2) 5))
#t)
(load "./ex-1.42")
(define (repeated f n)
(cond
((<= n 1)
f)
((= (remainder n 2) 1)
(compose f (repeated f (- n 1))))
(else
(let ((ff (repeated f (/ n 2))))
(compose ff ff)))))
; (define (repeated f n)
; (define (iter i val)
; (if (>= i n)
; val
; (iter (+ i 1) (f val))))
; (lambda (x) (iter 0 x)))
gosh> (ex-1.43)
((repeated square 2) 5)
#==> 625
#t
ex-1.44. n 重平滑化
; [ex-1.44.scm]
(define (ex-1.44)
(print "((smooth square) 100)")
(print ";==> " ((smooth square) 100))
(print "((n-fold-smooth square 4) 100)")
(print ";==> " ((n-fold-smooth square 4) 100))
#t)
(load "./ex-1.43")
; smooth :: (a -> a) -> (a -> a)
(define (smooth f)
(define dx 0.00001)
(lambda (x)
(/ (+ (f (- x dx)) (f x) (f (+ x dx))) 3)))
(define (n-fold-smooth f n)
(repeated (smooth f) n))
gosh> (ex-1.44)
((smooth square) 100)
;==> 10000.000000000067
((n-fold-smooth square 4) 100)
;==> 1.0000000000000545e32
#t
サンプルがないのであってるのかわかんない・ω・`
ex-1.45.
ぷしゅー…o__)o
ex-1.46.
o__)o