「第2章 データによる抽象の構築」で提示されている問題を解いています。
目次
問題
2.1
最初に自分で作った手続き。
(define (make-rat n d)
(define (rat abs-n abs-d g symbol)
(cond ((= d 0) (error "denom MUST NOT zero."))
(else (cons (* symbol (/ abs-n g)) (/ abs-d g)))))
(rat (abs n) (abs d) (abs (gcd n d))
(/ (* n d) (* (abs n) (abs d)))))
正負を決定する時の+/-の判別処理と、その結果をsymbolに入れて使っている部分は自分でも面白いと思うけど、いかんせん全体で汚いコードになってしまっている。それに対して、解答の記述は
(define (make-rat n d)
(let ((g (abs (gcd n d))))
(if (< d 0)
(cons (/ (- n) g) (/ (- d) g))
(cons (/ n g) (/ d g)))))
やっぱり、式に対してどういうパターンがあるかを見極めた上でコーディングするべきだと思った。
で、ちょっと調べてみた。
で、ちょっと調べてみた。
gosh> (gcd 6 9) 3 gosh> (gcd -6 9) 3 gosh> (gcd 6 -9) -3 gosh> (gcd -6 -9) -3
なるほど、それでgcdの正の数にしておいて、分母が負のときに符号を反転しているんだ。
2.2
考えたけれど、次のような抽象の壁を作成しよう。
| 抽象度 | 手続き |
| 高 | ユーザー |
| ↑ | midpoint-segment, start/end-segment |
| ｜ | make-segment, x/y-point |
| ↓ | make-point |
| 低 | cons,car,cdr |
この表を元に作成したのが、これ。
(define (make-point x y) (cons x y)) (define (x-point point) (car point)) (define (y-point point) (cdr point)) (define (make-segment start end) (cons start end)) (define (start-segment seg) (car seg)) (define (end-segment seg) (cdr seg))
(define (avg a b) (/ (+ a b) 2)) (define (midpoint-segment seg) (cons (avg (x-point (start-segment seg)) (x-point (end-segment seg))) (avg (y-point (start-segment seg)) (y-point (end-segment seg)))))
ここで１点気になった。make-segmentやstart/end-segment手続きは、car/cdr/consといった最下層の手続きとは離れている。にも関わらずcar/cdr/consを使うのは、データ構造を意識させてしまうから良くないのでは？各壁で対を作る手続きを提供した方がいいのでは（面倒だけど）？
さらにその理屈から言えば、SICP（2.1 データ抽象入門）の「2.1.2 抽象の壁」にある壁もユーザーがmake-ratを直接使っていたけれど、避けた方がいい・・・けれどそれだと何だかおかしい。
ちょっと待て。抽象の壁と、構造化設計モジュール図（またはUMLのオブジェクト図）の考え方は違うのか？
うー、分からなくなってきた・・・。
ちょっと待て。抽象の壁と、構造化設計モジュール図（またはUMLのオブジェクト図）の考え方は違うのか？
うー、分からなくなってきた・・・。
2.3
まず、いきなり誤読。文中の「長方形(rectangle)」と「四角形(quadrilateral)」は違うのだ。Wikipediaの説明を引用すると、
| 長方形（ちょうほうけい）、矩形（くけい）は、4つの角がすべて等しい四角形である。4つの角はすべて直角となる。 |
となっている。必死に四角形なるデータ構造を作ろうとしていた・・・(*1)。
というわけで再チャレンジ。
というわけで再チャレンジ。
まず、縦・横を表す2つの線分で長方形を表現するタイプ。
(define (make-rectangle a b) (cons a b))
(define (height-rectangle a) (length-segment (car a)))
(define (width-rectangle a) (length-segment (cdr a)))
(define (length-segment a)
(sqrt (+ (square (- (x-point (start-segment a))
(x-point (end-segment a))))
(square (- (y-point (start-segment a))
(y-point (end-segment a)))))))
次に幅×高さの長さで長方形を表現するタイプ。
(define (make-rectangle height width) (cons height width)) (define (height-rectangle a) (car a)) (define (width-rectangle a) (cdr a))
これらはいずれも同じ長さ・面積を計算する手続きが利用できる。
(define (perimeter r)
(+ (* 2 (height-rectangle r))
(* 2 (width-rectangle r))))
(define (area r)
(* (height-rectangle r) (width-rectangle r)))
こんな感じでいいかな。
2.4
(define (cons x y) (lambda (m) (m x y))) (define (car z) (z (lambda (p q) p))) (define (cdr z) (z (lambda (p q) q)))
consを使うと、「引数を1つ取り、その引数に値x,yで評価させる」手続きを返す。一方、car/cdrはconsで生成した手続きに対して、「引数を2つ取り、その内のどちらかを返す」手続きを渡している。
それによって、consで手続きを生成した時に渡した値のどちらかが得られる。
それによって、consで手続きを生成した時に渡した値のどちらかが得られる。
consで手続きを生成した時に、値x,yが閉包されている点がポイントだね。このような値が束縛される概念、Cではどういうふうに表現するべきなんだろう？
2.5
なぜ2^a*3^bを使って非正数の対が表現できるかの証明は省略。
(define (ex-cons a b)
(* (expt 2 a) (expt 3 b)))
(define (pair z value result)
(if (= (remainder z value) 0)
(pair (/ z value) value (+ result 1))
result))
(define (ex-car z)
(pair z 2 0))
(define (ex-cdr z)
(pair z 3 0))
2.6
む・・・ダメ、全然ダメ。分からない。
(define zero (lambda (f) (lambda (x) x))) (define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x)))))
まず脳内解釈をしてみる。
| zero | 「引数を1つ(f)とり、「引数を1つ(x)取り、その値をそのまま返す手続き」を返す手続き」を返す |
| add-1 | 「引数を1つ(n←これも手続き)取り、「引数を1つ(f←これも手続き)取って、fでnを評価した結果で返る手続きでxを評価し、その結果をfで評価して返る手続き」を返す手続き」を返す |
いや、意味が分かりません。とりあえず入力＆評価してみたものの、Closureが帰ってくるだけでどう利用するのかが分からない。
しょうがないのでChurch数とは何かを調べた。Blog Not Foundというページがヒットして、いわく
| ・・・要は、ある数は、ある関数fを何回xに適用するか、という定義にしてしまうのである。・・・ |
とのこと。こちらのページにも分かりやすい説明が載っている（解答まで）。ふむふむ。最初からそう言ってもらえれば。
で、今zeroは(lambda (x) x)となっていて、xをそのまま返している（＝一度も関数fを適用していない）から0となるわけか。
(define inc (lambda (x) (+ x 1))) ((zero inc) 0) → 0 (((add-1 zero) inc) 0) → 1
ここでincを渡しているのは、この関数は関数を適用した回数が結果として得られるから。(lambda (x) (+ x 2))だとoneに渡した時には2が得られる、はず。
となると、まずoneとtwoはシンプルに考えて、
となると、まずoneとtwoはシンプルに考えて、
(define one (lambda (f) (lambda (x) (f x)))) (define two (lambda (f) (lambda (x) (f (f x)))))
((one inc) 0) → 1 ((two inc) 0) → 2
よし、次は加算。aはfをa回適用することなので、a+bはfをa回適用した後に、さらにb回適用すればいいのかな。
ここで少し手戻りして、lambdaが2回繰り返されるというのはどういう使い方になるかをメモ。oneを例にとります。
(define one (lambda (f) (lambda (x) (f x))))
は、
- zeroに対して関数fを渡す
- 引数xを取る手続きが返ってくる
- 返ってきた手続きに対して値xを渡す
- 関数fを使ってxを1回評価してくれる
となる。twoだと(f (f x))なので、xを関数fで2回評価。
おや・・・？すると、数値を表す手続きは、それ自体がfをn回評価してくれる手続きになっているわけか。特に再帰を繰り返さなくてもいいのかも。
そこで以下の式を作ってみた。
そこで以下の式を作ってみた。
(define (add n1 n2) (lambda (f) (n1 (n2 f))))
(((add one two) inc) 0) → 2 (((add two two) inc) 0) → 4
ん？
(define three (lambda (f) (lambda (x) (f (f (f x)))))) (((add two three) inc) 0) → 6 (((add three (add two three)) inc) 0) → 18
あらら、かけ算が出来てしまった・・・。
2つの数字手続きと値を評価する順番が違うのかな。
2つの数字手続きと値を評価する順番が違うのかな。
(define (add n1 n2)
(lambda (f)
((n2 n1) f)))
今度はn1のn2乗になってしまった。あれれ？
(define (add n1 n2)
(lambda (f)
(lambda (x)
((n1 f) ((n2 f) x)))))
やっとできた。長かったー。
2.7
(define (lower-bound x) (car x)) (define (upper-bound x) (cdr x))
2.8
(define (sub-interval x y)
(make-interval (- (lower-bound x) (upper-bound y))
(- (upper-bound x) (lower-bound y))))
最初はadd-intervalと同様にlower同士、upper同士で引き算をしていたけれど、そうではなかった。
なぜこの式で正しいか、ちょっと勉強しないと。そういうものなのだろうか？
なぜこの式で正しいか、ちょっと勉強しないと。そういうものなのだろうか？
2.9
省略。別にいいでしょ。（←言い訳）
2.10
0を跨がる区間で除算をしたときに、lower/upperの符号が値とは逆になってしまう問題があるのは分かった。この時にエラーを返せばいいので、
(define (new-div-interval x y)
(let ((yl (lower-bound y))
(yu (upper-bound y)))
(if (and (< yl 0) (< 0 yu))
(error "error" yl yu)
(mul-interval x
(make-interval (/ 1.0 yu) (/ 1.0 yl))))))
これでいいはず。
2.11
ギブアップ。写経してみる。
(define (new-mul-interval x y)
(let ((xl (lower-bound x))
(xu (upper-bound x))
(yl (lower-bound y))
(yu (upper-bound y)))
(cond ((< xu 0)
(cond ((< yu 0) (make-interval (* xu yu) (* xl yl)))
((< yl 0) (make-interval (* xl yu) (* xl yl)))
(else (make-interval (* xl yu) (* xu yl)))))
((< xl 0)
(cond ((< yu 0) (make-interval (* xu yl) (* xl yl)))
((< yl 0) (make-interval (min (* xl yu) (* xu yl))
(max (* xl yl) (* xu yu))))
(else (make-interval (* xl yu) (* xu yu)))))
(else
(cond ((< yu 0) (make-interval (* xu yl) (* xl yu)))
((< yl 0) (make-interval (* xu yl) (* xu yu)))
(else (make-interval (* xl yl) (* xu yu))))))))
場合分けの嵐になっている。9つの場合分けなので、しょうがないけれど。
でも、まだこの場合分けで良いのかどうか、なぜ２回評価されるかが分からない。今後の課題（溜まっているなあ）にさせてくださいお願いします。
でも、まだこの場合分けで良いのかどうか、なぜ２回評価されるかが分からない。今後の課題（溜まっているなあ）にさせてくださいお願いします。
2.12
やっと僕にも解ける問題がやってきた（情けない・・・）。
まず、作ったのが以下の手続き。
まず、作ったのが以下の手続き。
(define (make-center-percent c p) (make-interval (- c (* (/ c 100.0) p)) (+ c (* (/ c 100.0) p)))) (define (percent i) (* (/ (width i) (center i)) 100.0))
gosh> (percent (make-center-percent 100 15)) 15.0 gosh> (percent (make-center-percent 100 7)) 7.0 gosh> (percent (make-center-percent 35 7)) 7.000000000000008
うん、大丈夫。と思って解答を見たら、
(define (make-p c p)
(let ((w (/ (* c (/ p 100)) 2)))
(make-center-width c w)))
なんてやっている。letを使っているのは見習いたいけれど、これは違うんじゃないか？2.1.4の冒頭で、
| 例えば「10パーセントの許容誤差で6.8オーム」と書いてある抵抗を買えば、抵抗値は6.8-0.68=6.12と6.8+0.68=7.48オームの間の抵抗値を持っているということしか確かでない |
とあるのに、解答の手続きでは[6.46, 7.14]になってしまうから。let内の1/2倍は余分なんだね。
2.13
すみません、分かりません。飛ばします。
2.14
gosh> (define a (make-center-percent 10 1)) a gosh> (percent (div-interval a a)) 1.9998000199979908
割った結果の相対誤差が倍の2%になっている。
2.15
(define (par1 r1 r2) (div-interval (mul-interval r1 r2) (add-interval r1 r2))) (define (par2 r1 r2) (let ((one (make-interval 1 1))) (div-interval one (add-interval (div-interval one r1) (div-interval one r2)))))
gosh> (define a (make-center-percent 10 1)) a gosh> (percent (par1 a a)) 2.9992002399280135 ← 誤差が3%になっている gosh> (percent (par2 a a)) 0.9999999999999963 ← 誤差は1%のまま
設問のとおり、確かにpar1よりpar2の方が精度が良い。もうちょっと調べてみると、
gosh> (percent (par1 (par1 a a) a)) 5.660807155635733 gosh> (percent (par1 (par1 a a) (par1 a a))) 8.976076075554126 gosh> (percent (par2 (par2 a a) a)) 0.9999999999999966 gosh> (percent (par2 (par2 a a) (par2 a a))) 0.9999999999999963 gosh> (percent (par2 (par2 a a) (par1 a a))) 1.999800019997993
となっている。par1が評価されるほど誤差が大きくなっているということは、誤差を生みやすい区間データを使うほど誤差が大きくなるということ、かも（自信なし）。
だから、データが評価される回数が少ないpar2の方が「よい」プログラムであるということか。
2.16
| 注意：この問題は非常に難しい |
とあるので、後回し。
2.17
忙しさにかまけ、以前の問題を解いてから3日も経ってしまった。また隙を見ては続けていかねば。
で、ここからはリストが登場。
(define (last-pair items)
(if (null? (cdr items))
items
(last-pair (cdr items))))
2.18
逆からリストを辿ったときに、リストと値という対を作ったり、先頭がヌル、つまり末尾のヌルも含めて逆順にしてしまったり（出来上がったリストの末尾は数字）と予想外に苦労した。再帰的手続きで当初書いていたけれど、断念して反復的手続きに方針変更。それで何とか完成した。
(define (reverse items)
(define (rev-itr list1 list2)
(if (null? list1)
list2
(rev-itr (cdr list1) (cons (car list1) list2))))
(rev-itr items ()))
ちなみに解答ではどうしているんだろう？と思って見てみたら、
(define (reverse l)
(if (null? l)
()
(append (reverse (cdr l)) (list (car l)))))
というように本書の説明文中で作成したappend手続きを使用していた。なるほどね。あと、ポイントは最終行で単に「(car l)」としないで、「(list (car l))」としているところ。なるほど、こうすれば末尾も対で構成されるよ。
2.19
1.2.2 例：両替の計算で紹介されていた、指定金額を両替するときの全組み合わせを求める計算で、コインの並びをリストで実現する方法について。メインルーチンはすでにテキストに載っていたので、問題はその一部をリストが使用できるように置き換えるだけだった。
(define us-coins (list 50 25 10 5 1)) (define uk-coins (list 100 50 20 10 5 2 1 0.5)) (define jp-coins (list 500 100 50 10 5 1)) (define (cc amount coin-values) (define (no-more? coins) (null? coins)) (define (first-denomination coins) (car coins)) (define (except-first-denomination coins) (cdr coins)) (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)))))
(cc 100 us-coins) => 292 (cc 100 jp-coins) => 159 (cc 100 uk-coins) => 104561(計算に時間がかかった)
で、この問題のもう1つの質問：
| リストcoins-valuesの順は、ccの答に影響があるか。なぜか。 |
が分からない。影響があるかどうかは「順番には影響がない」と1.2.2の説明文で書いてあったんだけど、理由が分からない。何だろう？今後の宿題にしておこう。
2.20
まずは自力で解いた方法。反復的手続きを使用している。
(define (same-party first . rest)
(define (itr matched? l1 l2)
(cond ((null? l1) (reverse l2))
(else (if (matched? (car l1))
(itr matched? (cdr l1) (cons (car l1) l2))
(itr matched? (cdr l1) l2)))))
(itr (if (= (remainder first 2) 0)
(lambda (x) (= (remainder x 2) 0))
(lambda (x) (= (remainder x 2) 1)))
(cons first rest) ()))
l1が最後に空リストになったときの結果が逆順になっているため、問題2.18のreverse手続きを使用している点が気になる。
そこで解答を見て、それを参考にもう一度解いた。
そこで解答を見て、それを参考にもう一度解いた。
(define (same-party2 first . rest)
(define (itr matched? l1)
(cond ((null? l1) ())
((matched? (car l1))
(cons (car l1) (itr matched? (cdr l1))))
(else (itr matched? (cdr l1)))))
(itr (if (= (remainder first 2) 0)
(lambda (x) (= (remainder x 2) 0))
(lambda (x) (= (remainder x 2) 1)))
(cons first rest)))
こちらは再帰的手続きになっている。リストを扱う上で、反復的手続きではどうしても逆順になってしまうのだろうか？
2.21
mapを使い始める。
(define (sq x) (* x x))
(define (square-list items) (if (null? items) () (cons (sq (car items)) (square-list (cdr items)))))
(define (square-list-map items) (map sq items))
map、超便利。
2.22
これは僕が2.20で悩んだのと同じことだ！
最初に作った手続き：
最初に作った手続き：
(define (sq-list-rep items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons (sq (car things))
answer))))
(iter items ()))
これは(1^2 . ())→(2^2 . (1^2 . ()))→(3^2 . (2^2 . (1^2 . ())))というように評価されていってしまうから、結果が逆順になってしまう。
「それならば」とconsする順番を変えただけの手続き（これも作ってしまった経験あり）：
「それならば」とconsする順番を変えただけの手続き（これも作ってしまった経験あり）：
(define (sq-list-rep items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons answer
(sq (car things))))))
(iter items ()))
これは(() . 1^2)→((() . 1^2) . 2^2)→というようにconsしていくため、やはりうまくいかない。
ではどうすれば良いのか、がまだ分からない。解答にも書いてなかったし・・・。
ではどうすれば良いのか、がまだ分からない。解答にも書いてなかったし・・・。
2.23
(define (for-each func items)
(cond ((null? items) #t)
(else (func (car items))
(for-each func (cdr items)))))
ifではなくてcondを使えば複数の式を同じ条件のときに書けるので、それを利用した。ところがSICP Reading's Wikiの解答例を見たら、
| 弾さん曰く、「(define for-each map) でいいじゃない」とのこと。 確かに...。 |
という記述があった。試してみると、最後に返す値こそ違うが、確かに同じだ。へぇへぇ（古い）。
(define for-each2 map)
2.24
省略。
ノートには手書きしてあるので、GraphvizかPower Pointを使って後で書こう。
ノートには手書きしてあるので、GraphvizかPower Pointを使って後で書こう。
2.25
(define x (list 1 3 (list 5 7) 9)) (define y (list (list 7))) (define z (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(car (cdr (car (cdr (cdr x))))) ; -> 7 (car (car y)) ; -> 7 (cadr (cadr (cadr (cadr (cadr (cadr z)))))) ; -> 7
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
まず、自分で作ったdeep-reverse手続きは以下。
(define (deep-reverse items)
(cond ((null? items) ())
((pair? (car items))
(append (deep-reverse (cdr items))
(list (deep-reverse (car items)))))
(else
(append (deep-reverse (cdr items))
(list (car items))))))
これはこれできちんと動く。pair?のときとelseとで似たような処理になっているのが気にかかるものの、これ以上はシェイプアップできないでしょう！と思って解答を見た。
(define (deep-reverse items)
(if (pair? items)
(append (deep-reverse (cdr items))
(list (deep-reverse (car items))))
items))
あれ？何だか凄くシンプルになっている・・・。pair?で#tだった場合の処理は同じだけど、#fだった場合はlをそのまま返して、さらにnull?判定が無くなっている。あ、よく見るとpair?の判定対象が(car items)ではなくて、itemsそのものを見ているな。
itemsが対かどうかを調べ、そうでない場合はitemsを直接返しているから、もはや空リストかどうかを調べる必要はないわけか（空リストもpair?で#fを返す）。あー・・・処理を追っていると確かに同じだ。
2.28
また解答を見てしまった。最近はペースも落ちているし、もっと学習への意欲を燃やさなければ。
(define (fringe l)
(if (pair? l)
(if (pair? (car l))
(append (fringe (car l)) (fringe (cdr l)))
(cons (car l) (fringe (cdr l))))
l))
このロジックはファイルを階層的に走査して一覧を得るときとかによく使うテクニックになると思うので、よく見ておこう。
まず、pair?をlそのものと(car l)との2層2回実施している点に注目。ここで先にcar部が対かどうかを評価しようとすると、再帰処理の中で値が渡ったときに「リストじゃないよ」と怒られるのでアウト。だからまずlそのものが対かどうかを見ている。
あと、対だったときにcar部cdr部の双方で再帰させているけれど、そのときの結合方式がappendになっている点も注意。fringeが返すのはリストなので、リストとリストをconsしてもダメだからだ。
2.29
さて、じっくり解いていこう。
まずはa)のモビールの枝を返す手続きと、長さ、構成物を返す手続きを定義。
まずはa)のモビールの枝を返す手続きと、長さ、構成物を返す手続きを定義。
(define (left-branch mobile) (car mobile)) (define (right-branch mobile) (cadr mobile)) (define (branch-length branch) (car branch)) (define (branch-structure branch) (cadr branch))
これは簡単。
次はb)で、モビールの全重量を返す手続きtotal-weightの定義。a)で作った定義を使わないといけないが、さてどうしたものか。
(define (has-mobile? branch)
(pair? (branch-structure branch)))
(define (total-weight m)
(define (branch-weight b)
(if (has-mobile? b)
(total-weight (branch-structure b))
(branch-structure b)))
(+ (branch-weight (left-branch m))
(branch-weight (right-branch m))))
うん、解けた。内部で手続きをもう1つ作っているのはあまりキレイではない気がするけれど、これでも良いと思う。
ただ、これだとmobileそのものが単なる値だった場合に対処できない。そこで解答を参考に、mそのものをpair?で評価し、対でなければmをそのまま返すよう変更した。
(define (total-weight m)
(if (not (pair? m))
m
(let ((l-b (left-branch m))
(r-b (right-branch m)))
(let ((l-s (branch-structure l-b))
(r-s (branch-structure r-b)))
(+ (total-weight l-s)
(total-weight r-s))))))
これなら動作が明確になるので、気軽に使えるような手続きになっているかな。やはり、エラー処理を含む特殊処理は大切だ。
で、c)。作ったモビールがバランスが取れているかどうかを返すbalanced手続きを作る。どうやって式を組み立てるかで悩んだ。
つまるところ、
- 今見ているモビールの、左右の回転力が等しい
- 左側のバランスが取れている
- 右側のバランスが取れている
という3つの条件がandで揃えば#tを返せばいい。それ以外は#f。あとは再帰をストップさせる条件として、単なる錘がぶら下がっている枝のバランスは常に#tを返すことを追加する。
それが下の手続き：
(define (balanced m)
(if (not (pair? m))
#t
(let ((left-b (left-branch m))
(right-b (right-branch m)))
(let ((left-l (branch-length left-b))
(right-l (branch-length right-b))
(left-s (branch-structure left-b))
(right-s (branch-structure right-b)))
(and (= (* left-l (total-weight left-s))
(* right-l (total-weight right-s)))
(balanced left-s)
(balanced right-s))))))
なんて簡単に書いたけど、実際には相当苦労した。
回転力を求める手続きを別に作った方が良いのか、and手続きは一度に2つの式しか評価できないのでは、とか（and/orは幾つでも引数を取れる）。あとは回転力を部分モビールごとに見ようとした時、毎回total-weight手続きを使うと計算回数が多くなってしまうのではという点が特に気になって、考えが進まなかった。
回転力を求める手続きを別に作った方が良いのか、and手続きは一度に2つの式しか評価できないのでは、とか（and/orは幾つでも引数を取れる）。あとは回転力を部分モビールごとに見ようとした時、毎回total-weight手続きを使うと計算回数が多くなってしまうのではという点が特に気になって、考えが進まなかった。
でも、解答を見たら毎回のモビールで使っていたので、まあいいやということで。
d)のモビールのデータ構造をlistではなくconsにした時の、これまで作った手続きへの影響はどれくらいかという質問は、（list→cons程度の）変更には対応できる抽象化を行っているので、right-branchとbranch-structureで使っているcadrをcdrに変更するだけでオーケー。
でも、consではなく別のデータ構造に変える場合は注意が必要。だってpair?という対に対する基本手続きを使ってしまっているから。
2.30
これはSICP（2.2 階層データ構造と閉包性）の「木と写像」にあるサンプルとほとんど変わらないので、そのまま。
(define (square-tree1 tree) (cond ((null? tree) ()) ((not (pair? tree)) (* tree tree)) (else (cons (square-tree1 (car tree)) (square-tree1 (cdr tree))))))
(define (square-tree2 tree) (map (lambda (item) (if (pair? item) (square-tree2 item) (* item item))) tree))
上が再帰による写像で、下がmapを使った写像。最初mapの方でitemが対だったときに(square-tree2 (car item))としてしまった。
mapの1回の処理で見ているのは木全体ではなくその1つなので、carしたりcdrしたりする必要は無いのだ。
mapの1回の処理で見ているのは木全体ではなくその1つなので、carしたりcdrしたりする必要は無いのだ。
2.31
(define (tree-map f tree)
(map (lambda (item)
(if (pair? item)
(tree-map f item)
(f item)))
tree))
簡単、簡単。
2.32
「リストの各要素からなる全ての組み合わせを求めよ」という、とても面白い問題。そう言う問題も解けてしまうんだ。
けれど1つ前で「簡単、簡単♪」何て言っていた割にはすぐに挫折。眠い頭ではどうしても分からなかったのです。
解答を見た。
けれど1つ前で「簡単、簡単♪」何て言っていた割にはすぐに挫折。眠い頭ではどうしても分からなかったのです。
解答を見た。
(define (subsets a)
(if (null? a)
(list ())
(let ((rest (subsets (cdr a))))
(append
rest
(map (lambda (x) (cons (car a) x))
rest)))))
ダメだ、見ても意味が分からない。
ただ、これをそのまま実行しても次のような変な値が返ってくる。
ただ、これをそのまま実行しても次のような変な値が返ってくる。
gosh> (subsets '(1 2 3)) gosh> ((#0=(#1=(()) #2=((3))) #3=((2 . #1#) (2 . #2#))) ((1 . #0#) (1 . #3#)))
これはどうしたらいいだろうとググってみたら、このページで(display)を使うと良いと書いてあった。
gosh> (display (subsets '(1 2 3))) gosh> (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))#<undef>
ほんとだ。でも、何でだろうか。
上で紹介したページhttp://sicp.naochan.com/でもSICPを読み進めていて、しかも１つ１つ丁寧に、だいぶん進んでいる。追いつくことは無理だけど、僕も最後まで頑張ろう。
2.33
(define (my_map p sequence) (accumulate (lambda (x y) (cons (p x) y)) () sequence))
(define (my_append seq1 seq2) (accumulate cons seq2 seq1))
(define (my_length sequence) (accumulate (lambda (x y) (+ y 1)) 0 sequence))
部品の積み重ねが作業効率を向上させる、というのは本当だ（そのぶん細部のアルゴリズムは隠されて分からなくなってしまうけど）。
最後のlengthだけは、最初(lambda (x y) (+ x 1))としていて手こずった。xをインクリメントする方法だと、並びの最初の要素が+1された値が返るだけだったので。
そうしないといけないというのはaccumulateの内部構造を分かってないといけないから、抽象化という視点ではどうなんだろう。
最後のlengthだけは、最初(lambda (x y) (+ x 1))としていて手こずった。xをインクリメントする方法だと、並びの最初の要素が+1された値が返るだけだったので。
そうしないといけないというのはaccumulateの内部構造を分かってないといけないから、抽象化という視点ではどうなんだろう。
2.34
Hornerの公式をここでのConventional Interfaceで実装してみよう、という問題。
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms)
(+ (* this-coeff x) higher-terms))
0
coefficient-sequence))
解答を見てしまった・・・。
どうもaccumulate手続きによって渡される2引数（特に2つ目）の意味が分かっていないなあ。accumulate手続きの定義を見ると、2つ目の引数は"(accumulate op initial (cdr sequence))"とあるから、並びの残りの要素に対してaccumulate手続きを評価した結果をかえすわけか。
(2007/7/30)上山さんからTYPOの指摘。lambdaの中の引数の使い方が間違っていて、正しくは
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms)
(+ (* higher-terms x) this-coeff))
0
coefficient-sequence))
でした。ありがとうございます。→上山さん
2.35
すでに木構造をイテレートする手続きenumerate-treeを持っているので、簡単だった。
(define (count-leaves t)
(accumulate + 0
(map (lambda (x) 1)
(enumerate-tree t))))
Just it!
2.36
そうかー、(map car seqs)と(map cdr seqs)を使うのか。確かに「並び」の「並び」から同じ位置にある値を取り出せる。
きっと行列演算に使い回しが効きそうな予感。目からウロコの表現だった。
きっと行列演算に使い回しが効きそうな予感。目からウロコの表現だった。
(define (accumulate-n op init seqs)
(if (null? (car seqs))
()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
2.37
tranpose以外は写経。行列は苦手だったんで・・・。ていうか、相変わらず苦手なのにもがっくり。
(define (matrix-*-vector m v) (map (lambda (x) (dot-product v x)) m))
(define (transpose mat) (accumulate-n cons () mat))
(define (mat-*-mat m n) (let ((cols (transpose n))) (map (lambda (x) (map (lambda (y) (dot-product x y)) cols)) m)))
2.38
(fold-right / 1 (list 1 2 3)) → 3/2 (fold-left / 1 (list 1 2 3)) → 1/6 (fold-right list () (list 1 2 3)) → (1 (2 (3 ()))) (fold-left list () (list 1 2 3)) → (((() 1) 2) 3) (fold-right cons () (list 1 2 3)) → (1 2 3) (fold-left cons () (list 1 2 3)) → (((() . 1) . 2) . 3)
これは(op a b)と(op b a)が同じ値を返せば、fold-left/rightに関係なく同じ値を返す。
(2007/7/30)こちらも上山さんからの指摘。上記の交換則だけでなく、結合則も満たしていないといけないとのこと。割り算や引き算は交換則・結合則共に満たしていないから駄目なんですね。
色々とご指摘ありがとうございました。
色々とご指摘ありがとうございました。
2.39
はい、また間が空いてしまいました。いかんよ。
(define (reverse-left seq) (fold-left (lambda (x y) (cons y x)) '() seq))
(define (reverse-right seq) (fold-right (lambda (x y) (append y (list x))) '() seq))
上記の問題はguileで解いています。なのでリストの作り方がGaucheと違うことに注意。
appendは以前の演習問題でも解いたけれど、これは組込みの手続きなので自由に使ってもよい。とはいえ、ついつい存在を忘れてしまうんだよなあ。
今後かなり使うことになると思うから、今この場で覚えてしまおう。
appendは以前の演習問題でも解いたけれど、これは組込みの手続きなので自由に使ってもよい。とはいえ、ついつい存在を忘れてしまうんだよなあ。
今後かなり使うことになると思うから、今この場で覚えてしまおう。
2.40
(define (unique-pairs n) (flatmap (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))))
unique-pairsの方は71ページの中である対の作り方を（ほぼ）そのまま使えば良くて、あとは既存のprime-sum-pairs手続きに組み合わせるだけ。
簡単なんだけれど、風邪を引いていたため以前の更新(2007/2/28)から間が空いてしまい、何だか手こずった。
2.41
「与えられた整数nに対し、nより小さいか等しい相異なる正の整数i,j,kの順序付けられた3つの組で、和が与えられた整数sになるものを全て見つけよ」という問題。見るからに手応えがありそう。
まず、この手続きは「組を制限づける整数n」と「抽出条件s」の２つの引数を持つことが分かる。そして、
- nより小さいか等しい相異なる正の整数i,j,kの順序付けられた3つの組の並びを作る
- 和がsにならない物を除外する
という2つの手続きを作り組み合わせることが必要そうだ。
1の手続きを考える前に、2の方が簡単そうなので先に定義しておく：
(define (remove-diff-sum s seq) (filter (lambda (x) (= s (accumulate + 0 x))) seq))
gosh> (remove-diff-sum 5 '((1 2) (1 2 3) (2 3))) ((2 3))
さて1をどうするか。ユニークなペアを作る手続きunique-pairsは問題2.40で作ったので、それを応用すればいいかなと作ってみたのが以下の手続き。
(define (unique-triples n)
(filter (lambda (x) (not (null? x)))
(flatmap (lambda (k)
(map (lambda (j)
(map (lambda (i) (list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- k 1))))
(enumerate-interval 1 n))))
ところがこれを実行したら、
gosh> (unique-triples 4) (((1 2 3)) ((1 2 4)) ((1 3 4) (2 3 4)))
というように木の中に要素が入ってしまった。ここから更に数え上げるフィルタを付けてあげれば良いのかもしれないけれど、きっともっと良い解法があるんだろうなぁ・・・と思って解答を見てしまった。
そうしたら、unique-pairsで作った並びにもう1つの値をconsしているという、単純な仕組みだった。
(define (unique-triples n)
(flatmap (lambda (i)
(map (lambda (jk) (cons i jk))
(unique-pairs (- i 1))))
(enumerate-interval 1 n)))
ポイントは、iがenumerate-intervalで作られた数値であるのに対して、jkはunique-pairsで作られた並びであること。だからijと記しているし、consを使っているわけだ。
さいごはこれを組み合わせるだけ。
(define (s-sum-triples n s) (remove-diff-sum s (unique-triples n)))
gosh> (s-sum-triples 10 15) ((6 5 4) (7 5 3) (7 6 2) (8 4 3) (8 5 2) (8 6 1) (9 4 2) (9 5 1) (10 3 2) (10 4 1))
できた！
2.42
アルゴリズムと言えば有名な「エイトクイーンパズル」。この問題、そういえば大学のC言語の授業でやったなあ。1年生のときだったから、考えてみれば12年前か。
そんなに経つのか。懐かしいなあ。
そんなに経つのか。懐かしいなあ。
で、そんな懐かしい問題を解けずに解答を見てしまう自分。情けない・・・Cならできるんだけれど、まだSchemeに慣れていないということか。
(define (queen board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (pos) (safe? k pos)) (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 empty-board ()) (define (adjoin-position new-row k rest-of-queens) (cons new-row rest-of-queens)) (define (safe? k pos) (define (safe1 x n) (or (= n k) (let ((y (list-ref pos n))) (and (not (= x y)) (not (= (- x y) n)) (not (= (- y x) n)) (safe1 x (+ n 1)))))) (safe1 (car pos) 1))
safe?に出てくる手続き(list-ref list id)は、渡されたリストのid番目の項目を返す手続き。初出だけれど、配列みたく使えるようになるので覚えておこう。
自分で作ったmy-list-refも載せておく。
自分で作ったmy-list-refも載せておく。
(define (my-list-ref seq n)
(if (= n 0)
(car seq)
(my-list-ref (cdr seq) (- n 1))))
2.43
省略。2.42のロジックも出来ていないのに解けないよ。
