オンラインSICP読書女子会 #11

[オンラインSICP読書女子会 #11 (1.3.4)](http://ladiespp.connpass.com/event/31179/)

1.3.4 (練習問題1.40~1.46)

## sec-1.3.4. 返り値としての手続き (a) 平均緩和法を使った平方根と三乗根

```scm
; [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))
```

```scm
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) 微分の近似と不動点探索によるニュートン法

```scm
; [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))
```

```scm
((derive cube) 5)  ; exact value = 75
;==> 75.00014999664018
(sqrt-1.3.4-b 5)
;==> 2.2360679775020436
#t
```

## sec-1.3.4. (c) 抽象化とファーストクラス手続き

```scm
; [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))
```

```scm
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 の零点の近似値

```scm
; [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)))
```

```scm
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)

```scm
; [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))
```

```scm
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)

```scm
; [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))))
```

```scm
gosh> (ex-1.42)
((compose square inc) 6)
#==> 49
#t
```


## ex-1.43. n 回適用

```scm
; [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)))
```

```scm
gosh> (ex-1.43)
((repeated square 2) 5)
#==> 625
#t
```


## ex-1.44. n 重平滑化

```scm
; [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))
```

```scm
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