1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 2 665c255d 2023-08-04 jrmu   (newline)
 3 665c255d 2023-08-04 jrmu   (display "Actual:   ")
 4 665c255d 2023-08-04 jrmu   (display actual)
 5 665c255d 2023-08-04 jrmu   (newline)
 6 665c255d 2023-08-04 jrmu   (display "Expected: ")
 7 665c255d 2023-08-04 jrmu   (display expected)
 8 665c255d 2023-08-04 jrmu   (newline))
 9 665c255d 2023-08-04 jrmu 
10 665c255d 2023-08-04 jrmu (define (accumulate op initial sequence)
11 665c255d 2023-08-04 jrmu   (if (null? sequence)
12 665c255d 2023-08-04 jrmu       initial
13 665c255d 2023-08-04 jrmu       (op (car sequence)
14 665c255d 2023-08-04 jrmu 	  (accumulate op initial (cdr sequence)))))
15 665c255d 2023-08-04 jrmu 
16 665c255d 2023-08-04 jrmu (define (accumulate-n op init seqs)
17 665c255d 2023-08-04 jrmu   (if (null? (car seqs))
18 665c255d 2023-08-04 jrmu       '()
19 665c255d 2023-08-04 jrmu       (cons (accumulate op init (map car seqs))
20 665c255d 2023-08-04 jrmu             (accumulate-n op init (map cdr seqs)))))
21 665c255d 2023-08-04 jrmu 
22 665c255d 2023-08-04 jrmu (define (dot-product v w)
23 665c255d 2023-08-04 jrmu   (accumulate + 0 (map * v w)))
24 665c255d 2023-08-04 jrmu 
25 665c255d 2023-08-04 jrmu (define (matrix-*-vector m v)
26 665c255d 2023-08-04 jrmu   (map (lambda (row)
27 665c255d 2023-08-04 jrmu 	 (dot-product row v))
28 665c255d 2023-08-04 jrmu        m))
29 665c255d 2023-08-04 jrmu 
30 665c255d 2023-08-04 jrmu (define (transpose mat)
31 665c255d 2023-08-04 jrmu   (accumulate-n cons '() mat))
32 665c255d 2023-08-04 jrmu 
33 665c255d 2023-08-04 jrmu (define (matrix-*-matrix m n)
34 665c255d 2023-08-04 jrmu   (let ((cols (transpose n)))
35 665c255d 2023-08-04 jrmu     (map (lambda (m-row)
36 665c255d 2023-08-04 jrmu 	   (matrix-*-vector cols m-row))
37 665c255d 2023-08-04 jrmu 	 m)))
38 665c255d 2023-08-04 jrmu 
39 665c255d 2023-08-04 jrmu (define m1 '((1 2 3) (4 5 6) (7 8 9)))
40 665c255d 2023-08-04 jrmu (define m2 '((3 1 9) (3 -2 -4) (7 0 5)))
41 665c255d 2023-08-04 jrmu (define m3 '((30 36 42) (66 81 96) (102 126 150)))
42 665c255d 2023-08-04 jrmu (define m4 '((3 1 9 -5 -2 1)
43 665c255d 2023-08-04 jrmu 	     (3 -2 -4 0 4 8)
44 665c255d 2023-08-04 jrmu 	     (7 0 5 2 3 6)))
45 665c255d 2023-08-04 jrmu (define m5 '((1 5 4)
46 665c255d 2023-08-04 jrmu 	     (2 -1 -3)
47 665c255d 2023-08-04 jrmu 	     (0 5 0)
48 665c255d 2023-08-04 jrmu 	     (-4 0 8)
49 665c255d 2023-08-04 jrmu 	     (5 -1 -2)
50 665c255d 2023-08-04 jrmu 	     (-3 -2 6)))
51 665c255d 2023-08-04 jrmu (define m6 '((12 59 -21)
52 665c255d 2023-08-04 jrmu 	     (-5 -23 58)
53 665c255d 2023-08-04 jrmu 	     (-4 45 74)))
54 665c255d 2023-08-04 jrmu (define m7 '((1 2 0 -4 5 -3)
55 665c255d 2023-08-04 jrmu 	     (5 -1 5 0 -1 -2)
56 665c255d 2023-08-04 jrmu 	     (4 -3 0 8 -2 6)))
57 665c255d 2023-08-04 jrmu (define m8 '((3 3 7)
58 665c255d 2023-08-04 jrmu 	     (1 -2 0)
59 665c255d 2023-08-04 jrmu 	     (9 -4 5)
60 665c255d 2023-08-04 jrmu 	     (-5 0 2)
61 665c255d 2023-08-04 jrmu 	     (-2 4 3)
62 665c255d 2023-08-04 jrmu 	     (1 8 6)))
63 665c255d 2023-08-04 jrmu (define v1 '(1 2 3))
64 665c255d 2023-08-04 jrmu (define v2 '(14 32 50))
65 665c255d 2023-08-04 jrmu (define v3 '(2 -1 4))
66 665c255d 2023-08-04 jrmu (define v4 '(41 -8 34))
67 665c255d 2023-08-04 jrmu 
68 665c255d 2023-08-04 jrmu (test-case (matrix-*-vector m1 v1) v2)
69 665c255d 2023-08-04 jrmu (test-case (matrix-*-vector m2 v3) v4)
70 665c255d 2023-08-04 jrmu 
71 665c255d 2023-08-04 jrmu 
72 665c255d 2023-08-04 jrmu (test-case (transpose m5) m7)
73 665c255d 2023-08-04 jrmu (test-case (transpose m4) m8)
74 665c255d 2023-08-04 jrmu 
75 665c255d 2023-08-04 jrmu (test-case (matrix-*-matrix m1 m1) m3)
76 665c255d 2023-08-04 jrmu (test-case (matrix-*-matrix m4 m5) m6)