Hatena::Groupcsnagoya-sicp

クラなんとかの日記 このページをアンテナに追加 RSSフィード

 | 

2009-06-11準備会

2.37

| 2.37 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.37 - クラなんとかの日記 2.37 - クラなんとかの日記 のブックマークコメント

matrix-*-vector, transpose, matrix-*-matrix を定義せよ.

matrix の定義がわかればわかる問題.2.36 も参照のこと.

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

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

; 2.36 より
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      (list)
      (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 (w)
;         (dot-product w v))
         (list (dot-product w v))) ; 6/18 訂正 list が抜けていた
       m))

(define (transpose mat)
  (accumulate-n cons (list) mat))

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

;; 確認
(define m (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))
(define n (list (list 2 4) (list 6 8) (list 9 7) (list 1 3)))
(define v (list 1 2 3 4))

(display m) (newline) ; ((1 2 3 4) (4 5 6 6) (6 7 8 9))
(display n) (newline) ; ((2 4) (6 8) (9 7) (1 3))
(display v) (newline) ; (1 2 3 4)
(display (matrix-*-vector m v)) (newline) ; (30 56 80)
(display (transpose m)) (newline) ; ((1 4 6) (2 5 7) (3 6 8) (4 6 9))
(display (matrix-*-matrix m n)) (newline) ; ((45 53) (98 116) (135 163))
 |