Blame


1 665c255d 2023-08-04 jrmu (define tolerance 0.0000001)
2 665c255d 2023-08-04 jrmu (define (fixed-point f first-guess)
3 665c255d 2023-08-04 jrmu (define (close-enough? v1 v2)
4 665c255d 2023-08-04 jrmu (< (abs (- v1 v2)) tolerance))
5 665c255d 2023-08-04 jrmu (define (try guess)
6 665c255d 2023-08-04 jrmu (let ((next (f guess)))
7 665c255d 2023-08-04 jrmu (if (close-enough? guess next)
8 665c255d 2023-08-04 jrmu next
9 665c255d 2023-08-04 jrmu (try next))))
10 665c255d 2023-08-04 jrmu (try first-guess))
11 665c255d 2023-08-04 jrmu
12 665c255d 2023-08-04 jrmu (define (average x y)
13 665c255d 2023-08-04 jrmu (/ (+ x y) 2.0))
14 665c255d 2023-08-04 jrmu (define (average-damp f)
15 665c255d 2023-08-04 jrmu (lambda (x) (average x (f x))))
16 665c255d 2023-08-04 jrmu (define (fixed-point-of-transform g transform guess)
17 665c255d 2023-08-04 jrmu (fixed-point (transform g) guess))
18 665c255d 2023-08-04 jrmu (define (sqrt x)
19 665c255d 2023-08-04 jrmu (fixed-point-of-transform (lambda (y) (/ x y))
20 665c255d 2023-08-04 jrmu average-damp
21 665c255d 2023-08-04 jrmu 1.0))
22 665c255d 2023-08-04 jrmu (define (cube-root x)
23 665c255d 2023-08-04 jrmu (fixed-point-of-transform (lambda (y) (/ x (square y)))
24 665c255d 2023-08-04 jrmu average-damp
25 665c255d 2023-08-04 jrmu 1.0))
26 665c255d 2023-08-04 jrmu
27 665c255d 2023-08-04 jrmu (define (compose f g)
28 665c255d 2023-08-04 jrmu (lambda (x)
29 665c255d 2023-08-04 jrmu (f (g x))))
30 665c255d 2023-08-04 jrmu
31 665c255d 2023-08-04 jrmu (define (test-case actual expected)
32 665c255d 2023-08-04 jrmu (load-option 'format)
33 665c255d 2023-08-04 jrmu (newline)
34 665c255d 2023-08-04 jrmu (format #t "Actual: ~A Expected: ~A" actual expected))
35 665c255d 2023-08-04 jrmu
36 665c255d 2023-08-04 jrmu (define (square x) (* x x))
37 665c255d 2023-08-04 jrmu (define (inc x) (1+ x))
38 665c255d 2023-08-04 jrmu ;; (test-case ((compose square inc) 6) 49)
39 665c255d 2023-08-04 jrmu
40 665c255d 2023-08-04 jrmu (define (repeated f n)
41 665c255d 2023-08-04 jrmu (if (= n 0)
42 665c255d 2023-08-04 jrmu (lambda (x) x)
43 665c255d 2023-08-04 jrmu (compose f (repeated f (- n 1)))))
44 665c255d 2023-08-04 jrmu
45 665c255d 2023-08-04 jrmu ;; (test-case ((repeated square 2) 5) 625)
46 665c255d 2023-08-04 jrmu ;; (test-case (cube-root 5) 1.70997594668)
47 665c255d 2023-08-04 jrmu
48 665c255d 2023-08-04 jrmu
49 665c255d 2023-08-04 jrmu ;; Exercise 1.44. The idea of smoothing a function is an important concept in signal processing. If f is a function and dx is some small number, then the smoothed version of f is the function whose value at a point x is the average of f(x - dx), f(x), and f(x + dx). Write a procedure smooth that takes as input a procedure that computes f and returns a procedure that computes the smoothed f. It is sometimes valuable to repeatedly smooth a function (that is, smooth the smoothed function, and so on) to obtained the n-fold smoothed function. Show how to generate the n-fold smoothed function of any given function using smooth and repeated from exercise 1.43.
50 665c255d 2023-08-04 jrmu
51 665c255d 2023-08-04 jrmu (define dx 0.01)
52 665c255d 2023-08-04 jrmu
53 665c255d 2023-08-04 jrmu (define (smooth f)
54 665c255d 2023-08-04 jrmu (lambda (x)
55 665c255d 2023-08-04 jrmu (/ (+ (f x)
56 665c255d 2023-08-04 jrmu (f (+ x dx))
57 665c255d 2023-08-04 jrmu (f (- x dx)))
58 665c255d 2023-08-04 jrmu 3.0)))
59 665c255d 2023-08-04 jrmu (define (n-fold-smooth f n)
60 665c255d 2023-08-04 jrmu ((repeated smooth n) f))
61 665c255d 2023-08-04 jrmu
62 665c255d 2023-08-04 jrmu ;; Exercise 1.45. We saw in section 1.3.3 that attempting to compute square roots by naively finding a fixed point of y x/y does not converge, and that this can be fixed by average damping. The same method works for finding cube roots as fixed points of the average-damped y x/y2. Unfortunately, the process does not work for fourth roots -- a single average damp is not enough to make a fixed-point search for y x/y3 converge. On the other hand, if we average damp twice (i.e., use the average damp of the average damp of y x/y3) the fixed-point search does converge. Do some experiments to determine how many average damps are required to compute nth roots as a fixed-point search based upon repeated average damping of y x/yn-1. Use this to implement a simple procedure for computing nth roots using fixed-point, average-damp, and the repeated procedure of exercise 1.43. Assume that any arithmetic operations you need are available as primitives.
63 665c255d 2023-08-04 jrmu
64 665c255d 2023-08-04 jrmu (define (fast-expt b n)
65 665c255d 2023-08-04 jrmu (cond ((= n 0) 1)
66 665c255d 2023-08-04 jrmu ((even? n) (square (fast-expt b (/ n 2))))
67 665c255d 2023-08-04 jrmu (else (* b (fast-expt b (- n 1))))))
68 665c255d 2023-08-04 jrmu
69 665c255d 2023-08-04 jrmu
70 665c255d 2023-08-04 jrmu (define (quartic-root x)
71 665c255d 2023-08-04 jrmu (fixed-point-of-transform (lambda (y) (/ x (cube y)))
72 665c255d 2023-08-04 jrmu (repeated average-damp 2)
73 665c255d 2023-08-04 jrmu 1.0))
74 665c255d 2023-08-04 jrmu (define (nth-root-test x n d)
75 665c255d 2023-08-04 jrmu (fixed-point-of-transform (lambda (y) (/ x (expt y (- n 1))))
76 665c255d 2023-08-04 jrmu (repeated average-damp d)
77 665c255d 2023-08-04 jrmu 1.0))
78 665c255d 2023-08-04 jrmu
79 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 1 0) 19)
80 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 2 1) 4.35889894)
81 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 3 1) 2.66840165)
82 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 4 2) 2.08779763)
83 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 5 2) 1.80198313)
84 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19 6 2) 1.6335243)
85 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 199 7 2) 2.13013723)
86 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 199 8 3) 1.93801277)
87 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 199 9 3) 1.80064508)
88 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 199 10 3) 1.69779522)
89 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19999 11 3) 2.46037187)
90 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19999 12 3) 2.28253453)
91 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19999 13 3) 2.14213477)
92 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19999 14 3) 2.02868621)
93 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 19999 15 3) 1.93523578)
94 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 1999999 16 4) 2.47636331)
95 665c255d 2023-08-04 jrmu ;; (test-case (nth-root-test 1999999 17 4) 2.34773357)
96 665c255d 2023-08-04 jrmu
97 665c255d 2023-08-04 jrmu
98 665c255d 2023-08-04 jrmu ;; At first, my conclusion: average damp = sqrt(n), rounded down -- EXCEPT for 8...why is that?
99 665c255d 2023-08-04 jrmu ;; Maybe: 2^average damp = n
100 665c255d 2023-08-04 jrmu
101 665c255d 2023-08-04 jrmu (define (nth-root x n)
102 665c255d 2023-08-04 jrmu (fixed-point-of-transform (lambda (y) (/ x (expt y (- n 1))))
103 665c255d 2023-08-04 jrmu (repeated average-damp (truncate (/ (log n) (log 2))))
104 665c255d 2023-08-04 jrmu 1.0))
105 665c255d 2023-08-04 jrmu
106 665c255d 2023-08-04 jrmu (test-case (nth-root 19 1) 19)
107 665c255d 2023-08-04 jrmu (test-case (nth-root 19 2) 4.35889894)
108 665c255d 2023-08-04 jrmu (test-case (nth-root 19 3) 2.66840165)
109 665c255d 2023-08-04 jrmu (test-case (nth-root 19 4) 2.08779763)
110 665c255d 2023-08-04 jrmu (test-case (nth-root 19 5) 1.80198313)
111 665c255d 2023-08-04 jrmu (test-case (nth-root 19 6) 1.6335243)
112 665c255d 2023-08-04 jrmu (test-case (nth-root 199 7) 2.13013723)
113 665c255d 2023-08-04 jrmu (test-case (nth-root 199 8) 1.93801277)
114 665c255d 2023-08-04 jrmu (test-case (nth-root 199 9) 1.80064508)
115 665c255d 2023-08-04 jrmu (test-case (nth-root 199 10) 1.69779522)
116 665c255d 2023-08-04 jrmu (test-case (nth-root 19999 11) 2.46037187)
117 665c255d 2023-08-04 jrmu (test-case (nth-root 19999 12) 2.28253453)
118 665c255d 2023-08-04 jrmu (test-case (nth-root 19999 13) 2.14213477)
119 665c255d 2023-08-04 jrmu (test-case (nth-root 19999 14) 2.02868621)
120 665c255d 2023-08-04 jrmu (test-case (nth-root 19999 15) 1.93523578)
121 665c255d 2023-08-04 jrmu (test-case (nth-root 1999999 16) 2.47636331)
122 665c255d 2023-08-04 jrmu (test-case (nth-root 1999999 17) 2.34773357)