*1175152529*[SICP] 2.2 階層データ構造と閉包性
2.2.1 並びの表現
問題2.17
;; lのcdrが空リストならlのcarのリスト ;; そうでなければ、lのcdrのlast-pair (define (last-pair l) (if (null? (cdr l)) (list (car l)) (last-pair (cdr l))))
問題2.18
;; 反復的('()はnil) (define (reverse l) (define (iter l r) (if (null? l) r (iter (cdr l) (cons (car l) r)))) (iter l '())) ;; 再帰的(効率悪) (define (reverse l) (if (null? l) '() (append (reverse (cdr l)) (list (car l)))))
問題2.19
(define (first-denomination l) (car l)) (define (except-first-denomination l) (cdr l)) (define (no-more? l) (null? l))
coin-valuesの順はccの答に影響はない。なぜなら、このアルゴリズムは硬貨の順番異なっていても同じ答えを返すから。
問題2.20
(define (same-parity x . rest) (let ((xr (remainder x 2))) (define (recr l) (cond ((null? l) '()) ((= xr (remainder (car l) 2)) (cons (car l) (recr (cdr l)))) (else (recr (cdr l))))) (cons x (recr rest)))) (same-parity 1 2 3 4 5 6 7) => (1 3 5 7) (same-parity 0 1 2 3 4 5 6 7) => (0 2 4 6)
問題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)) ;; おまけ (define (square-list items) (map * items items))
問題2.22
最初のsquare-listではリストの先頭の方の要素を先にconsし、後ろの方の要素を後にconsするので、順番が逆になる。
後の、square-listでは、answerがリストを構成していない。consでリストを作るには(cons 数値 リスト）としなければならないが、(cons リスト 数値)の順になっているためだ。
(square-list (list 1 2 3))
の結果を箱とポインタ記法で書くと
+-++-+ +-+ |*||*|->|9| +-++-+ +-+ | +-++-+ +-+ |*||*|->|4| +-++-+ +-+ | +-++-+ +-+ |/||*|->|1| +-++-+ +-+
となる。しかし、
+-++-+ +-++-+ +-++-+ |*||*|->|*||*|->|*||/| +-++-+ +-++-+ +-++-+ | | | +-+ +-+ +-+ |1| |4| |9| +-+ +-+ +-+
となっているべきである。
問題2.23
(define (for-each proc l) (if (null? l) #t (begin (proc (car l)) (for-each proc (cdr l))))) gosh> (for-each (lambda (x) (newline) (display x)) (list 57 321 88)) 57 321 88#t
2.2.2 階層構造
箱とポインタ構造
+-++-+ +-++-+
(1 (2 (3 4)))-> |*||*|->|*||/|
+-++-+ +-++-+
| |
+-+ +-++-+ +-++-+
|1| |*||*|->|*||/|
+-+ +-++-+ +-++-+
| |
+-+ +-++-+ +-++-+
|2| |*||*|->|*||/|
+-+ +-++-+ +-++-+
| |
+-+ +-+
|3| |4|
+-+ +-+ 木は横向きだけど。
(1 (2 (3 4)))
|
+- 1
|
`- (2 (3 4))
|
+- 2
|
`- (3 4)
|
+- 3
|
`- 4
問題2.25
(define l1 '(1 3 (5 7) 9)) (define l2 '((7))) (define l3 '(1 (2 (3 (4 (5 (6 7))))))) ;; car, cdrだけを使ったものと、それらの合成したものを使ったものをそれぞれ (car (cdr (car (cdr (cdr l1))))) (cadar (cddr l1)) (car (car l2)) (caar l2) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr l3)))))))))))) (cadr (cadr (cadr (cadr (cadr (cadr l3))))))
問題2.26
(define x (list 1 2 3)) (define y (list 4 5 6)) (append x y) => (1 2 3 4 5 6) (cons x y) => ((1 2 3) 4 5 6) (list x y) => ((1 2 3) (4 5 6))
問題2.27
(define (deep-reverse items) (cond ((not (pair? items)) items) (else (append (deep-reverse (cdr items)) (list (deep-reverse (car items))))))) (deep-reverse '((1 2) (3 4))) => ((4 3) (2 1)) ;; 効率改善 (define (deep-reverse items) (define (iter l r) (cond ((null? l) r) ((not (pair? l)) l) (else (iter (cdr l) (cons (iter (car l) '()) r))))) (iter items '())) (deep-reverse '((1 2) (3 4))) => ((4 3) (2 1))
問題2.28
;; 再帰的 (define (fringe tree) (cond ((null? tree) '()) ((not (pair? tree)) (list tree)) (else (append (fringe (car tree)) (fringe (cdr tree)))))) (fringe (list (list 1 2) (list 3 4))) => (1 2 3 4) ;; 効率改善 (define (fringe tree) (define (iter l r) (cond ((null? l) r) ((not (pair? l)) (cons l r)) (else (iter (cdr l) (iter (car l) r))))) (reverse (iter tree '())))
問題2.29
(define (make-mobile left right) (list left right)) (define (make-branch length structure) (list length structure)) (define (left-branch mobile) (car mobile)) (define (right-branch mobile) (cadr mobile)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (cadr branch)) (define (total-weight mobile) (if (not (pair? mobile)) mobile (+ (total-weight (branch-structure (left-branch mobile))) (total-weight (branch-structure (right-branch mobile)))))) (define (balanced? mobile) (if (not (pair? mobile)) #t (let ((lb (left-branch mobile)) (rb (right-branch mobile))) (let ((ls (branch-structure lb)) (rs (branch-structure rb))) (and (= (* (branch-length lb) (total-weight ls)) (* (branch-length rb) (total-weight rs))) (balanced? ls) (balanced? rs)))))) (define m (make-mobile (make-branch 10 2) (make-branch 2 (make-mobile (make-branch 2 6) (make-branch 3 4))))) (total-weight m) => 12 (balanced? m) => #t
問題2.30
(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))) => (1 (4 (9 16) 25) (36 49))
問題2.31
(define (tree-map proc tree) (map (lambda (sub-tree) (if (pair? sub-tree) (tree-map proc sub-tree) (proc sub-tree))) tree)) (tree-map (lambda (x) (* x x)) (list 1 (list 2 (list 3 4) 5) (list 6 7))) => (1 (4 (9 16) 25) (36 49))
問題2.32
(define (subsets s) (if (null? s) (list '()) (let ((rest (subsets (cdr s)))) (append rest (map (lambda (subs) (cons (car s) subs)) rest))))) (print (subsets (list 1 2 3))) => (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))
部分集合は再帰的に定義できる。
空集合の部分集合は空集合だけを要素に持つ集合である。
要素aを含む集合Aの部分集合は、
aを含まない部分集合(A') + aを含む部分集合(A'')
である。さらに、A''のそれぞれからaを除いた集合はA'にひとしいはずである。
subsetsでは sが空集合の時、 空リストを持つリスト。そうでないとき、sの先頭の要素を除いた部分集合と、そのそれぞれにsの先頭の要素を加えた集合の和集合を返す。よって、sの部分集合を返す。
2.2.3 公認インターフェースとしての並び
問題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 k) (cons (p x) k)) '() sequence)) (define (append seq1 seq2) (accumulate cons seq2 seq1)) (define (length sequence) (accumulate (lambda (x k) (+ 1 k)) 0 sequence)) (map (lambda (x) (* x x)) '(0 1 2 3 4)) => (0 1 4 9 16) (append '(1 2 3) '(4 5 6)) => (1 2 3 4 5 6) (length '(1 2 3)) => 3
問題2.34
(define (horner-eval x coefficient-sequence) (accumulate (lambda (this-coeff higher-terms) (+ (* x higher-terms) this-coeff)) 0 coefficient-sequence)) (horner-eval 2 (list 1 3 0 5 0 1)) => 79
問題2.35
(define (count-leaves t) (accumulate + 0 (map (lambda (x) (cond ((null? x) 0) ((pair? x) (count-leaves x)) (else 1))) t))) (count-leaves '(1 2 (3 1 (2 0) (2 3) () 0) 2)) => 10
問題2.36
(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 '((1 2 3) (4 5 6) (7 8 9) (10 11 12))) (accumulate-n + 0 s) => (22 26 30)
問題2.37
(define m '((1 2 3) (4 5 6) (7 8 9))) (define v '(1 2 3)) (define (dot-product v w) (accumulate + 0 (map * v w))) (define (matrix-*-vector m v) (map (lambda (w) (dot-product w v)) m)) (matrix-*-vector m v) => (14 32 50) (define (transpose mat) (accumulate-n cons '() mat)) (transpose m) => ((1 4 7) (2 5 8) (3 6 9)) (define (matrix-*-matrix m n) (let ((cols (transpose n))) (map (lambda (row) (map (lambda (col) (dot-product row col)) cols)) m))) (matrix-*-matrix m m) => ((30 36 42) (66 81 96) (102 126 150))
問題2.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 / 1 (list 1 2 3)) => (1 / (2 / (3 / 1))) => (1 / (2 / 3)) => 3/2 (fold-left / 1 (list 1 2 3)) => ((1 / 1) / 2) / 3 => (1 / 2) / 3 => 1/6 (fold-right list '() (list 1 2 3)) => (list 1 (list 2 (list 3 '()))) => (list 1 (list 2 (3 ()))) => (list 1 (2 (3 ()))) => (1 (2 (3 ()))) (fold-left list '() (list 1 2 3)) => (list (list (list '() 1) 2) 3) => (list (list (() 1) 2) 3) => (list ((() 1) 2) 3) => (((() 1) 2) 3)
fold-left/rightが同じ値を生じるためのopの条件。
(fold-right op init '(x))
=> (op x init)
(fold-left op init '(x))
=> (op init x)
なので、opは交換法則を満たさなければならない。
(fold-right op init '(x y))
=> (op x (op y init))
- > x op (y op init)
- > x op (init op y)
(fold-left op init '(x y))
=> (op (op init x) y)
- > (init op x) op y
- > (x op init) op y
問題2.39
(define (reverse sequence) (fold-right (lambda (x y) (append y (list x))) '() sequence)) (reverse '(1 2 3)) => (3 2 1) (define (reverse sequence) (fold-left (lambda (x y) (cons y x)) '() sequence)) (reverse '(1 2 3)) => (3 2 1)
問題2.40
(define (enumerate-interval low high) (if (> low high) '() (cons low (enumerate-interval (+ low 1) high)))) (define (flatmap proc seq) (fold-right append '() (map proc seq))) (define (unique-pairs n) (flatmap (lambda (i) (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))) (unique-pairs 3) => ((2 1) (3 1) (3 2)) (define (prime-sum? pair) (prime? (+ (car pair) (cadr pair)))) (define (make-pair-sum pair) (list (car pair) (cadr pair) (+ (car pair) (cadr pair)))) (define (prime-sum-pairs n) (map make-pair-sum (filter prime-sum? (unique-pairs n)))) (prime-sum-pairs 6) => ((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11))
問題2.41
(define (unique-triples n) (flatmap (lambda (i) (map (lambda (j) (cons i j)) (unique-pairs (- i 1)))) (enumerate-interval 1 n))) (unique-triples 4) => ((3 2 1) (4 2 1) (4 3 1) (4 3 2)) (define (divide-into-three n) (filter (lambda (x) (= n (fold-right + 0 x))) (unique-triples n))) (divide-into-three 10) => ((5 3 2) (5 4 1) (6 3 1) (7 2 1))
unique-pairsとunique-triplesを一般化した、与えられた整数n以下のk個の順序づけられた並びを返す手続き。
(define (unique-tuples n k) (cond ((= k 0) '(())) ((= n 0) '()) (else (append (map (lambda (x) (cons n x)) (unique-tuples (- n 1) (- k 1))) (unique-tuples (- n 1) k))))) (unique-tuples 4 3) => ((4 3 2) (4 3 1) (4 2 1) (3 2 1))
問題2.42
テーブルは、縦の位置のリスト。
(define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) (define (adjoin-position new-row k table) (cons new-row table)) (define empty-board '()) (define (safe? k table) (let ((last (car table))) (define (iter l i) (cond ((null? l) #t) ((or (= last (car l)) (= (abs (- last (car l))) i)) #f) (else (iter (cdr l) (+ i 1))))) (iter (cdr table) 1)))
(time (queens 10))
; real 0.674
; user 0.670
; sys 0.000
問題2.43
問題2.42では、queen-colsの呼ばれる回数は
| k | 8 | 7 | 6 | 5 | 4 | 3 | 2 | 1 |
|---|---|---|---|---|---|---|---|---|
| 回数 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 |
Louisのものは、k=nのとき、(queen-cols (- n 1))は8回呼ばれる。
| k | 8 | 7 | 6 | 5 | 4 | 3 | 2 | 1 |
|---|---|---|---|---|---|---|---|---|
| 回数 | 1 | 8 | 8^2 | 8^3 | 8^4 | 8^5 | 8^6 | 8^7 |
queen-colsの再帰呼び出し以外の部分の処理時間は同じなので、board-sizeをbとすると、
Louisの処理時間 = T * (b^0 + ... + b^(b-1)) / 8
になる。
なので、
これは、だいたい、b^(b-2)くらい。よって、Louisの処理時間は b^(b-2)T と推定される。
2.2.4 例：図形言語
問題2.44
(define (right-split painter n) (if (= n 0) painter (let ((smaller (right-split painter (- n 1)))) (beside painter (below smaller smaller)))))
問題2.45
(define (split p1 p2) (define (sub painter n) (if (= n 0) painter (let ((smaller (sub painter (- n 1)))) (p1 painter (child (p2 smaller smaller)))))) sub)
問題2.46
(define (make-vect x y) (cons x y)) (define (xcor-vect v) (car v)) (define (ycor-vect v) (cdr v)) (define (add-vect v w) (make-vect (+ (xcor-vect v) (xcor-vect w)) (+ (ycor-vect v) (ycor-vect w)))) (define (sub-vect v w) (make-vect (- (xcor-vect v) (xcor-vect w)) (- (ycor-vect v) (ycor-vect w)))) (define (scale-vect s v) (make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))
問題2.47
(define (make-frame origin edge1 edge2) (list origin edge1 edge2)) (define (origini-frame frame) (car frame)) (define (edge1-frame frame) (cadr frame)) (define (edge2-frame frame) (caddr frame)) ;; test (define frame (make-frame (make-vect 0 0) (make-vect 1 0) (make-vect 0 1))) (origin-frame frame) => (0. 0) (edge1-frame frame) => (1 . 0) (edge2-frame frame) => (0 . 1) (define (make-frame origin edge1 edge2) (cons origin (cons edge1 edge2))) (define (origini-frame frame) (car frame)) (define (edge1-frame frame) (cadr frame)) (define (edge2-frame frame) (cddr frame)) ;test (origin-frame frame) => (0. 0) (edge1-frame frame) => (1 . 0) (edge2-frame frame) => (0 . 1)
問題2.48
(define (make-segmenet v w) (cons v v)) (define (start-segment s) (car s)) (define (end-segment s) (cdr s))
問題2.49
(define (segments->painter segment-list) (lambda (flame) (for-each (lambda (segment) (draw-line ((frame-coord-map frame) (start-segment segment)) ((frame-coord-map frame) (end-segment segment)))) (segment-list)))) (define (frame-coord-map frame) (lambda (v) (add-vect (origin-frame frame) (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) (scale-vect (ycor-vect v) (edge2-frame frame)))))) ;; a (define outline (segments->painter (list (make-segment (make-vect 0 0) (make-vect 1 0)) (make-segment (make-vect 0 0) (make-vect 0 1)) (make-segment (make-vect 0 1) (make-vect 1 1)) (make-segment (make-vect 1 0) (make-vect 1 1))))) ;; b (define x (segments->painter (list (make-segment (make-vect 0 0) (make-vect 1 1)) (make-segment (make-vect 1 0) (make-vect 0 1))))) ;; c (define rhomboid (segments->painter (list (make-segment (make-vect 0.5 0) (make-vect 1 0.5)) (make-segment (make-vect 1 0.5) (make-vect 0.5 1)) (make-segment (make-vect 0.5 1) (make-vect 0 0.5)) (make-segment (make-vect 0 0.5) (make-vect 0.5 0))))) ;; d (define wave (segments->painter (list ;; 左下 (make-segment (make-vect 0.238 0) (make-vect 0.357 0.5)) (make-segment (make-vect 0.357 0.5) (make-vect 0.310 0.595)) (make-segment (make-vect 0.310 0.595) (make-vect 0.143 0.429)) (make-segment (make-vect 0.143 0.429) (make-vect 0 0.857)) ;; 股 (make-segment (make-vect 0.417 0) (make-vect 0.5 0.167)) (make-segment (make-vect 0.5 0.167) (make-vect 0.595 0)) ;; 右下 (make-segment (make-vect 0.786 0) (make-vect 0.619 0.476)) (make-segment (make-vect 0.619 0.476) (make-vect 1 0.143)) ;; 右上 (make-segment (make-vect 0 0.357) (make-vect 0.762 0.667)) (make-segment (make-vect 0.762 0.667) (make-vect 0.595 0.667)) (make-segment (make-vect 0.595 0.667) (make-vect 0.643 0.869)) (make-segment (make-vect 0.643 0.869) (make-vect 0.595 1)) ;; 左上 (make-segment (make-vect 0.405 1) (make-vect 0.357 0.869)) (make-segment (make-vect 0.357 0.869) (make-vect 0.405 0.667)) (make-segment (make-vect 0.405 0.667) (make-vect 0.274 0.667)) (make-segment (make-vect 0.274 0.667) (make-vect 0.143 0.619)) (make-segment (make-vect 0.143 0.619) (make-vect 0 0.857)))))
問題2.50
(define (flip-horiz painter) (transform-painter painter (make-vect 1.0 0.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0))) (define (rotate180 painter) (transform-painter painter (make-vect 1.0 1.0) (make-vect 0.0 1.0) (make-vect 1.0 0.0))) (define (rotate270 painter) (transform-painter painter (make-vect 0.0 1.0) (make-vect 0.0 0.0) (make-vect 1.0 1.0)))
問題2.51
(define (below painter1 painter2) (let ((split-point (make-vect 0.0 0.5))) (let ((paint-low (transform-pianter painter1 (make-vect 0.0 0.0) split-point (make-vect 1.0 0.0))) (paint-high (transform-painter painter2 (make-vect split-point) (make-vect 0.0 1.0) (make-vect 1.0 0.5)))) (lambda (frame) (paint-low frame) (paint-high frame))))) (define (below painter1 painter2) (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))
問題2.52
;; a (define wave (segments->painter (list ;; 左下 (make-segment (make-vect 0.238 0) (make-vect 0.357 0.5)) (make-segment (make-vect 0.357 0.5) (make-vect 0.310 0.595)) (make-segment (make-vect 0.310 0.595) (make-vect 0.143 0.429)) (make-segment (make-vect 0.143 0.429) (make-vect 0 0.643)) ;; 股 (make-segment (make-vect 0.417 0) (make-vect 0.5 0.167)) (make-segment (make-vect 0.5 0.167) (make-vect 0.595 0)) ;; 右下 (make-segment (make-vect 0.786 0) (make-vect 0.619 0.476)) (make-segment (make-vect 0.619 0.476) (make-vect 1 0.143)) ;; 右上 (make-segment (make-vect 1 0.357) (make-vect 0.762 0.667)) (make-segment (make-vect 0.762 0.667) (make-vect 0.595 0.667)) (make-segment (make-vect 0.595 0.667) (make-vect 0.643 0.869)) (make-segment (make-vect 0.643 0.869) (make-vect 0.595 1)) ;; 左上 (make-segment (make-vect 0.405 1) (make-vect 0.357 0.869)) (make-segment (make-vect 0.357 0.869) (make-vect 0.405 0.667)) (make-segment (make-vect 0.405 0.667) (make-vect 0.274 0.667)) (make-segment (make-vect 0.274 0.667) (make-vect 0.143 0.619)) (make-segment (make-vect 0.143 0.619) (make-vect 0 0.857)) ;; 目 (make-segment (make-vect 0.405 0.869) (make-vect 0.445 0.893)) (make-segment (make-vect 0.445 0.893) (make-vect 0.485 0.869)) (make-segment (make-vect 0.514 0.869) (make-vect 0.555 0.893)) (make-segment (make-vect 0.555 0.893) (make-vect 0.595 0.869)) ;; 口 (make-segment (make-vect 0.429 0.786) (make-vect 0.476 0.738)) (make-segment (make-vect 0.476 0.738) (make-vect 0.571 0.786))))) ;; b ;; 原書では ;; (for example, by using only one copy of the up-split and right-split images insted of two) ;; なので、up/right-splitを二つ使うのではなく、一つだけ使う (define (corner-split painter n) (if (= n 0) n (beside (below painter (up-split painter (- n 1))) (below (right-split painter (- n 1)) (corner-split painter (- n 1)))))) ;; c ;; 四角の隅で向きを変えるには、corner-splitに手を加えなければだめだ。 (define (square-limit painter n) (define (corner-split painter n) (if (= n 0) (flip-horiz painter) (let ((up (up-split painter (- n 1))) (right (right-split painter (- n 1)))) (let ((top-left (beside up up)) (bottom-right (below right right)) (corner (corner-split painter (- n 1)))) (beside (below painter top-left) (below bottom-right corner)))))) (let ((quarter (corner-split painter n))) (let ((half (beside (flip-horiz quarter) quarter))) (below (flip-vert half) half))))
