1 665c255d 2023-08-04 jrmu (define (search f neg-point pos-point)
 2 665c255d 2023-08-04 jrmu   (let ((midpoint (average neg-point pos-point)))
 3 665c255d 2023-08-04 jrmu     (if (close-enough? neg-point pos-point)
 4 665c255d 2023-08-04 jrmu 	midpoint
 5 665c255d 2023-08-04 jrmu 	(let ((test-value (f midpoint)))
 6 665c255d 2023-08-04 jrmu 	  (cond ((positive? test-value)
 7 665c255d 2023-08-04 jrmu 		 (search f neg-point midpoint))
 8 665c255d 2023-08-04 jrmu 		((negative? test-value)
 9 665c255d 2023-08-04 jrmu 		 (search f midpoint pos-point))
10 665c255d 2023-08-04 jrmu 		(else midpoint))))))
11 665c255d 2023-08-04 jrmu (define (close-enough? x y)
12 665c255d 2023-08-04 jrmu   (< (abs (- x y)) 0.001))
13 665c255d 2023-08-04 jrmu 
14 665c255d 2023-08-04 jrmu (define (half-interval-method f a b)
15 665c255d 2023-08-04 jrmu   (let ((a-value (f a))
16 665c255d 2023-08-04 jrmu 	(b-value (f b)))
17 665c255d 2023-08-04 jrmu     (cond ((and (negative? a-value) (positive? b-value))
18 665c255d 2023-08-04 jrmu 	   (search f a b))
19 665c255d 2023-08-04 jrmu 	  ((and (negative? b-value) (positive? a-value))
20 665c255d 2023-08-04 jrmu 	   (search f b a))
21 665c255d 2023-08-04 jrmu 	  (else
22 665c255d 2023-08-04 jrmu 	   (error "Values are not of opposite sign" a b)))))
23 665c255d 2023-08-04 jrmu (define tolerance 0.00001)
24 665c255d 2023-08-04 jrmu (define (fixed-point f first-guess)
25 665c255d 2023-08-04 jrmu   (define (close-enough? v1 v2)
26 665c255d 2023-08-04 jrmu     (< (abs (- v1 v2)) tolerance))
27 665c255d 2023-08-04 jrmu   (define (try guess)
28 665c255d 2023-08-04 jrmu     (let ((next (f guess)))
29 665c255d 2023-08-04 jrmu       (if (close-enough? guess next)
30 665c255d 2023-08-04 jrmu 	  next
31 665c255d 2023-08-04 jrmu 	  (try next))))
32 665c255d 2023-08-04 jrmu   (try first-guess))
33 665c255d 2023-08-04 jrmu 
34 665c255d 2023-08-04 jrmu (fixed-point (lambda (y) (+ (sin y) (cos y))) 
35 665c255d 2023-08-04 jrmu 	     1.0)
36 665c255d 2023-08-04 jrmu 
37 665c255d 2023-08-04 jrmu (define (sqrt x)
38 665c255d 2023-08-04 jrmu   (fixed-point (lambda (y) (average y (/ x y)))
39 665c255d 2023-08-04 jrmu 	       1.0))
40 665c255d 2023-08-04 jrmu 
41 665c255d 2023-08-04 jrmu (define (average x y)
42 665c255d 2023-08-04 jrmu   (/ (+ x y) 2))
43 665c255d 2023-08-04 jrmu 
44 665c255d 2023-08-04 jrmu (define golden-ratio (fixed-point (lambda (x) (+ 1 (/ 1 x)))
45 665c255d 2023-08-04 jrmu 				  1.0))
46 665c255d 2023-08-04 jrmu 
47 665c255d 2023-08-04 jrmu (define (test-case actual expected)
48 665c255d 2023-08-04 jrmu   (load-option 'format)
49 665c255d 2023-08-04 jrmu   (newline)
50 665c255d 2023-08-04 jrmu   (format #t "Actual: ~A Expected: ~A" actual expected))
51 665c255d 2023-08-04 jrmu 
52 665c255d 2023-08-04 jrmu (test-case golden-ratio (/ (+ 1.0 (sqrt 5.0)) 2.0))