Blame


1 665c255d 2023-08-04 jrmu (define (non-num-members as)
2 665c255d 2023-08-04 jrmu (filter (lambda (x) (not (number? x)))
3 665c255d 2023-08-04 jrmu as))
4 665c255d 2023-08-04 jrmu (define (num-members as)
5 665c255d 2023-08-04 jrmu (filter number? as))
6 665c255d 2023-08-04 jrmu (define (more-than-one-number? as)
7 665c255d 2023-08-04 jrmu (let ((nums (num-members as)))
8 665c255d 2023-08-04 jrmu (if (or (null? nums) (null? (cdr nums)))
9 665c255d 2023-08-04 jrmu false
10 665c255d 2023-08-04 jrmu true)))
11 665c255d 2023-08-04 jrmu (define (zero-is-the-only-number? as)
12 665c255d 2023-08-04 jrmu (let ((nums (num-members as)))
13 665c255d 2023-08-04 jrmu (if (null? nums)
14 665c255d 2023-08-04 jrmu false
15 665c255d 2023-08-04 jrmu (and (= (car nums) 0) (null? (cdr nums))))))
16 665c255d 2023-08-04 jrmu
17 665c255d 2023-08-04 jrmu (define (make-sum . as)
18 665c255d 2023-08-04 jrmu (cond ((null? as) 0)
19 665c255d 2023-08-04 jrmu ((null? (cdr as)) (car as))
20 665c255d 2023-08-04 jrmu ((null? (non-num-members as)) (apply + as))
21 665c255d 2023-08-04 jrmu ((more-than-one-number? as)
22 665c255d 2023-08-04 jrmu (apply make-sum
23 665c255d 2023-08-04 jrmu (append (non-num-members as)
24 665c255d 2023-08-04 jrmu (list (apply + (num-members as))))))
25 665c255d 2023-08-04 jrmu ((zero-is-the-only-number? as)
26 665c255d 2023-08-04 jrmu (apply make-sum (non-num-members as)))
27 665c255d 2023-08-04 jrmu (else (append '(+) as))))
28 665c255d 2023-08-04 jrmu (define (make-product . ms)
29 665c255d 2023-08-04 jrmu (cond ((null? ms) 1)
30 665c255d 2023-08-04 jrmu ((null? (cdr ms)) (car ms))
31 665c255d 2023-08-04 jrmu ((null? (non-num-members ms)) (apply * ms))
32 665c255d 2023-08-04 jrmu ((more-than-one-number? ms)
33 665c255d 2023-08-04 jrmu (apply make-product
34 665c255d 2023-08-04 jrmu (append (non-num-members ms)
35 665c255d 2023-08-04 jrmu (list (apply * (num-members ms))))))
36 665c255d 2023-08-04 jrmu ((zero-is-the-only-number? ms) 0)
37 665c255d 2023-08-04 jrmu ((one-is-the-only-number? ms)
38 665c255d 2023-08-04 jrmu (apply make-product (non-num-members ms)))
39 665c255d 2023-08-04 jrmu (else (append '(*) ms))))
40 665c255d 2023-08-04 jrmu
41 665c255d 2023-08-04 jrmu
42 665c255d 2023-08-04 jrmu (define (augend s)
43 665c255d 2023-08-04 jrmu (apply make-sum (cddr s)))
44 665c255d 2023-08-04 jrmu (define (multiplicand p)
45 665c255d 2023-08-04 jrmu (apply make-product (cddr p)))