本文

写像の入れ子

map を入れ子にして リストのリストを生成、flatmap でリストにして filter でフィルタリング、
加算結果が追加された結果を生成。

問題解答

問2.40

(define (unique-pairs n)
  (flatmap
   append
   (map (lambda (i)
          (map (lambda (j) (list i j))
               (enumerate-interval 1 (- i 1))))
        (enumerate-interval 1 n))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
                (unique-pairs n))))

問2.41

(define (filterSum n s)
  (filter (lambda (l) (= (accumulate + 0 l) s))
          (flatmap
           (lambda (i)
             (flatmap
              (lambda (j)
                (map (lambda (k) (list i j k))
                     (enumerate-interval 1 n)))
              (enumerate-interval 1 n)))
           (enumerate-interval 1 n))))

そろそろ、ちゃんとしたデバッガのある環境が欲しい。。。。
コードの流れをきちんと追いかけるトレーニングをするにはデバッガのない環境っていいんですが、謎なエラーと格闘する時間が多くてもったいないです。

問題解答

問2.38
(fold-right / 1 (list 1 2 3)) は以下のような処理になる。

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

(fold-left / 1 (list 1 2 3)) は以下。

(iter 1 (1 2 3))
(iter (op 1 1) (2 3)) → (iter 1 (2 3))
(iter (op 1 2) (3)) → (iter 1/2 (3))
(iter (op 1/2 3) ()) → (iter 1/6 ())
1/6

op はオペランドが入れ替わっても同じ結果を返すものであれば fold-right と fold-left で同じ値を得ることができる。

問2.39

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

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

cons, list 周りと append などのオペレーション周りの理解が怪しい感じがしたので復習。

問題解答

問2.36

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

(define (lh l)
  (if (null? (cdr l))
      (list (caar l))
      (cons (caar l)
            (lh (cdr l)))))

(define (ll l)
  (if (null? (cdr l))
      (list (cdar l))
      (cons (cdar l)
            (ll (cdr l)))))

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

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      ()
      (cons (accumulate op init (lh seqs))
            (accumulate-n op init (ll seqs)))))


(accumulate-n + 0 l)

できたけど、絶対これじゃない感が。。。。そして正解を見て鼻血出ました。

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

map か、、、たしかに。というか、答えを見れば当たり前だなと思うんですよね。何であんな冗長な書き方しか思い浮かばなかったのか。

問2.37
四苦八苦しながら作成。

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

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

(define (transpose mat)
  (accumulate-n cons () mat))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (transpose (map (lambda (v) (matrix-*-vector m v)) cols))))

matrix-*-matrix は、答えを見ると方法が違った。

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
      (map (lambda (y) (dot-product x y)) cols)) m)))

考え方的には間違っていない。。。ハズ。ただ、最後に transpose しているのはダサいし余分な処理なのでよくない感じはする。それに比べて参考解答は素直に処理していて普通の計算方法そのもの。

うーーーん。。まだ、自分でこれを一からパッと作れる気がしないです。単純な二重ループなんですけどね。

問題解答

問2.34

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

問2.35

(define (count-leaves t)
  (accumulate + 0 (map (lambda (x) (cond ((null? x) 0)
                                         ((not (pair? x)) 1)
                                         (else (count-leaves x)))) t)))

週末+1日で三日間開くと波に乗るのに時間がかかってしまう。やっぱり週末も手をつけるようにしたほうがいいかも。

本文

2.2.3 公認インターフェースとしての並び

再度ここから再読。内容もOK。

説明の流れ上そうなるよなーというのはあるものの、例として上がっていコードの

(define (sum-odd-squares tree)
  (accumulate +
              0
              (map square
                   (filter odd?
                           (enumerate-tree tree)))))

なんかは

(define v (enumerate-tree tree))
(define v (filter odd? v))
(define v (map square v))
(define v (accumulate + 0 v))

こういう感じで書いた方が意図がわかりやすいんじゃないでしょうかね。各演算に v をバケツリレーしてる感じ。

問題解答

問2.33

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

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

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

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

(define l1 (list 0 1 2 3 4))
(define l2 (list 5 6 7))
(length l1)
(append l1 l2)
(map (lambda (x) (* x x)) l2)

append で accumulate に渡すのが seq2 seq1 になっているのがハマりどころですね。
ちょっと気持ち悪いけど、たしかに処理を追っていくとそうなるのでそんなものなのかなという感じです。

問題解答

(define (subsets s)
  (display s)(newline)
  (if (null? s)
      (list ())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (append (list (car s)) x)) rest)))))

(subsets (list 1 2 3))

rest が、s から先頭を取り除いたもので構成される部分集合になる。rest 本体と、rest の部分集合に対して s の先頭の要素を追加した新たな集合をつくることで、s のすべての部分集合の集合をつくりだしている。

本文

2.2.3 公認インターフェースとしての並び

処理の流れを信号処理に見立てて、処理の要素ごとにモジュール化して繋げた中にデータを通すようにする。

解説を一気に読んで、内容としては理解できた感じなのだけれどもまだきちんと自分で応用できる感じではないので、明日もここから続けるようにする。

問題回答

問2.27

(define (deep-reverse items)
  (define (iter items ret)
    (if (null? items)
        ret
        (iter (cdr items) (cons (reverse (car items)) ret))))

  (iter (cdr items) (cons (reverse (car items)) ())))

(define x (list (list 1 2) (list 3 4)))
(deep-reverse x)

問2.28

(define (fringe items)
  (define (iter items ret)
    (display items)(newline)
    (cond ((not (pair? items)) (append ret (list items)))
          ((null? (cdr items)) (append ret (iter (car items) ())))
          (else (append ret (iter (car items) ()) (iter (cdr items) ())))))

  (iter items ()))

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

問2.29
a.

(define (make-mobil left right)
  (list left right))

(define (make-branch length structure)
  (list length structure))

(define (left-branch mobil)
  (car mobil))

(define (right-branch mobil)
  (cadr mobil))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (cadr branch))


(define m (make-mobil (make-branch 1 ()) (make-branch 3 ())))
(left-branch m)
(right-branch m)

(branch-length (left-branch m))
(branch-structure (left-branch m))

b.

(define (total-weight mobil)
  (define (iter branch)
    (cond ((null? branch) 0)
          ((pair? branch) (+ (iter (left-branch branch)) (iter (right-branch branch))))
          (branch-structure branch)))

  (iter mobil))

(total-weight m)

c.

(define (balanced? mobil)
  (let ((lb (left-branch mobil))
        (rb (right-branch mobil)))
    (if (= (* (total-weight lb) (branch-length lb))
           (* (total-weight rb) (branch-length rb)))
        (begin (display "balanced")(newline))
        (begin (display "unbalanced")(newline)))))

(define m (make-mobil (make-branch 1 ()) (make-branch 3 ())))
(balanced? m)
(define m (make-mobil (make-branch 1 ()) (make-branch 1 ())))
(balanced? m)

d.
枝と、枝の部品の選択肢を修正すれば対応可

(define (left-branch mobil)
  (car mobil))

(define (right-branch mobil)
  (cdr mobil))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (cdr branch))

本文

木の写像
list に対するのと同様、再帰と一緒になった map を使用する

問題回答

問2.30

(define (square-tree items)
  (cond ((null? items) ())
        ((not (pair? items)) (* items items))
        (else (cons (square-tree (car items))
                    (square-tree (cdr items))))))

(square-tree (list 1
                   (list 2 (list 3 4) 5)
                   (list 6 7)))

map 版

(define (square-tree tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree sub-tree)
             (* sub-tree sub-tree)))
       tree))

(square-tree (list 1
                   (list 2 (list 3 4) 5)
                   (list 6 7)))

問2.31

(define (tree-map tree f)
  (map (lambda (sub-tree)
           (if (pair? sub-tree)
               (tree-map sub-tree f)
               (f sub-tree)))
       tree))

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

(define (square-tree tree)
  (tree-map tree square ))

(square-tree (list 1
                   (list 2 (list 3 4) 5)
                   (list 6 7)))

本文

2.2.2 階層構造

問題解答

問2.24
図を載せるのは割愛。

問2.25

(define v (list 1 3 (list 5 7) 9))
(car (cdr (car (cdr (cdr v)))))

(define v (list (list 7)))
(car (car v))

(define v (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr v))))))))))))

解答を見るとこんな感じだった。

(cadadr (cadadr (cadadr v)))

このあたり、ちょっとググるとゲシュタルト崩壊を起こしそうな解説が、、、、

問2.26
まずは挙動を予想。

(append x y) → (1 2 3 4 5 6)
(cons x y) → ((123) (456))
(list x y) → ((123) (456))

gosh> (append x y)
(1 2 3 4 5 6)
gosh> (cons x y)
((1 2 3) 4 5 6)
gosh> (list x y)
((1 2 3) (4 5 6))

cons を間違えていました。cons と list がきちんと分けて考えられていなかったっぽいです。

問題解答

問2.20

(define (same-party x . y)
  (define (iter f l)
    (cond ((null? l) ())
          ((= (mod (car l) 2) f) (cons (car l) (iter f (cdr l))))
          (else (iter f (cdr l)))))
  (iter (mod x 2) y))

(same-party 1 2 3 4 5 6 7)
(same-party 2 2 3 4 5 6 7)

終了条件をどうすればいいのかわからなくて、ちょっと考えてしまいました。
これくらいのプログラムを書くにも未だに慣れないです。

本文

リストの写像

map を使用して、より抽象化することができる

(define (map proc items)
  (if (null? items)
      ()
      (cons (proc (car items))
            (map proc (cdr items)))))

(map (lambda(x) (* x x))
     (list 1 2 3 4))

問題解答

問2.21

(define (square-list items)
  (if (null? items)
      ()
      (cons (* (car items) (car items))
            (square-list (cdr items)))))

(define (square-list items)
  (map (lambda(x) (* x x)) items))

(square-list (list 1 2 3 4))

問2.22
最初のコードは頭から値を取り出して、リストの頭に値を挿入しているので逆になってしまう。
変更したコードは、answer が対なので、対と値の対を作ってしまう。そのため、((() 1) 4 9) のような結果になってしまう。

問2.23

(define (for-each f items)
  (if (null? items)
      true
      (f (car items)) (for-each f (cdr items))))

(for-each (lambda (x) (newline) (display x))
          (list 57 321 88))

これはこれで正解ですが、解答例を見ると begin というものがあるのですね。

4.7 順次実行

本日はここまで。

MIT OCW のビデオは完全に先を行ってしまったっぽいので当分お休みして、追いつくまでは本文に集中します。

本文

2.2 階層データ構造と閉包性
ある集合の要素にある演算を作用させて得られた要素が、またその集合の要素だった場合に、要素の集合はその演算のもとで閉じているというのが本来の閉包の定義

対の car 部分に値、 cdr 部分に次の対へのポインタを格納することでリスト構造を表現する。
また、このための手続きとして list がある。

※Gauche の場合、nil は ()
註釈を見ると、nil の扱いはかなり議論の的になったようで、嗚呼、乙。。。という感じ。

リスト演算

問題解答

問 2.17

(define odds (list 1 3 5 7 9))

(define (last-pair items)
  (if (null? (cdr items))
      (car items)
      (last-pair (cdr items))))

(last-pair odds)

問2.18

(define (reverse items)
  (define (reverse-iter items ret)
    (if (null? items)
        ret
        (reverse-iter (cdr items) (cons (car items) ret))))

  (reverse-iter (cdr items) (cons (car items) ())))

(define odds (list 1 3 5 7 9))

(reverse odds)

問2.19

(define (first-denomination coin-values)
  (car coin-values))

(define (except-first-denomination coin-values)
  (cdr coin-values))

(define (no-more? coin-values)
  (null? coin-values))

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

(cc 100 us-coins)
(cc 100 uk-coins)

あまり深く考えずにペロッと書いたら正解っぽくなってしまってむしろキョドってしまった(汗