問題2-33〜36

｢公認インターフェイスとしての並び｣に関する部分を読み進めています。accumulateというインターフェイスを使ってどんなことができるのかということを試す問題に少しずつ取り組んでいます。
accumulate手続きの実装は、以下のようになっています。三つ目の引数に、操作対象となる｢リスト｣を置きます。そのリストを先頭から順に走査していくわけですが、次の要素に移るときに何をするのかを、accumulateの一つ目の引数で指定します。二つ目の引数は、その初期値になります。

(define sample-list (list 1 2 3 4 5))

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

(accumulate + 0 sample-list)

=>15

まずは、問題2-33です。mapやappend、lengthなど、これまでに登場した手続きをaccumulateで書いてみます。

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y))
              '()
              sequence))

(define (square x) (* x x))

(map square sample-list)

=>(1 4 9 16 25)

(define (append seq1 seq2)
  (accumulate cons
              seq2
              seq1))

(append sample-list sample-list)

=>(1 2 3 4 5 1 2 3 4 5)

(define (length sequence)
  (accumulate (lambda (x y) (+ 1 y))
              0
              sequence))

(length sample-list)
(length (append sample-list sample-list))

=>5
=>10

次の問題2-34は、以下のように書きました。要素間の操作部分で、順番を入れ替えてもいいことに気付くまでに、少し時間がかかりました。

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ (* higher-terms x)
                   this-coeff))
              0
              coefficient-sequence))

(horner-eval 2 (list 1 3 0 5 0 1))

=>79

問題2-35のcount-leaves再定義は、以下のように書きました。treeの各要素を強制的に｢1｣にしてしまい、それらを足し上げるようにしています。

(define (enumerate-tree tree)
  (cond ((null? tree) '())
        ((not (pair? tree)) (list tree))
        (else (append (enumerate-tree (car tree))
                      (enumerate-tree (cdr tree))))))

(define (count-leaves t)
  (accumulate +
              0
              (map (lambda (x) (* x (/ 1 x)))
                   (enumerate-tree t))))

(define x (list (list 1 2) (list 3 4)))

(count-leaves (list x x))

=>8

もう一つ、問題2-36では、accumulateを改良したaccumulate-nを定義します。現在取り組んでいるマトリックス問題につながる考え方だということを、このエントリーを書きながら感じ取ることができました。

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      '()
      (cons (accumulate op 
                        init
                        (map car seqs))
            (accumulate-n op
                          init
                          (map cdr seqs)))))

(define s (list (list 1 2 3)
                (list 4 5 6)
                (list 7 8 9)
                (list 10 11 12)))

(accumulate-n + 0 s)

=>(22 26 30)