2章の練習問題の解答 by kacchi
現在 2.1 から 2.42 まで。
未回答番号
2.5
2.6 の後半部分
2.9 の後半部分
2.10 2.11 2.13 2.14 2.15 2.16
2.19 の後半
2.29のc 間違い
2.32の後半
Exercise 2.1
正負両方の引数を扱う改良版 make-rat を定義せよ。
(define (make-rat n d)
(let ((g (gcd n d)))
(cond ((or (and (positive? n) (negative? d))
(and (negative? n) (negative? d)))
(cons (/ (- n) g) (/ (- d) g)))
((and (= n 0) (negative? d))
(cons (/ n g) (/ (- d) g)))
(else
(cons (/ n g) (/ d g))))))
(print-rat (make-rat 2 3)) ;=> 2/3
(print-rat (make-rat -2 3)) ;=> -2/3
(print-rat (make-rat 2 -3)) ;=> -2/3
(print-rat (make-rat -2 -3)) ;=> 2/3
(print-rat (make-rat -0 3)) ;=> 0/1
(print-rat (make-rat 0 -3)) ;=> 0/1
(print-rat (make-rat -0 -3)) ;=> 0/1
Exercise 2.2
平面上の線分を表現する。
(define (make-segment start-point end-point)
(cons start-point end-point))
(define (start-segment s) (car s))
(define (end-segment s) (cdr s))
(define (make-point x y) (cons x y))
(define (x-point p) (car p))
(define (y-point p) (cdr p))
(define (midpoint-segment s)
(let ((start-point (start-segment s))
(end-point (end-segment s)))
(make-point (/ (+ (x-point start-point) (x-point end-point)) 2)
(/ (+ (y-point start-point) (y-point end-point)) 2))))
;; 実行例
(define p1 (make-point 1 3)) ;点1を定義
(define p2 (make-point 5 9)) ;点2を定義
(define s1 (make-segment p1 p2)) ;線分1を定義
(print-point (start-segment s1)) ;線分1の開始点を印字
=>(1,3)
(print-point (end-segment s1)) ;線分1の終着点を印字
=>(5,9)
(print-point (midpoint-segment s1)) ;線分1の中間点を印字
=>(3,6)
(define p3 (make-point -1 -3)) ;点3を定義
(define s2 (make-segment p3 p2)) ;線分2を定義
(print-point (start-segment s2)) ;線分2の開始点を印字
=>(-1,-3)
(print-point (end-segment s2)) ;線分2の終着点を印字
=>(5,9)
(print-point (midpoint-segment s2)) ;線分2の中間点を印字
=>(2,3)
Exercise 2.3
長方形は高さと幅をもった領域で表現される。それぞれ長方形を引数として受
けとり、その周囲の長さと面積を計算する手続きを、rect-perimeter,
rect-area とする。長方形の表現を定義する構成子を make-rect 長方形の高さ
と幅を取り出す選択子を rect-height, rect-width とすると、rect-perimeter
と rect-area は次のように定義できる。
(define (rect-perimeter rect)
(+ (* (rect-height rect) 2)
(* (rect-width rect) 2)))
(define (rect-area rect)
(* (rect-height rect) (rect-width rect)))
長方形を高さと幅の対で表現すれば、make-rect, rect-height, rect-width は
次のように実装できる。
(define (make-rect height width) (cons height width))
(define (rect-height rect) (car rect))
(define (rect-width rect) (cdr rect))
[周囲の長さと面積の計算]
(define rect1 (make-rect 3 4))
(rect-perimeter rect1) ;=> 14
(rect-area rect1) ;=> 12
[別な長方形の表現]
長方形は中間点と長さが同じ2つの線分を対角線として、その4つの端点を結ん
だ領域として表現できる。対角線は1対の点で表現される(Exercise 2.2)。対角
線を使って長方形の表現を定義する構成子 make-rect と長方形の2つの対角線
を取り出す選択子 first-diagonal, second-diagonal と長方形の高さと幅を計算
する手続き rect-height, rect-width を定義する。線分の幅を求める
length-segment も必要なので定義する。対角線の開始点は終了点より左にある
と仮定する。また、ユーザーが与える2つの対角線は中間点と長さが同一で異な
る線分であると仮定する。
(define (make-rect diagonal1 diagonal2)
(cons diagonal1 diagonal2))
(define (first-diagonal rect) (car rect))
(define (second-diagonal rect) (cdr rect))
(define (length-segment s)
(let ((start-point (start-segment s))
(end-point (end-segment s)))
(sqrt (+ (square (- (x-point end-point) (x-point start-point)))
(square (- (y-point end-point) (y-point start-point)))))))
(define (rect-height rect)
(let ((start-h-point (start-segment (first-diagonal rect)))
(end-h-point (start-segment (second-diagonal rect))))
(length-segment (make-segment start-h-point end-h-point))))
(define (rect-width rect)
(let ((start-w-point (start-segment (first-diagonal rect)))
(end-w-point (end-segment (second-diagonal rect))))
(length-segment (make-segment start-w-point end-w-point))))
[周囲の長さと面積の計算]
(define d1 (make-segment (make-point -7 3) (make-point 2 -5)))
(define d2 (make-segment (make-point -7 -5) (make-point 2 3)))
(define rect2 (make-rect d1 d2))
(rect-height rect2) ;=> 8
(rect-width rect2) ;=> 9
(rect-perimeter rect2) ;=> 34
(rect-area rect2) ;=> 72
周囲と面積を計算する手続きは、どちらの長方形の表現でも働く。
Exercise 2.4
次の cons について任意のオブジェクト x と y に対し、(car (cons x y)) が x を生じることを
証明せよ。また cdr を定義せよ。
(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))
(car (cons 3 4)) を評価する。
cons の本体を取り出し、仮引数を 3 と 4 で置き換える。
(lambda (m) (m 3 4)) になる。
car の本体を取り出し、仮引数を (lambda (m) (m 3 4)) で置き換える。
((lambda (m) (m 3 4)) (lambda (p q) p)) になる。
左端の手続きは、引数を1つとり、それを 3 と 4 に作用させるものである。
手続きの本体を取り出し、引数の手続き (lambda (p q) p) で置き換える。
((lambda (p q) p) 3 4) になる。
手続き (lambda (p q) p) は、引数を2つとり、最初の引数を返す。
手続きを引数 3 と 4 に作用させると 3 を返す。
したがって、(car (cons x y)) は、x を生じる。
cdr も同様に手続きを引数としてとり、引数を2つとり2番目の引数を返す手続きに
作用させる関数として定義できる。
(define (cdr z)
(z (lambda (p q) q)))
(cdr (cons 3 4))
=>4
Exercise 2.5
Exercise 2.6
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
1. one と two を定義せよ。
2. + を定義せよ。
1
one は、(add-1 zero) の返す値なので、(add-1 zero) を評価してみる。
add-1 の本体をとりだす。
(lambda (f) (lambda (x) (f ((n f) x))))
仮引数 n を zero で置き換える。
(lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) x)) f) x)))) の評価に帰着する。
((lambda (f) (lambda (x) x)) f) は、(lambda (x) x) を返すので、
(lambda (f) (lambda (x) (f ((lambda (x) x) x)))) になる。
((lambda (x) x) x) は、x を返すので、
(lambda (f) (lambda (x) (f x))) に帰着する。
したがって、one は次のように定義できる。
(define one (lambda (f) (lambda (x) (f x))))
同様に、two は、(add-1 one) の返す値なので、(add-1 one) を評価すると次のように定義できる。
add-1 の本体をとりだし、仮引数を n を one で置き換える。
(lambda (f) (lambda (x) (f (((lambda (f) (lambda (x) (f x))) f) x)))) の評価に帰着する。
(((lambda (f) (lambda (x) (f x))) f) x) は、((lambda (x) (f x)) x) となりさらに、
(f x) となるので、
(lambda (f) (lambda (x) (f (f x)))) に帰着する。
(define two (lambda (f) (lambda (x) (f (f x)))))
2 保留
Exercise 2.7
選択子 upper-bound と lower-bound を定義せよ。
(define (upper-bound x) (max (car x) (cdr x)))
(define (lower-bound x) (min (car x) (cdr x)))
Exercise 2.8
区間の差の計算法を書け。対応する sub-interval を定義せよ。
差の最小値は下限の差であり、最大値は上限の差と考える。
(define (sub-interval x y)
(make-interval (- (lower-bound x) (lower-bound y))
(- (upper-bound x) (upper-bound y))))
Exercise 2.9
区間の幅は上限と下限の差の半分だから次のように定義できる。
(define (width-interval x)
(/ (- (upper-bound x) (lower-bound x)) 2.0))
区間の和の幅は、(width-interval (add-interval x y)) で得られる。
(add-interval x y) は、
(make-interval (+ (lower-bound x) (lower-bound y)) ;下限
(+ (upper-bound x) (upper-bound y))) ;上限
となり、下限と上限の対である。したがって和の幅は、
(/ (- (+ (upper-bound x) (upper-bound y)) ;上限
(+ (lower-bound x) (lower-bound y))) ;下限
2.0)
となり、
(+ (/ (- (upper-bound x) (lower-bound x)) 2.0)
(/ (- (upper-bound y) (lower-bound y)) 2.0))
とすれば、
(+ (width-interval x) (width-interval y)) となり区間の幅に関する関数になる。
区間の差の幅も同様に、
(make-interval (- (lower-bound x) (lower-bound y)) ;下限
(- (upper-bound x) (upper-bound y))) ;上限
から、
(/ (- (- (upper-bound x) (upper-bound y)) ;上限
(- (lower-bound x) (lower-bound y))) ;下限
2.0)
となり、
(- (/ (- (upper-bound x) (lower-bound x)) 2.0)
(/ (- (upper-bound y) (lower-bound y)) 2.0))
とすれば、
(- (width-interval x) (width-interval y)) となり区間の幅に関する関数になる。
Exercise 2.10
Exercise 2.11
Exercise 2.12
make-center-parcent と percent を定義せよ。
(define (make-center-parcent c p)
(let ((w (* c (/ p 100.0))))
(make-interval (- c w) (+ c w))))
(define (percent i)
(let ((c (center i)))
(/ (* (- (upper-bound i) c) 100.0) c)))
Exercise 2.13
Exercise 2.14
Exercise 2.15
Exercise 2.16
Exercise 2.17
(空でない)リストの最後の要素だけからなるリストを返す last-pair を定義せよ。
・リストのcdrが空リストなら、last-pair はそのリストを返す。
・そうでなければ、last-pair はリストのcdrを返す。
(define (last-pair items)
(if (null? (cdr items))
items
(last-pair (cdr items))))
(last-pair (list 23 72 149 34))
=>(34)
Exercise 2.18
逆順のリストを返す手続き reverse を定義せよ。
・引数のリストが空リストなら、reverse したリストも空リストである。
・空リストでなければ、リストの car を要素とするリストに、
リストの cdr を reverse したリストを append する。
(define (reverse ls)
(if (null? ls)
'() ;nil
(append (reverse (cdr ls)) (list (car ls)))))
;; 反復版
(define (reverse items)
(define (reverse-iter a items)
(if (null? items)
a
(reverse-iter (cons (car items) a) (cdr items))))
(reverse-iter '() items))
(reverse (list 1 4 9 16 25))
=>(25 16 9 4 1)
Exercise 2.19
first-denomination, except-first-denomination, no-more? を
1. リスト構造の基本的演算を使って定義せよ。
2. coin-values の順は、cc の答に影響があるか。なぜか。
1
(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))
(cc 100 us-coins)
=>292
2
Exercise 2.20
1個以上の整数をとり、先頭の引数と同じ偶奇性を持つ引数のリストを返す手続き
same-parity を定義せよ。
;; append を利用
(define (same-parity ca . cd)
(define (iter cd a)
(if (null? cd)
a
(let ((obj (car cd)))
(if (= (remainder ca 2) (remainder obj 2))
(iter (cdr cd) (append a (list obj)))
(iter (cdr cd) a)))))
(iter cd (list ca)))
;; reverse を利用
(define (same-parity ca . cd)
(define (iter cd a)
(if (null? cd)
(reverse a)
(let ((obj (car cd)))
(if (= (remainder ca 2) (remainder obj 2))
(iter (cdr cd) (cons obj a))
(iter (cdr cd) a)))))
(iter cd (list ca)))
※高階手続きを利用するのがよいのだと思う。
Exercise 2.21
square-list の2つの定義。
(define (square-list items)
(if (null? items)
'()
(cons (square (car items))
(square-list (cdr items)))))
(define (square-list items)
(map square items))
(square-list (list 1 2 3 4))
=>(1 4 9 16)
Exercise 2.22
1. Louis Reasoner が書いた反復プロセスを生成する square-list が
逆順のリストを作るのはなぜか。
(square-list (list 1 2 3 4)) ;=>(16 9 4 1)
返されるべきリストは、
(cons (square 1) (cons (square 2) (cons (square 3) (cons (square 4) '()))))
のように作られなければならないが、次のように引数のリストの先頭の要素から順に
手続きを作用させた結果を cons して行ったため。
answer ;=> ()
(cons (square 1) answer) ;=> (1):=answer
(cons (square 2) answer) ;=> (4 1):=answer
(cons (square 3) answer) ;=> (9 4 1):=answer
(cons (square 4) answer) ;=> (16 9 4 1):=answer
2. Louis が cons の引数を交換して修正した定義も動かない。なぜか。
(square-list (list 1 2 3 4)) ;=>((((() . 1) . 4) . 9) . 16)
次のようにリストが作られるため、cons の引数を交換しても期待した結果にはならない。
answer ;=> ()
(cons answer (square 1)) ;=> (() . 1):=answer
(cons answer (square 2)) ;=> ((() . 1) . 4):=answer
(cons answer (square 3)) ;=> (((() . 1) . 4) . 9):=answer
(cons answer (square 4)) ;=> ((((() . 1) . 4) . 9) . 16):=answer
※ append や reverse を利用すれば期待する結果となる定義が書ける。
Exercise 2.23
for-each を実装せよ。
(define (for-each proc items)
(cond ((null? items))
(else (proc (car items))
(for-each proc (cdr items)))))
gosh> (for-each (lambda (x) (newline) (display x))
(list 57 321 88))
57
321
88#t
Exercise 2.24
(list 1 (list 2 (list 3 4))) を評価したときの
1. 解釈系の印字結果
2. 箱とポインタ記法
3. 木としての解釈を書け。
1. 印字結果
(1 (2 (3 4)))
2. 箱とポインタ記法
;; (1 (2 (3 4))) のドット対記法 (1 . ((2 . ((3 . (4 . ())) . ())) . ())) から考えた。
[*|*]-[*|/]
| |
1 [*|*]-[*|/]
| |
2 [*|*]-[*|/]
| |
3 4
3. 木としての解釈
(1 (2 (3 4)))
.
/ \
1 . (2 (3 4))
/ \
2 . (3 4)
/ \
3 4
Exercise 2.25
次のリストから 7 を取り出す car と cdr の組み合せを書け。
1. (1 3 (5 7) 9)
2. ((7))
3. (1 (2 (3 (4 (5 (6 7))))))
1. (define list1 '(1 3 (5 7) 9))
;; '(1 . (3 . ((5 . (7 . ())) . (9 . ()))))
(car (cdr (car (cdr (cdr list1)))))
=>7
2. (define list2 '((7)))
;; '((7 . ()) . ())
(car (car list2))
=>7
3. (define list3 '(1 (2 (3 (4 (5 (6 7)))))))
;; '(1 . ((2 . ((3 . ((4 . ((5 . ((6 . (7 . ())) . ())) . ())) . ())) . ())) . ()))
(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr list3))))))))))))
=>7
Exercise 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))
Exercise 2.27
deep-reverse を定義せよ。
・リストの reverse は、リストの cdr を reverse したものと car を要素とするリストを append したもの。
・空リストを reverse したものは空リスト。
だった。deep-reverse も同様だが、car も reverse すべき木の場合があるので、
・木 x の deep-reverse は、x の car の deep-reverse を要素とするリストに、cdr の deep-reverse を append したもの。
・ただし葉なら、葉を要素とするリストに cdr の deep-reverse を append するため、それを返す。
(define (deep-reverse x)
(cond ((null? x) '())
((not (pair? x)) x)
(else (append (deep-reverse (cdr x))
(list (deep-reverse (car x)))))))
(define x (list (list 1 2) (list 3 4)))
x
=>((1 2) (3 4))
(reverse x)
=>((3 4) (1 2))
(deep-reverse x)
=>((4 3) (2 1))
Exercise 2.28
fringe を定義せよ。
★間違っている版
・空リストの fringe は空リスト。
・木 x の fringe は、その car が木なら car の fringe と cdr の fringe を append したもの。
・car が葉なら、葉を要素とするリストと cdr の fringe を append したもの。
・葉ならそれを返す。
(define (fringe x)
(cond ((null? x) '())
((not (pair? x)) x)
((pair? (car x))
(append (fringe (car x))
(fringe (cdr x))))
(else
(append (list (car x))
(fringe (cdr x))))))
(define x (list (list 1 2) (list 3 4)))
x
=>((1 2) (3 4))
(fringe x)
=>(1 2 3 4)
(fringe (list x x))
=>(1 2 3 4 1 2 3 4)
(fringe '(1 2 ()))
=>(1 2 ())
★修正版
・空リストの fringe は空リスト。
・木 x の fringe は、その car の fringe と cdr の fringe を append したもの。
・car をとりながら葉に至るので、葉なら cdr の fringe に append するため、
葉を要素とするリストを返す。
(define (fringe x)
(cond ((null? x) '())
((not (pair? x)) (list x))
(else
(append (fringe (car x))
(fringe (cdr x))))))
(fringe x)
=>(1 2 3 4)
(fringe (list x x))
=>(1 2 3 4 1 2 3 4)
(fringe '(1 2 ()))
=>(1 2)
Exercise 2.29
モビールはふたつの枝でできていて、それぞれ枝には錘か別のモビールがぶら下がっている。
;; モビールの構成子
(define (make-mobile left right)
(list left right))
;; 枝の構成子
(define (make-branch length structure)
(list length structure))
a. 枝を返す選択子 left-branch, right-branch と、枝の部品を返す
branch-length, branch-structure を書け。
;; 左の枝を返す
(define (left-branch mobile)
(car mobile))
;; 右の枝を返す
(define (right-branch mobile)
(car (cdr mobile)))
;; 枝の length を返す
(define (branch-length branch)
(car branch))
;; 枝の structure を返す
(define (branch-structure branch)
(car (cdr branch)))
b. 選択子を使い、モビールの全重量を返す手続き total-weight を定義せよ。
・モビールの重量は左右の枝の重量の和である。
・左と右に分けて後で加算する。
・枝は length と structure の合成データだから、structure をとりだし重量を求める。
・ただし、structure は錘である数か、別のモビールであるから、
モビールなら total-weight を再帰的に呼んで計算する。
(define (total-weight mobile)
(define (total branch)
(let ((structure (branch-structure branch)))
(if (pair? structure)
(total-weight branch)
structure)))
(+ (total (left-branch mobile))
(total (right-branch mobile))))
;;---- テスト ----------------------------------------------------------
(define m0 (make-mobile (make-branch 1 2)
(make-branch 3 4)))
m0 ;=>((1 2) (3 4))
(total-weight m0) ;=>6
(define m1 (make-mobile (make-branch 5 6)
m0))
m1 ;=>((5 6) ((1 2) (3 4)))
(total-weight m1) ;=>12
(define m2 (make-mobile m0 m1))
m2 ;=>(((1 2) (3 4)) ((5 6) ((1 2) (3 4))))
(total-weight m2) ;=>18
(define m3 (make-mobile (make-mobile (make-branch 1 2) (make-branch 3 4))
(make-mobile (make-branch 5 6) m2)))
m3 ;=>(((1 2) (3 4)) ((5 6) (((1 2) (3 4)) ((5 6) ((1 2) (3 4))))))
(total-weight m3) ;=>30
;;----------------------------------------------------------------------
c. モビールが釣り合っているかどうかをテストする述語を設計せよ。
;; 間違い。釣り合っていないモービルを部分に含むモービルが全体として釣り合ってしまっている。
引数としてモビールを1個とり、モビールが釣り合っていれば真を返し、
そうでなければ偽を返す述語 balanced-mobile? を定義する。
balanced-mobile? は、枝の回転力を計算する手続き rotation-power を使い、
左右の回転力を比較する。
(define (balanced-mobile? mobile)
(= (rotation-power (left-branch mobile))
(rotation-power (right-branch mobile))))
回転力を計算する rotation-power は、枝の length と structure を
掛け合わせたものだから、構成子 branch-structure と branch-length で
枝の部品を取得し計算すればよい。ただし、structure が別のモビールの場合、
そのモビールの左右の各枝を再帰的にたどって計算する必要がある。
(define (rotation-power branch)
(let ((structure (branch-structure branch)))
(if (pair? structure)
(+ (rotation-power (left-branch branch))
(rotation-power (right-branch branch)))
(* structure (branch-length branch)))))
;;---- テスト ----------------------------------------------------------
m1 ;=>((5 6) ((1 2) (3 4)))
(rotation-power m1) ;=>44
(balanced-mobile? m1) ;=>#f
(rotation-power m3) ;=>102
(balanced-mobile? m3) ;=>#f
(define m4 (make-mobile (make-mobile (make-branch 8 11) ;88
(make-branch 2 7)) ;14
m3))
m4 ;=>(((8 11) (2 7)) (((1 2) (3 4)) ((5 6) (((1 2) (3 4)) ((5 6) ((1 2) (3 4)))))))
(rotation-power m4) ;=>204
(balanced-mobile? m4) ;=>#t
;;----------------------------------------------------------------------
d. モビールの表現を変更し、構成子を次のようにした。
新しい表現に対応するには、どのくらいプログラムを変更しなければならないか。
(define (make-mobile left right)
(cons left right))
(define (make-branch length structure)
(cons length structure))
total-weight, balanced-mobile?, rotation-power は抽象の壁で隔離されているので、
合成データの選択子 right-branch と branch-structure を次のように変更するだけでよい。
(define (right-branch mobile)
(cdr mobile))
(define (branch-structure mobile)
(cdr mobile))
Exercise 2.30
square-tree を高階手続きを使わず定義せよ。また map と再帰を使って定義せよ。
(define (square-tree tree)
(cond ((null? tree) '())
((not (pair? tree)) (square tree))
(else (cons (square-tree (car tree))
(square-tree (cdr tree))))))
;; map と再帰を使う
(define (square-tree tree)
(map (lambda (sub-tree)
(if (not (pair? sub-tree))
(square sub-tree)
(square-tree sub-tree)))
tree))
(square-tree
(list 1
(list 2 (list 3 4) 5)
(list 6 7)))
=>(1 (4 (9 16) 25) (36 49))
Exercise 2.31
問題 2.30 を抽象化し、tree-map を作れ。
;; 高階手続きを使わない
(define (tree-map proc tree)
(cond ((null? tree) '())
((not (pair? tree)) (proc tree))
(else (cons (tree-map proc (car tree))
(tree-map proc (cdr tree))))))
;; map と再帰を使う
(define (tree-map proc tree)
(map (lambda (sub-tree)
(if (not (pair? sub-tree))
(proc sub-tree)
(tree-map proc sub-tree)))
tree))
(define (square-tree tree) (tree-map square tree))
(square-tree
(list 1
(list 2 (list 3 4) 5)
(list 6 7)))
=>(1 (4 (9 16) 25) (36 49))
Exercise 2.32
集合の部分集合の集合を作る手続き subsets を完成させ、
なぜこれが上手く行くのか明快に説明せよ。
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest
(map (lambda (x) (cons (car s) x))
rest)))))
(subsets '(1 2 3))
=>(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))
Exercise 2.33
リスト基本演算 map, append, length のアキュムレーションとしての定義
(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))
Exercise 2.34
Horner の方法
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms)
(+ this-coeff (* higher-terms x)))
0
coefficient-sequence))
Exercise 2.35
count-leaves をアキュムレーションとして定義せよ。
(define (count-leaves t)
(accumulate (lambda (x y) (+ x y))
0
(map (lambda (s)
(if (not (pair? s))
1
(count-leaves s)))
t)))
;; 別解 fold-left(Exercise2.38)を使った定義
(define (count-leaves t)
(fold-left (lambda (x y)
(if (pair? y)
(+ (count-leaves y) x)
(+ 1 x)))
0
t))
(count-leaves '()) ;=>0
(count-leaves '(1 2 (3 4 5 6 (7 8)))) ;=>8
(count-leaves '(1 (2 (3 (4 (5 6 7 (8 9))) 10 11)))) ;=>11
Exercise 2.36
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)))))
(accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12))) ;=>(22 26 30)
Exercise 2.37
;; マトリクス * ベクタ
(define (matrix-*-vector m v)
(map (lambda (x) (dot-product x v)) m))
(matrix-*-vector '((2 -1) (-3 4)) '(1 2)) ;=>(0 5)
(matrix-*-vector '((4 -1) (-5 3)) '(1 2)) ;=>(2 1)
;; 転置
(define (transpose mat)
(accumulate-n cons '() mat))
(transpose '((1 2 3) (4 5 6) (7 8 9))) ;=>((1 4 7) (2 5 8) (3 6 9))
(transpose '((1 4 7) (2 5 8) (3 6 9))) ;=>((1 2 3) (4 5 6) (7 8 9))
;; マトリクス * マトリクス
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (x)
(map (lambda (y)
(dot-product x y))
cols))
m)))
(matrix-*-matrix '((5 6) (7 8)) '((1 2) (3 4))) ;=>((23 34) (31 46))
(matrix-*-matrix '((1 2) (3 4)) '((5 6) (7 8))) ;=>((19 22) (43 50))
Exercise 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 == accumulate
(define (fold-right op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(fold-right op initial (cdr sequence)))))
1. 次の値は何か。
(fold-right / 1 (list 1 2 3)) ;=>3/2
(fold-left / 1 (list 1 2 3)) ;=>1/6
(fold-right list nil (list 1 2 3)) ;=>(1 (2 (3 ())))
(fold-left list nil (list 1 2 3)) ;=>(((() 1) 2) 3)
2. 同じ値を生じるための op の満たすべき性質は何か。
min, max, +, * などのように引数の順序が変っても結果が同一であること。
;; fold-left
(fold-left / 1 (list 2 3 4 5)) ;=>1/120
(/ (/ (/ (/ 1 2) 3) 4) 5) ;=>1/120
;; fold-right
(accumulate / 1 (list 2 3 4 5)) ;=>8/15
(fold-right / 1 (list 2 3 4 5)) ;=>8/15
(/ 2 (/ 3 (/ 4 (/ 5 1)))) ;=>8/15
;; fold-left
(fold-left / 1 (list 1 2 3 4)) ;=>1/24
(/ (/ (/ (/ 1 1) 2) 3) 4) ;=>1/24
;; fold-right
(fold-right / 1 (list 1 2 3 4)) ;=>3/8
(/ 1 (/ 2 (/ 3 (/ 4 1)))) ;=>3/8
;; fold-left
(fold-left + 0 (list 1 2 3 4)) ;=>10
(+ (+ (+ (+ 0 1) 2) 3) 4) ;=>10
;; fold-right
(fold-right + 0 (list 1 2 3 4)) ;=>10
(+ 1 (+ 2 (+ 3 (+ 4 0)))) ;=>10
;; fold-left
(fold-left max 0 (list 1 2 3 4)) ;=>4
(max (max (max (max 0 1) 2) 3) 4) ;=>4
;; fold-right
(fold-right max 0 (list 1 2 3 4)) ;=>4
(max 1 (max 2 (max 3 (max 4 1)))) ;=>4
Exercise 2.39
reverse の fold-right と fold-left を使った定義
(define (reverse sequence)
(fold-right (lambda (x y) (append y (list x))) nil sequence))
(define (reverse sequence)
(fold-left (lambda (x y) (cons y x)) '() sequence))
;; fold(srfi-1)
(define (reverse sequence)
(fold (lambda (x y) (cons x y)) '() sequence))
(reverse (list 1 2 3)) ;=>(3 2 1)
Exercise 2.40
1. unique-pairs を定義せよ。
2. unique-pairs を使って prime-sum-pairs の定義を簡単にせよ。
1
(define (unique-pairs n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
;; 以下別解
(define (unique-pairs n)
(flatmap (lambda (i)
(flatmap (lambda (j) (list (list i j)))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(define (unique-pairs n)
(apply append
(map (lambda (i)
(apply append
(map (lambda (j) (list (list i j)))
(enumerate-interval 1 (- i 1)))))
(enumerate-interval 1 n))))
(use srfi-42)
(define (unique-pairs n)
(list-ec (: i 1 (+ n 1))
(: j 1 i)
(list i j)))
(unique-pairs 5)
=>((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))
2
(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))
Exercise 2.41
正の整数 n に対し、1 <= k < j < i <= n である異なる正の整数 i と j と
k のリストで、i + j + k が与えられた整数 s と等しくなるものをすべて見つ
ける手続きを書け。(と問題文を理解して解答した。)
;; もっと良い解があるのではないか。
(define (find-all s n)
(filter (lambda (x) (= (accumulate + 0 x) s))
(accumulate append nil
(accumulate append nil
(map (lambda (i)
(map (lambda (j)
(map (lambda (k) (list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))))
;; flatmap 1
(define (find-all s n)
(flatmap
(lambda (x) (filter pair? x))
(flatmap (lambda (i)
(map (lambda (j)
(map (lambda (k) (and (= (+ i j k) s) (list i j k)))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))
;; flatmap 2
(define (find-all s n)
(flatmap (lambda (i)
(flatmap (lambda (j)
(flatmap (lambda (k)
(if (= (+ i j k) s)
(list (list i j k))
'()))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
;; apply
(define (find-all s n)
(apply append
(map (lambda (i)
(apply append
(map (lambda (j)
(apply append
(map (lambda (k)
(if (= (+ i j k) s)
(list (list i j k))
'()))
(enumerate-interval 1 (- j 1)))))
(enumerate-interval 1 (- i 1)))))
(enumerate-interval 1 n))))
(find-all 5 10) ;=>()
(find-all 6 10) ;=>((3 2 1))
(find-all 7 10) ;=>((4 2 1))
(find-all 8 10) ;=>((4 3 1) (5 2 1))
(find-all 9 10) ;=>((4 3 2) (5 3 1) (6 2 1))
(find-all 10 10) ;=>((5 3 2) (5 4 1) (6 3 1) (7 2 1))
;; srfi-42 を使ってみた
(use srfi-42)
(define (find-all s n)
(list-ec (: i 1 (+ n 1))
(: j 1 i)
(: k 1 j)
(if (= (+ i j k) s))
(list i j k)))
(find-all 5 10) ;=>()
(find-all 6 10) ;=>((3 2 1))
(find-all 7 10) ;=>((4 2 1))
(find-all 8 10) ;=>((4 3 1) (5 2 1))
(find-all 9 10) ;=>((4 3 2) (5 3 1) (6 2 1))
(find-all 10 10) ;=>((5 3 2) (5 4 1) (6 3 1) (7 2 1))
Exercise 2.42
エイトクィーンパズル
empty-board と adjoin-position と safe? を書いてプログラムを完成せよ。
(define empty-board nil)
(define (safe? k positions)
(define (conflict? level up down positions)
(if (null? positions)
#t
(let ((row (caar positions)))
;; 同じ行・斜め上の筋・斜め下の筋にあるなら衝突
(if (or (= level row) (= up row) (= down row))
#f
(conflict? level (- up 1) (+ down 1) (cdr positions))))))
(if (= k 1) ;(null? positions) としてkを利用しなくてもできてしまう…
#t
(let ((row (caar positions)))
;; 列を遡って調べる
(conflict? row (- row 1) (+ row 1) (cdr positions)))))
(define (adjoin-position new-row k rest-of-queens)
(cons (list new-row k) rest-of-queens))
(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))
(queens 4)
=>(((3 4) (1 3) (4 2) (2 1))
((2 4) (4 3) (1 2) (3 1)))
(queens 5)
;;(map (lambda (x) (map (lambda (y) (car y)) x)) (queens 5))
=>((4 2 5 3 1) (3 5 2 4 1) (5 3 1 4 2) (4 1 3 5 2) (5 2 4 1 3)
(1 4 2 5 3) (2 5 3 1 4) (1 3 5 2 4) (3 1 4 2 5) (2 4 1 3 5))
(queens 6)
;;(map (lambda (x) (map (lambda (y) (car y)) x)) (queens 6))
=>((5 3 1 6 4 2) (4 1 5 2 6 3) (3 6 2 5 1 4) (2 4 6 1 3 5))
(length (queens 7))
=>40
(length (queens 8))
=>92
Exercise 2.43
Exercise 2.44
Exercise 2.45
Exercise 2.46
Exercise 2.47
Exercise 2.48
Exercise 2.49
Exercise 2.50
Exercise 2.51
Exercise 2.52
Exercise 2.53
Exercise 2.54
Exercise 2.55
Exercise 2.56
Exercise 2.57
Exercise 2.58
Exercise 2.59
Exercise 2.60
Exercise 2.61
Exercise 2.62
Exercise 2.63
Exercise 2.64
Exercise 2.65
Exercise 2.66
Exercise 2.67
Exercise 2.68
Exercise 2.69
Exercise 2.70
Exercise 2.71
Exercise 2.72
Exercise 2.73
Exercise 2.74
Exercise 2.75
Exercise 2.76
Exercise 2.77
Exercise 2.78
Exercise 2.79
Exercise 2.80
Exercise 2.81
Exercise 2.82
Exercise 2.83
Exercise 2.84
Exercise 2.85
Exercise 2.86
Exercise 2.87
Exercise 2.88
Exercise 2.89
Exercise 2.90
Exercise 2.91
Exercise 2.92
Exercise 2.93
Exercise 2.94
Exercise 2.95
Exercise 2.96
Exercise 2.97
最終更新：2008年02月20日 00:24
