sicp(14)m2.37〜m2.39

;;復習 accumulateとaccumulate-nを作る。
(define (accumulate op init seq)
  (if (null? seq)
      init
      (op (car seq) (accumulate op init (cdr seq)))))
(define (accumulate-n op init seq)
  (if (null? (car seq))
      '()
      (cons (accumulate op init (map car seq))
            (accumulate-n op init (map cdr seq)))))
;	gosh> (accumulate + 0 '(1 2 3 4))
;	10
;	gosh> (accumulate-n + 0 '((1 2) (10 10)))
;	(11 12)

;;m2.37
;;とりあえず、問題の元の行列を手軽に呼び出せるようする
(define ei enumerate-interval)
(define m2.37 (list (ei 1 4) (append (ei 4 6) '(6)) (ei 6 9)))

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

(define (matrix-*-vector m v)
  (map (lambda (xs) (map * v xs)) m))
;	gosh> (matrix-*-vector m2.37 '(1 10 100 1000))
;	((1 20 300 4000) (4 50 600 6000) (6 70 800 9000))
;;あー総和にするんだった。
(define (matrix-*-vector m v)
  (map (lambda (xs) (dot-product xs v)) m))
;	gosh> (matrix-*-vector m2.37 '(1 10 100 1000))
;	(4321 6654 9876)
;;これで問題なし。
;;(下の関数は上の関数を使って作るのかもしれない）

;;(transpose (a b) (c d) (e f))
;;((a c e) (b d e))
;;こんな感じになればいい。
;;ということで、
(define (traspose mat)
  (accumulate-n (lambda (x y) (cons x y)) '() mat))
;	gosh>  (traspose m2.37)
;	((1 4 6) (2 5 7) (3 6 8) (4 6 9))
;;確認。
;	gosh> (traspose (traspose m2.37))
;	((1 2 3 4) (4 5 6 6) (6 7 8 9))
;	gosh> m2.37
;	((1 2 3 4) (4 5 6 6) (6 7 8 9))
;;教科書のものと同じ。

;;mapの引数になるのはリスト中の要素だから、
;;mapの引数内はベクトルと同じような形のリストになる。
;;(というより、matrix-*-vectorの組み合わせと考えることができる。
(define (matrix-*-mat m n)
  (let ((cols (traspose n)))
    (map (lambda (x) (matrix-*-vector cols x)) m)))
(define x '((1 2) (3 4)))
(define y '((1 10) (100 1000)))
;	gosh> (matrix-*-mat x y) 
;	((201 2010) (403 4030))

;;m2.38
(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest ))))
  (iter initial sequence))
;;てきとーにfold-rightも作る。
(define (fold-right op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (fold-right op initial (cdr sequence)))))
;(fold-right / 1 '(1 2 3))
;;右から順に進んでいくので
;;=((3/2)/1)/1=3/2
;;
;(fold-left / 1 '(1 2 3))
;;こちらは左から
;;=((1/1)/2)/3=1/6
;;確かめ
;	gosh> (fold-right / 1 '(1 2 3))
;	3/2
;	gosh> (fold-left / 1 '(1 2 3))
;	1/6

;;これだけで十分
;;満たすべき性質はは(op x y)=(op y x)になること

;;m2.39
(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))
(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) '() sequence))
;;完成。
;;何気にrの方が難しい。
;	gosh> (reverse-r '(1 2 3))
;	(3 2 1)
;	gosh> (reverse-l '(a b c))
;	(c b a)

;;昔困っていた再帰的なreverseの定義のしかたが分かった。
;;(reverseは再帰的には定義できない。そのように思っていた時もありましたww)
(define (recur-reverse lst)
  (if (null? lst)
      '()
      (append (recur-reverse (cdr lst))
              (list (car lst)))))
;	gosh> (recur-reverse '(1 2 3))
;	(3 2 1)

;prime?を使えるようにする。
(define (prime? n)
  (define (smallest-divisor n)
    (find-divisor n 2))
  (define (find-divisor n test-divisor)
    (cond ((> (square test-divisor) n) n)
          ((divides? test-divisor n) test-divisor)
          (else (find-divisor n (+ test-divisor 1)))))
  (define (divides? a b)
    (= (remainder b a) 0))
  (= n (smallest-divisor n)))
(define (square x) (* x x))

;;ここから、教科書の書写
;;＝＝和が素数になる数字を探す。==
(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (let ((l (car pair))
        (r (cadr pair)))
  (list l r (+ l r))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)))))
;;すごい！
;	gosh> (prime-sum-pairs 5)
;	((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7))

(define (list-fib-squares n)
  (accumulate cons
              '()
              (map square
                   (map fib
                        (enumerate-interval 0 n)))))
(define (fib n)
  (define (f next result count)
    (if (= count 0)
        result
        (f (+ next result) next (- count 1))))
  (f 1 0 n))
;	gosh> (list-fib-squares 10)
;	(0 1 1 4 9 25 64 169 441 1156 3025)
;	gosh> (accumulate cons '() (map fib (enumerate-interval 0 10)))
;	(0 1 1 2 3 5 8 13 21 34 55)