1 665c255d 2023-08-04 jrmu (define (sum term a next b)
 2 665c255d 2023-08-04 jrmu   (if (> a b)
 3 665c255d 2023-08-04 jrmu       0
 4 665c255d 2023-08-04 jrmu       (+ (term a)
 5 665c255d 2023-08-04 jrmu 	 (sum term (next a) next b))))
 6 665c255d 2023-08-04 jrmu 
 7 665c255d 2023-08-04 jrmu ;; (define (simpsons-rule f a b n)
 8 665c255d 2023-08-04 jrmu ;;   (let ((h (/ (- b a) n)))
 9 665c255d 2023-08-04 jrmu ;;     (define (running-sum k)
10 665c255d 2023-08-04 jrmu ;;       (let ((akh (+ a (* k h))))
11 665c255d 2023-08-04 jrmu ;; 	(if (= k n) 
12 665c255d 2023-08-04 jrmu ;; 	    (f akh)
13 665c255d 2023-08-04 jrmu ;; 	    (+ (cond ((= k 0) (f akh))
14 665c255d 2023-08-04 jrmu ;; 		     ((even? k) (* 2 (f akh)))
15 665c255d 2023-08-04 jrmu ;; 		     ((odd? k) (* 4 (f akh))))
16 665c255d 2023-08-04 jrmu ;; 	       (running-sum (+ k 1))))))
17 665c255d 2023-08-04 jrmu ;;     (* (/ h 3)
18 665c255d 2023-08-04 jrmu ;;        (running-sum 0))))
19 665c255d 2023-08-04 jrmu 
20 665c255d 2023-08-04 jrmu (define (simpsons-rule f a b n)
21 665c255d 2023-08-04 jrmu   (let ((h (/ (- b a) n)))
22 665c255d 2023-08-04 jrmu     (define (simpsons-term k)
23 665c255d 2023-08-04 jrmu       (let ((akh (+ a (* k h))))
24 665c255d 2023-08-04 jrmu 	(* (f akh)
25 665c255d 2023-08-04 jrmu 	   (cond ((or (= k 0) (= k n)) 1)
26 665c255d 2023-08-04 jrmu 		 ((odd? k) 4)
27 665c255d 2023-08-04 jrmu 		 ((even? k) 2)))))
28 665c255d 2023-08-04 jrmu     (* (/ h 3)
29 665c255d 2023-08-04 jrmu        (sum simpsons-term 0 1+ n))))
30 665c255d 2023-08-04 jrmu 
31 665c255d 2023-08-04 jrmu 
32 665c255d 2023-08-04 jrmu (define (test-case actual expected)
33 665c255d 2023-08-04 jrmu   (load-option 'format)
34 665c255d 2023-08-04 jrmu   (newline)
35 665c255d 2023-08-04 jrmu   (format #t "Actual: ~A Expected: ~A" actual expected))
36 665c255d 2023-08-04 jrmu 
37 665c255d 2023-08-04 jrmu (define (cube x) (* x x x))
38 665c255d 2023-08-04 jrmu 
39 665c255d 2023-08-04 jrmu (test-case (simpsons-rule cube 0.0 1.0 5) 0.25)
40 665c255d 2023-08-04 jrmu (test-case (simpsons-rule cube 0.0 1.0 10) 0.25)
41 665c255d 2023-08-04 jrmu (test-case (simpsons-rule cube 0.0 1.0 100) 0.25)
42 665c255d 2023-08-04 jrmu