SICP q2.37

gistfile1.scm

(define nil '())

(define (accumulate op initial sequence)
  (if (null? sequence)
    initial
    (op (car sequence)
        (accumulate op initial (cdr sequence)))))

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
    nil
    (cons (accumulate op init (map (lambda (x) (car x)) seqs))
          (accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))

;----------------------------------------------------------------------------

(define m (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(print (dot-product (list 1 2 3 4) (list 1 1 1 1)))   ; 10
(print (dot-product (list 4 5 6 6) (list 1 1 1 1)))   ; 21
(print (dot-product (list 6 7 8 9) (list 1 1 1 1)))   ; 30

;----------------------------------------------------------------------------
; ひとつひとつの要素がdot-productの結果なので
(define (matrix-*-vector m v)
  (map (lambda (row) (dot-product row v)) m))

(print (matrix-*-vector m (list 1 1 1 1))) ; (10 21 30)

;----------------------------------------------------------------------------
; (define m (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))
; のときtransposeは
; (list (list 1 4 6) (list 2 5 7) (list 3 6 8) (list 4 6 9))
; (list (cons 1 (cons 4 (cons 6 nil))) (list 2 5 7) (list 3 6 8) (list 4 6 9))
; なので先頭をconsでまとめていけばいい
(define (transpose mat)
  (accumulate-n cons nil mat))

(print (transpose m))

;----------------------------------------------------------------------------
; 行列の積はtransposeしてその行列とrow（vector）との積になるので
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
  (map (lambda (row) (matrix-*-vector cols row)) m)))

(define id (list (list 1 0 0 0) (list 0 1 0 0) (list 0 0 1 0) (list 0 0 0 1)))
(print (matrix-*-matrix m id))