commit c5567c05930e1c11f66aac2b2f8b163126fa127c parent 31d105aa3d3ce6320aa36ae76136713dcab05a10 Author: Yuval Langer <yuval.langer@gmail.com> Date: Sun, 12 Mar 2023 12:31:41 +0200 Add exercise 2.36. Diffstat:
| M | guile.scm | | | 124 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------- |
1 file changed, 112 insertions(+), 12 deletions(-)
diff --git a/guile.scm b/guile.scm @@ -2394,19 +2394,20 @@ Iterative. ;; Exercise 2.36 -(define (exercise-2.36) - (define (accumulate-n op init seqs) - (if (null? (car seqs)) - '() - (cons (accumulate op +(define (accumulate-n op init seqs) + ;; Took it out of exercise-2.36 because we'll need it later in 2.37. + (if (null? (car seqs)) + '() + (cons (accumulate op + init + (map (lambda (x) (car x)) + seqs)) + (accumulate-n op init - (map (lambda (x) (car x)) - seqs)) - (accumulate-n op - init - (map (lambda (x) (cdr x)) - seqs))))) - + (map (lambda (x) (cdr x)) + seqs))))) + +(define (exercise-2.36) (test-begin "2.36") (test-equal '(22 26 30) @@ -2417,3 +2418,102 @@ Iterative. (test-end "2.36")) (exercise-2.36) + +;; Exercise 2.37 + +(define (exercise-2.37) + (define (matrix-ref m i j) + (list-ref (list-ref m i) j)) + + (define (dot-product v w) + (accumulate + + 0 + (map * + v + w))) + + (define (dumb-dot-product v w) + (sum (list-ec (: i + (length v)) + (* (list-ref v + i) + (list-ref w + i))))) + + (define (matrix-*-vector m v) + (map (lambda (w) (dot-product v + w)) + m)) + + (define (dumb-matrix-*-vector m v) + (list-ec (: i + (length m)) + (accumulate + + 0 + (list-ec (: j + (length v)) + (* (matrix-ref m i j) + (list-ref v + j)))))) + + (define (transpose mat) + (accumulate-n cons + '() + mat)) + + (define (dumb-transpose mat) + (list-ec (: j + (length (car mat))) + (list-ec (: i + (length mat)) + (matrix-ref mat i j)))) + + (define (matrix-*-matrix m n) + (let ([cols (transpose n)]) + (map (lambda (v) + (matrix-*-vector cols v)) + m))) + + (define (dumb-matrix-*-matrix m n) + ;; p_ij = sum_k(m_ik * n_kj) + (list-ec (: i (length m)) + (list-ec (: j (length (car n))) + (sum-ec (: k (length n)) + (* (matrix-ref m i k) + (matrix-ref n k j)))))) + + (define v '(2 3 5 7)) + + (define M + '((1 2 3 4) + (4 5 6 6) + (6 7 8 9))) + + (define M-transposed + '((1 4 6) + (2 5 7) + (3 6 8) + (4 6 9))) + + (test-begin "2.37") + (test-equal + (dumb-transpose M) + (transpose M)) + (test-equal + (dumb-matrix-*-vector M + v) + (matrix-*-vector M + v)) + (test-equal + (dumb-matrix-*-matrix M + M-transposed) + (matrix-*-matrix M + M-transposed)) + (test-equal + (dumb-matrix-*-matrix '((2 3) (5 7)) + '((2 3) (5 7))) + (matrix-*-matrix '((2 3) (5 7)) + '((2 3) (5 7)))) + (test-end "2.37")) + +(exercise-2.37)