1 665c255d 2023-08-04 jrmu (define (square x)
 2 665c255d 2023-08-04 jrmu   (* x x))
 3 665c255d 2023-08-04 jrmu (define (fib n)
 4 665c255d 2023-08-04 jrmu   (fib-iter 1 0 0 1 n))
 5 665c255d 2023-08-04 jrmu (define (fib-iter a b p q count)
 6 665c255d 2023-08-04 jrmu   (cond ((= count 0) b)
 7 665c255d 2023-08-04 jrmu 	((even? count) (fib-iter a
 8 665c255d 2023-08-04 jrmu 				 b
 9 665c255d 2023-08-04 jrmu 				 (+ (square q) (square p))
10 665c255d 2023-08-04 jrmu 				 (+ (* 2 q p) (square q))
11 665c255d 2023-08-04 jrmu 				 (/ count 2)))
12 665c255d 2023-08-04 jrmu 	(else (fib-iter (+ (* b q) (* a q) (* a p))
13 665c255d 2023-08-04 jrmu 			(+ (* b p) (* a q))
14 665c255d 2023-08-04 jrmu 			p
15 665c255d 2023-08-04 jrmu 			q
16 665c255d 2023-08-04 jrmu 			(- count 1)))))
17 665c255d 2023-08-04 jrmu 
18 665c255d 2023-08-04 jrmu (define (test-case actual expected)
19 665c255d 2023-08-04 jrmu   (load-option 'format)
20 665c255d 2023-08-04 jrmu   (newline)
21 665c255d 2023-08-04 jrmu   (format #t "Actual: ~A Expected: ~A" actual expected))
22 665c255d 2023-08-04 jrmu 
23 665c255d 2023-08-04 jrmu (test-case (fib 0) 0)
24 665c255d 2023-08-04 jrmu (test-case (fib 1) 1)
25 665c255d 2023-08-04 jrmu (test-case (fib 2) 1)
26 665c255d 2023-08-04 jrmu (test-case (fib 3) 2)
27 665c255d 2023-08-04 jrmu (test-case (fib 4) 3)
28 665c255d 2023-08-04 jrmu (test-case (fib 5) 5)
29 665c255d 2023-08-04 jrmu (test-case (fib 6) 8)
30 665c255d 2023-08-04 jrmu (test-case (fib 7) 13)
31 665c255d 2023-08-04 jrmu (test-case (fib 8) 21)
32 665c255d 2023-08-04 jrmu (test-case (fib 9) 34)
33 665c255d 2023-08-04 jrmu 
34 665c255d 2023-08-04 jrmu (define (fib n)
35 665c255d 2023-08-04 jrmu   (fib-iter 1 0 0 1 n)
36 665c255d 2023-08-04 jrmu 
37 665c255d 2023-08-04 jrmu (define (fib-iter a b p q n)
38 665c255d 2023-08-04 jrmu   (cond ((= n 0) b)
39 665c255d 2023-08-04 jrmu 	((even? n) (fib-iter a
40 665c255d 2023-08-04 jrmu 			     b
41 665c255d 2023-08-04 jrmu 			     (+ (square p) (square q))
42 665c255d 2023-08-04 jrmu 			     (+ (* 2 p q) (square q))
43 665c255d 2023-08-04 jrmu 			     (/ n 2)))
44 665c255d 2023-08-04 jrmu 	(else (fib-iter (+ (* b q) (* a q) (* a p))
45 665c255d 2023-08-04 jrmu 			(+ (* b p) (* a q))
46 665c255d 2023-08-04 jrmu 			p 
47 665c255d 2023-08-04 jrmu 			q
48 665c255d 2023-08-04 jrmu 			(- n 1)))))