Blob


1 (define (test-case actual expected)
2 (newline)
3 (display "Actual: ")
4 (display actual)
5 (newline)
6 (display "Expected: ")
7 (display expected)
8 (newline))
10 (define (accumulate op initial sequence)
11 (if (null? sequence)
12 initial
13 (op (car sequence)
14 (accumulate op initial (cdr sequence)))))
16 (define (accumulate-n op init seqs)
17 (if (null? (car seqs))
18 '()
19 (cons (accumulate op init (map car seqs))
20 (accumulate-n op init (map cdr seqs)))))
22 ;; Exercise 2.38. The accumulate procedure is also known as fold-right, because it combines the first element of the sequence with the result of combining all the elements to the right. There is also a fold-left, which is similar to fold-right, except that it combines elements working in the opposite direction:
24 (define (fold-left op initial sequence)
25 (define (iter result rest)
26 (if (null? rest)
27 result
28 (iter (op result (car rest))
29 (cdr rest))))
30 (iter initial sequence))
32 ;; What are the values of
33 ;;(/ 1 (/ 2 (/ 3 1)))
34 (test-case (fold-right / 1 (list 1 2 3)) 3/2)
35 ;;(/ (/ (/ 1 1) 2) 3)
36 (test-case (fold-left / 1 (list 1 2 3)) 1/6)
37 ;;(list 1 (list 2 (list 3 '())))
38 (test-case (fold-right list '() (list 1 2 3)) '(1 (2 (3 ()))))
39 ;;(list (list (list nil 1) 2) 3)
40 (test-case (fold-left list '() (list 1 2 3)) '(((() 1) 2) 3))
42 ;; Give a property that op should satisfy to guarantee that fold-right and fold-left will produce the same values for any sequence.
44 ;; we need both associativity and commutativity
45 ;; associativity
46 ;; (op a (op b c)) = (op (op a b) c)
47 ;; commutativity
48 ;; (op a b) = (op b a)
50 ;; '(a b c)
51 ;; fold-right
52 ;; (op a (op b (op c initial)))
53 ;; fold-left
54 ;; (op (op (op initial a) b) c)
55 ;; associativity
56 ;; (op (op initial (op a b)) c)
57 ;; commutativity
58 ;; (op (op (op a b) initial) c)
59 ;; associativity
60 ;; (op (op a (op b initial)) c)
61 ;; associativity
62 ;; (op a (op (op b initial) c))
63 ;; associativity
64 ;; (op a (op b (op initial c)))
65 ;; commutativity
66 ;; (op a (op b (op c initial)))