@uents blog

Code wins arguments.

SICP 読書ノート#8 - 2.2.3 公認インターフェースとしての並び (pp.65-70)

「§2.2.3 公認インターフェースの並び」から。

公認インターフェース(conventional interfaces)というのがよくわからないけど、信号処理のフィルタのように手続きを組み合わせてプログラムを構成することを考える模様。

並びの演算

filterやaccumulateの実装。accumulateは1章でも出てきたけど復習。

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

(accumulate + 0 (range 1 6)) ;; => 15
(accumulate * 1 (range 1 6)) ;; => 120

「これってreduceだよね?」と思い、Schemeの解釈系に同等の組み込み手続きがあるのではと探したら、Racketにはfoldr (fold-right) および foldl (fold-left) が用意してあった。

racket@> (foldr + 0 (range 1 6)) ;; => 15
racket@> (foldr * 1 (range 1 6)) ;; => 120

fold-right、fold-leftは初期値z、リスト (a1, a2, ..., a[n-1], an) に対して以下のように作用する。

folder-right : (a1, a2, ..., a[n-1], an) => (f a1 (f a2 ... (f a[n-1] (f an z)) ... ))
folder-left  : (a1, a2, ..., a[n-1], an) => (f an (f a[n-1] ... (f a2 (f a1 z)) ... ))

と思いきや、SICPのfolder-leftは違う模様。RnRSはどっちなだろう?

folder-left  : (a1, a2, ..., a[n-1], an) => (f (f ... (f (f z a1) a2) ... a[n-1]) an)

また、SRFI1 Libraryをロードすると reduce、reduce-right も使える。

racket@> (require srfi/1)
racket@> (reduce-right + 0 (range 1 6))
15
racket@> (reduce-right * 1 (range 1 6))
120

問題 2.33

map, append, lengthをaccumlateを使って実装する。

(define (my-map proc sequence)
  (accumulate (lambda (x y) (cons (proc x) y)) nil sequence))

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

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

実行結果。

racket@> (my-map square (range 1 6))
>(accumulate #<procedure> '() '(1 2 3 4 5))
> (accumulate #<procedure> '() '(2 3 4 5))
> >(accumulate #<procedure> '() '(3 4 5))
> > (accumulate #<procedure> '() '(4 5))
> > >(accumulate #<procedure> '() '(5))
> > > (accumulate #<procedure> '() '())
< < < '()
< < <'(25)
< < '(16 25)
< <'(9 16 25)
< '(4 9 16 25)
<'(1 4 9 16 25)
'(1 4 9 16 25)

racket@> (my-append (range 1 4) (range 11 14))
>(accumulate #<procedure:cons> '(11 12 13) '(1 2 3))
> (accumulate #<procedure:cons> '(11 12 13) '(2 3))
> >(accumulate #<procedure:cons> '(11 12 13) '(3))
> > (accumulate #<procedure:cons> '(11 12 13) '())
< < '(11 12 13)
< <'(3 11 12 13)
< '(2 3 11 12 13)
<'(1 2 3 11 12 13)
'(1 2 3 11 12 13)

racket@> (my-length (range 11 14))
>(accumulate #<procedure> 0 '(11 12 13))
> (accumulate #<procedure> 0 '(12 13))
> >(accumulate #<procedure> 0 '(13))
> > (accumulate #<procedure> 0 '())
< < 0
< <1
< 2
<3
3

問題 2.34

Honerの方法で得られる多項式は、

a0*1 + a1*x^1 + a2+x^2 + .... + a(n-1)*x^(n-1) + an*x^n
= a0 + x * (a1 + x * (a2 + ... + x * (a(n-1) + x * an)))

と書けるため、accumulate に与えるλ式

;; higher-termsはそれまでの累積値
(lambda (this-coeff higher-terms)
  (+ this-coeff (* x higher-terms)))

とすることで計算できる。

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


(horner-eval 2 (list 1 3 0 5 0 1)) ;; => 79

問題 2.35

§2.2.2のcount-leavesをaccumulateを用いて再定義する。

sum-odd-squaresと同じように基本部品を組み立てる戦略を採ればよい

  • 木の葉を数え上げる (enumerate-treeを流用)
  • 数え上げたものを1に変換
  • 0を初期値として、+を使いaccumulateする
(define (count-leaves tree)
  (accumulate +
              0
              (map (lambda (leave) 1)
                   (enumerate-tree tree))))

(count-leaves (list 1 (list 2 (list 3 4)) 5)) ;; => 5

問題 2.36

複数のシーケンスを引数に取るaccumulate-nを実装せよ。

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op init <??>)
            (accumulate-n op init <??>))))

テキストのシーケンスを考えた場合、

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

各シーケンスの先頭の要素は以下のように取り出せる。

racket@> (map car s)
'(1 4 7 10)

残りの要素も同様。

racket@> (map cdr s)
'((2 3) (5 6) (8 9) (11 12))

よって答えは以下の通り。

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

(accumulate-n + 0 s) ;; => '(22 26 30)

問題 2.37

ベクトル・行列計算の問題。

ベクトルの内積を以下のように定義した場合、

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


(dot-product (list 1 2) (list 3 4)) ;; => 11

行列とベクトルの積、行列の転置、行列と行列の積はどう定義されるか。

行列とベクトルの積

(define (matrix-*-vector m v)
  (map (lambda (mcols) (dot-product mcols v)) m))

(matrix-*-vector (list (list 1 2) (list 3 4)) (list 3 4)) ;; => '(11 25)

行列の転置

(define (transpose m)
  (accumulate-n cons nil m))

(transpose (list (list 1 2) (list 3 4))) ;; => '((1 3) (2 4))

行列と行列の積

(define (matrix-*-matrix m n)
  (let ((ncols (transpose n)))
    (map (lambda (mcols) (matrix-*-vector ncols mcols)) m)))

(matrix-*-matrix (list (list 1 2) (list 3 4))
                 (list (list 1 2) (list 3 4))) ;; => '((7 10) (15 22))

問題 2.38

fold-left, fold-right の問題。置き換えモデルを使うとわかりやすい。

(fold-left / 1 (list 1 2 3))
=> (/ (/ (/ 1 1) 2) 3)
=> 1/6

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

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

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

fold-rightとfold-leftのがどのような並びに対しても同じ値を生じるためにopが満たす条件は、 可換則が成り立つかどうか? すなわち、

(op x y) = (op y x)

た必ず成り立つようなopであれば、fold-rightとfold-leftは必ず同じ値になる。

問題 2.39

reverseをfold-right、fold-leftを使って再実装する。

(define (reverse-fr sequence)
  (fold-right (lambda (x y) <??>) nil sequence))

(define (reverse-fl sequence)
  (fold-left (lambda (x y) <??>) nil sequence))

fold-right版

問題 2.34でも見てきたように、fold-rightに与える(lambda (x y) <??>)の yにはシーケンスを逆から辿った際の蓄積データが入るので、(append y <??>) は容易に推測できる。

xにはシーケンスを逆から辿った際のその時着目した要素が入るため、consアップすればよい。

よって、

(define (reverse-fr sequence)
  (fold-right (lambda (x y) (append y (cons x nil))) nil sequence))

fold-left版

問題 2.38でも見てきたように、fold-lightに与える(lambda (x y) <??>)の xにはシーケンスを順方向に辿った際の蓄積データが、yにはその時に着目している要素が入る。

よって、xとyを入れ替えてconsアップすればよい。

(define (reverse-fl sequence)
  (fold-left (lambda (x y) (cons y x)) nil sequence))

次回は、「§2.2.3 公認インターフェースとしての並び」の続き「写像の入れ子」から。


※「SICP読書ノート」の目次はこちら