SICP 読み (25)

問題 2.37 は、どハマリ。

問題 2.37

これは違う意味での予習が必要だな。
と、言いつつ勝手読みで進めていたら大きなボケをカマしていた。(駄目

matrix-*-vector は ((1 2) (3 4)) と (5 6) を渡すと

(1*5+2*6 3*5+4*6)

を返すのか。
最初は

(1*5+3*5 2*6+3*6)

と勘違いしていた。無理矢理動くのでっちあげたのは良いんですが問題の形にはどーやったって変形できん (当たり前

(define (matrix-*-vector m v)
 (map * v (map (lambda (x) (accumulate + 0 x)) (accumulate-n cons '() m))))

で相当頭がアツくなっていたのですが、できた。

(define (matrix-*-vector m v)
 (map (lambda (x) (accumulate + 0 (map * v x))) m))

次、なんとなくカンで試してみたらできた。(こら

gosh> (define m '((1 2 3) (4 5 6) (7 8 9)))
m
gosh> (accumuate-n cons '() m)
((1 4 7) (2 5 8) (3 6 9))
gosh>

なんで上手くいったのかは謎なので置き換えで検証を。

(accumulate-n cons '() '((1 2 3) (4 5 6) (7 8 9)))

(cons (accumulate cons '() '(1 4 7))
      (accumulate-n cons '() '((2 3) (5 6) (8 9))))

(cons '(1 4 7)
      (cons (accumulate cons '() '(2 5 8))
	    (accumulate-n cons '() '((3) (6) (9)))))

(cons '(1 4 7)
      (cons '(2 5 8)
	    (cons (accumulate cons '() '(3 6 9))
		  (accumulate-n cons '() '(() () ())))))

(cons '(1 4 7)
      (cons '(2 5 8)
	    (cons '(3 6 9)
		  '())))

((1 4 7) (2 5 8) (3 6 9))

まだまだ頭がアツいらしい。大丈夫だろうか。次は matrix-*-matrix ですが、以下のような形で計算 (内積というやつですか??) との事。

((m11 m12) (m21 m22)) * ((n11 n12) (n21 n22))
-> ((m11*n11 + m12*n21) (m11*n12 + m12*n22)
   (m21*n11 + m22*n21) (m21*n12 + m22*n22))

ex.)
((1 2) (3 4)) * ((5 6) (7 8))
-> ((1*5+2*7) (1*6+2*8)
   (3*5+4*7) (3*6+4*8))
-> ((19 22) (43 50))

transpose してるのであれば、順に掛けてあげれば良いという事で以下。

(define (transpose mat)
  (accumulate-n cons '() mat))
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x) (map (lambda (y) (accumulate + 0 (map * x y))) cols)) m)))

((1 2) (3 4)) * ((5 6) (7 8)) を例に置き換えてみます。

(matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8)))

(map (lambda (x)
       (map (lambda (y)
	      (accumulate + 0 (map * x y)))
	    '((5 7) (6 8))))
     '((1 2) (3 4)))

(cons ((lambda (x)
	 (map (lambda (y)
		(accumulate + 0 (map * x y)))
	      '((5 7) (6 8)))) '(1 2))
      (map (lambda (x)
	     (map (lambda (y)
		    (accumulate + 0 (map * x y)))
		  '((5 7) (6 8))))
	   '((3 4))))

(cons (map (lambda (y)
	     (accumulate + 0 (map * '(1 2) y))) '((5 7) (6 8)))
      (map (lambda (x)
	     (map (lambda (y)
		    (accumulate + 0 (map * x y)))
		  '((5 7) (6 8))))
	   '((3 4))))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (map (lambda (y)
		   (accumulate + 0 (map * '(1 2) y))) '((6 8))))
      (map (lambda (x)
	     (map (lambda (y)
		    (accumulate + 0 (map * x y)))
		  '((5 7) (6 8))))
	   '((3 4))))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  (map (lambda (y)
			 (accumulate + 0 (map * '(1 2) y))) '(()))))
      (map (lambda (x)
	     (map (lambda (y)
		    (accumulate + 0 (map * x y)))
		  '((5 7) (6 8))))
	   '((3 4))))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (map (lambda (x)
	     (map (lambda (y)
		    (accumulate + 0 (map * x y)))
		  '((5 7) (6 8))))
	   '((3 4))))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (cons ((lambda (x)
	       (map (lambda (y)
		      (accumulate + 0 (map * x y)))
		    '((5 7) (6 8)))) '(3 4))
	    (map (lambda (x)
		   (map (lambda (y)
			  (accumulate + 0 (map * x y)))
			'((5 7) (6 8)))) '())))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (cons (cons ((lambda (y)
		     (accumulate + 0 (map * '(3 4) y))) '(5 7))
		  (map (lambda (y)
			 (accumulate + 0 (map * '(3 4) y))) '((6 8))))
	    (map (lambda (x)
		   (map (lambda (y)
			  (accumulate + 0 (map * x y)))
			'((5 7) (6 8)))) '())))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (cons (cons ((lambda (y)
		     (accumulate + 0 (map * '(3 4) y))) '(5 7))
		  (cons ((lambda (y)
			   (accumulate + 0 (map * '(3 4) y))) '(6 8))
			(map (lambda (y)
			       (accumulate + 0 (map * '(3 4) y))) '(()))))
	    (map (lambda (x)
		   (map (lambda (y)
			  (accumulate + 0 (map * x y)))
			'((5 7) (6 8)))) '())))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (cons (cons (accumulate + 0 (map * '(3 4) '(5 7)))
		  (cons (accumulate + 0 (map * '(3 4) '(6 8)))
			'()))
	    (map (lambda (x)
		   (map (lambda (y)
			  (accumulate + 0 (map * x y)))
			'((5 7) (6 8)))) '())))

(cons (cons (accumulate + 0 (map * '(1 2) '(5 7)))
	    (cons (accumulate + 0 (map * '(1 2) '(6 8)))
		  '()))
      (cons (cons (accumulate + 0 (map * '(3 4) '(5 7)))
		  (cons (accumulate + 0 (map * '(3 4) '(6 8)))
			'()))
	    '()))

(cons (cons 19 (cons 22 '())) (cons (cons 43 (cons 50 '())) '()))

((19 22) (43 50))

これ、きちんと落ち着いてやらないと全然駄目だ。
# やり直しを何度かしております。

問題 2.38

それぞれの実装は以下。

(define (fold-right op init seq)
 (if (null? seq)
     init
     (op (car seq)
         (fold-right op init (cdr seq)))))

(define (fold-left op init seq)
  (define (iter result rest)
    (if (null? rest)
	result
      (iter (op result (car rest))
	    (cdr rest))))
  (iter init seq))

例えば (fold-right + 0 '(1 2 3)) だと

(fold-right + 0 '(1 2 3))

(+ (car '(1 2 3)) (fold-right + 0 (cdr '(1 2 3))))

(+ 1 (+ (car '(2 3)) (fold-right + 0 (cdr '(2 3)))))

(+ 1 (+ 2 (+ (car '(3)) (fold-right + 0 (cdr '(3))))))

(+ 1 (+ 2 (+ 3 (fold-right + 0 '()))))

(+ 1 (+ 2 (+ 3 0)))

6

あるいは (fold-left + 0 '(1 2 3)) だと

(fold-left + 0 '(1 2 3))

(iter 0 '(1 2 3))

(iter (+ 0 (car '(1 2 3))) (cdr '(1 2 3)))

(iter (+ 0 1) '(2 3))

(iter (+ 1 (car '(2 3))) (cdr '(2 3)))

(iter (+ 1 2) '(3))

(iter (+ 3 (car '(3))) (cdr '(3)))

(iter (+ 3 3) '())

6

右側の要素から op の適用が始まるから fold-right で左側の要素から op が適用されていくのが fold-left
ですか。とすると (fold-right / 1 (list 1 2 3)) は

(fold-right / 1 (list 1 2 3))

(/ 1 (/ 2 (/ 3 1)))

1.5

で、(fold-left / 1 (list 1 2 3)) は

(fold-left / 1 (list 1 2 3))

(/ (/ (/ 1 1) 2) 3)

0.16666666666666666

になるのかな。あるいは (fold-right list '() (list 1 2 3)) は

(fold-right list '() (list 1 2 3))

(list 1 (list 2 (list 3 '())))

(1 (2 (3 ())))

で、(fold-left list '() (list 1 2 3)) は

(fold-left list '() (list 1 2 3))

(list (list (list '() 1) 2) 3)

(((() 1) 2) 3)

になるか。足し算とかだと影響ない気がするがどうか。確認したら * も差異は無い模様。

op が満たすべき性質としては

(op l1 (op l2 (op l3 init)))

と

(op (op (op init l1) l2) l3)

が一緒である事、ってなんかハクチ的なソレだな。op に渡されたリストの並び順を問わない、という性質と言えば良いのかな。

問題 2.39

再度、fold-right と fold-left を以下に。

(define (fold-right op init seq)
  (if (null? seq)
      init
      (op (car seq)
	  (fold-right op init (cdr seq)))))

(define (fold-left op init seq)
  (define (iter result rest)
    (if (null? rest)
	result
	(iter (op result (car rest))
	      (cdr rest))))
  (iter init seq))

あと、2.18 の reverse の解は以下。

(define (reverse l)
 (let f ((l l) (result '()))
  (if (null? l)
      result
      (f (cdr l) (cons (car l) result)))))

(1 2 3) を reverse する時の置き換えの様子を以下に。

(reverse '(1 2 3))

(f '(1 2 3) '())

(f '(2 3) (cons 1 '()))

(f '(3) (cons 2 (cons 1 '())))

(f '() (cons 3 (cons 2 (cons 1 '()))))

(cons 3 (cons 2 (cons 1 '())))

これベースで考えると検討しやすいのは fold-left だな。fold-right の方は cons なんて使えっこないので append で何とかならんか、と以下。

(define (reverse seq)
  (fold-right (lambda (x y) (append y (list x))) '() seq))

(define (reverse seq)
  (fold-left (lambda (x y) (cons y x)) '() seq))

どうも試験ドリブンと言いながらそれをサボってるなぁ。(駄目