さかもとのブログ

つらつらと

SICP演習問題2.33~2.39

;;;exercise2.33                                                                                                                                
(define (my-map p sequence)
  (accumulate (lambda (x y)
                (cons (p x) y))
              '()
              sequence))
(define (my-append seq1 seq2)
  (accumulate cons
              seq2
              seq1))
(define (my-length sequence)
  (accumulate (lambda (x y)
                (+ 1 y))
              0
              sequence))

;;;exercise2.34                                                                                                                                
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda  (this-coeff higher-terms)
                (+ this-coeff (* x higher-terms)))
              0
              coefficient-sequence))
(horner-eval 2 '(1 3 0 5 0 1))
(horner-eval 2 '(1 1 2 3 4))

;;;exercise2.35                                                                                                                                
;;;解答参照                                                                                                                                    
;;;やっぱりmapの中にcount-leavesだ                                                                                                             
(define (count-leaves t)
  (accumulate +
              0
              (map (lambda (x)
                     (if (pair? x) (count-leaves x) 1)) t)))
(count-leaves '((1 2) (3 4)))

;;;exercise2.36                                                                                                                                
;;;忘れるな mapは勝手にリスト化する                                                                                                           
(map (lambda (x)
      (cdr x))
     '((1 2) (3 4) (5 6)))
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      '()
      (cons (accumulate   op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))
(accumulate-n + 0
              '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
;;;exercise2.37                                                                                                                                
;;;忘れるな mapは複数のリストを受け取れる                                                                                                      
(define (dot-product v w)
  (accumulate + 0 (map * v w)))
(dot-product '(1 2 3) '(1 2 3))

(define (matrix-*-vector m v)
  (map (lambda (n)
         (dot-product v n))
       m))
(matrix-*-vector '((1 2 3) (1 2 3)) '(2 2 2))

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

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
           (matrix-*-vector cols x))
         m)))
(matrix-*-matrix '((1 5) (-3 7)) '((2 2) (8 4)))

;;;exercise2.38                                                                                                                                
(define (fold-right op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (fold-right op initial (cdr sequence)))))
(define (fold-left op initial sequence)                                                                                                        
  (let loop ((result initial)                                                                                                                  
             (rest sequence))                                                                                                                  
    (if (null? rest)                                                                                                                           
        result                                                                                                                                 
        (loop (op result (car rest))                                                                                                           
              (cdr rest)))))

(fold-right / 1 '(1 2 3))
(fold-left / 1 '(1 2 3))

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

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

;;;exercise2.39                                                                                                                                
(define reverse (with-module gauche reverse))

(define (my-reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))
(my-reverse '(1 2 3))

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

accumulateで抽象の壁を作るとは言っても, 明らかにaccumulateの実装を意識しながら使っているから,正確には壁ができていないのでは..と思ってしまった.

例えば

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

(lambda (x y) (append y (list x)))

は,fold-rightで(car sequence)を使っていることを知らなければ,(list x)にするなんて分からない.
明らかに用いる抽象関数の実装を意識して使わなければならない.