learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-37.scm (2446B)

      1 ;; Exercise 2.37
      2 
      3 (define (exercise-2.37)
      4   (define (matrix-ref m i j)
      5     (list-ref (list-ref m i) j))
      6 
      7   (define (dot-product v w)
      8     (accumulate +
      9                 0
     10                 (map *
     11                      v
     12                      w)))
     13 
     14   (define (dumb-dot-product v w)
     15     (sum (list-ec (: i
     16                      (length v))
     17                   (* (list-ref v
     18                                i)
     19                      (list-ref w
     20                                i)))))
     21 
     22   (define (matrix-*-vector m v)
     23     (map (lambda (w) (dot-product v
     24                                   w))
     25          m))
     26 
     27   (define (dumb-matrix-*-vector m v)
     28     (list-ec (: i
     29                 (length m))
     30              (accumulate +
     31                          0
     32                          (list-ec (: j
     33                                      (length v))
     34                                   (* (matrix-ref m i j)
     35                                      (list-ref v
     36                                                j))))))
     37 
     38   (define (transpose mat)
     39     (accumulate-n cons
     40                   '()
     41                   mat))
     42 
     43   (define (dumb-transpose mat)
     44     (list-ec (: j
     45                 (length (car mat)))
     46              (list-ec (: i
     47                          (length mat))
     48                       (matrix-ref mat i j))))
     49 
     50   (define (matrix-*-matrix m n)
     51     (let ([cols (transpose n)])
     52       (map (lambda (v)
     53              (matrix-*-vector cols v))
     54            m)))
     55 
     56   (define (dumb-matrix-*-matrix m n)
     57     ;; p_ij = sum_k(m_ik * n_kj)
     58     (list-ec (: i (length m))
     59              (list-ec (: j (length (car n)))
     60                       (sum-ec (: k (length n))
     61                               (* (matrix-ref m i k)
     62                                  (matrix-ref n k j))))))
     63 
     64   (define v '(2 3 5 7))
     65 
     66   (define M
     67     '((1 2 3 4)
     68       (4 5 6 6)
     69       (6 7 8 9)))
     70 
     71   (define M-transposed
     72     '((1 4 6)
     73       (2 5 7)
     74       (3 6 8)
     75       (4 6 9)))
     76 
     77   (test-begin "2.37")
     78   (test-equal
     79       (dumb-transpose M)
     80     (transpose M))
     81   (test-equal
     82       (dumb-matrix-*-vector M
     83                             v)
     84     (matrix-*-vector M
     85                      v))
     86   (test-equal
     87       (dumb-matrix-*-matrix M
     88                             M-transposed)
     89     (matrix-*-matrix M
     90                      M-transposed))
     91   (test-equal
     92       (dumb-matrix-*-matrix '((2 3) (5 7))
     93                             '((2 3) (5 7)))
     94     (matrix-*-matrix '((2 3) (5 7))
     95                      '((2 3) (5 7))))
     96   (test-end "2.37"))
     97 
     98 (exercise-2.37)