計算機プログラムの構造と解釈 第二版 P69 問題2.37

この問題はいろいろ調べた。


そもそも行列の計算方法をうっかりわすれていたから、
問題をみてもあまりピンとこなかったからだ。
手続きの名前をみて


matrixは行列
vectorは列


ってのにピンとくればわりかし楽ちん。
あと、問題の順番がちゃんとしてるので、考え方が順序だてられていいですね。


問題自体は穴埋めです。


まず、dot-productの意味は内積ってことで
ベクトル内積の求め方はこうだ!
内積(KIT数学ナビゲーション)
http://w3e.kanazawa-it.ac.jp/math/category/vector/henkan.cgi?target=/math/category/vector/naiseki.html

空間ベクトル(3次元)の場合
a → =( a 1 , a 2 , a 3 ) , b → =( b 1 , b 2 , b 3 ) とすると、
a → · b → = a 1 b 1 + a 2 b 2 + a 3 b 3
となる 。

なるほど。


次にmatrix-*-vectorの意味は、行列×ベクトルって意味だと思う。
僕はとても2x2の行列をうまく表現できる自信がないので、本文の書式を若干借りると
行列の積はこんな感じで求める。

( (a1 a2)
  (a3 a4) ) × (b1 b2) = ( (a1 × b1 + a2 × b2) (a3 × b1 + a4 × b2) )

具体的にすると

( (2 -1)
  (-3 4) ) × (1 2) = ( (2 × 1 + (-1) ×2) (-3 × 1 + 4 × 2))
                                  = (0 5)

みたいな感じだ。


matrix-*-matrixはどう考えても、行列×行列でしょう。

( (a1 a2 a3)       ( (b1 b2) 
  (a4 a5 a6) ) ×   (b3 b4)
                          (b5 b6)
                          
= ( (a1 × b1 + a2 × b3 + a3 × b5) (a1 × b2 + a2 × b4 + a3 × b6)
      (a4 × b1 + a5 × b3 + a6 × b5) (a4 × b2 + a5 × b4 + a6 × b6) )


transeposeってのは、行列の行と列の入れ替えをどうやら行っているようで、

( (a1 a2)
 (b1 b2) )
が
( (a1 b1)
 (a2 b2) )

とか

( (a1 a2 a3)
  (b1 b2 b3) )
が
((a1 b1)
 (a2 b2)
 (a3 b2))

ってなれば良いってことだ。


上記をふまえつつ、実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(use ggc.debug.trace)
(use math.mt-random)

(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 car seqs))
          (accumulate-n op init (map cdr seqs)))))


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


(define (matrix-*-vector m v)
  (map (lambda (x) (dot-product x v)) m)) 


(define (transpose mat)
  (accumulate-n (lambda (x y) (cons x y)) nil mat))


(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (matrix-*-vector cols x)) m)))
  

;; main
(define (main args)

  (display "(dot-product '(1 2 3) '(4 5 6)): ")
  (display (dot-product '(1 2 3) '(4 5 6)))
  (newline)
  (newline)

  (display "(matrix-*-vector '((1 2) (3 4)) '(1 2)): ")
  (display (matrix-*-vector '((1 2) (3 4)) '(1 2)))
  (newline)
  (newline)

  (display "(map car '((1 2) (3 4) (5 6))): ")
  (display (map car '((1 2) (3 4) (5 6))))
  (newline)
  (display "(transpose '((1 2) (3 4) (5 6))): ")
  (display (transpose '((1 2) (3 4) (5 6))))
  (newline)
  (newline)

  (display "(car '((1 2) (3 4))): ")
  (display (car '((1 2) (3 4))))
  (newline)
  (display "(transpose '((5 6) (7 8))): ")
  (display (transpose '((5 6) (7 8))))
  (newline)

  (display "(matrix-*-vector (transpose '((5 6) (7 8))) (car '((1 2) (3 4)))): ")
  (display (matrix-*-vector (transpose '((5 6) (7 8))) (car '((1 2) (3 4)))))
  (newline)

  (display "(matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8))): " )
  (display (matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8))))
  (newline)

  0)


実行

(dot-product '(1 2 3) '(4 5 6)): 32

(matrix-*-vector '((1 2) (3 4)) '(1 2)): (5 11)

(map car '((1 2) (3 4) (5 6))): (1 3 5)
(transpose '((1 2) (3 4) (5 6))): ((1 3 5) (2 4 6))

(car '((1 2) (3 4))): (1 2)
(transpose '((5 6) (7 8))): ((5 7) (6 8))
(matrix-*-vector (transpose '((5 6) (7 8))) (car '((1 2) (3 4)))): (19 22)
(matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8))): ((19 22) (43 50))