昨晩の続き (問題 2.37)
昨晩時点のものまでの試験を書いた。若干微妙。
(use gauche.test) (add-load-path ".") (load "2.37") (test-start "dot-product") (test-section "dot-product") (test* "(dot-product '(0 9) '(2 0))" 0 (dot-product '(0 9) '(2 0))) (test* "(dot-product '(2 0) '(2 0))" 4 (dot-product '(2 0) '(2 0))) (test* "(dot-product '(1 1) '(3 1))" 4 (dot-product '(1 1) '(3 1))) (test-section "m-*-v") (test* "(m-*-v '((1 2 3) (4 5 6)) '(1 2 3))" '(14 32) (m-*-v '((1 2 3) (4 5 6)) '(1 2 3))) (test-end)
残りは transpose と m-*-m になります。まず transpose の試験から以下。
(test-section "transpose") (test* "(transpose '((1 2 3) (4 5 6) (7 8 9)))" '((1 4 7) (2 5 8) (3 6 9)) (transpose '((1 2 3) (4 5 6) (7 8 9))))
実装はどうしたものか、と言いつつ以下でパス。
(define (transpose mat) (accumulate-n cons '() mat))
次は m-*-m なんですが、問題の記述は以下になってます。
(define (m-*-m m n) (let ((cols (transpose n))) (map <??> m)))
ええと、n は transpose してるので map に渡す手続きの中身は行列の積の定義によれば以下で良いのかな。
(lambda (row-m) (map (lambda (row-cols) (dot-product row-m row-cols)) cols))
しまった試験が先。数学入門の例から以下。
(test-section "m-*-m") (test* "(m-*-m '((1 3) (2 4)) '((4 2) (3 1)))" '((13 5) (20 8)) (m-*-m '((1 3) (2 4)) '((4 2) (3 1)))) (test* "(m-*-m '((4 2) (3 1)) '((1 3) (2 4)))" '((8 20) (5 13)) (m-*-m '((4 2) (3 1)) '((1 3) (2 4))))
試験パス。実装以下です。
(define (m-*-m m n) (let ((cols (transpose n))) (map (lambda (row-m) (map (lambda (row-cols) (dot-product row-m row-cols)) cols)) m)))
これ、もう少しなんとかならんかな。