「第2章 データによる抽象の構築」で提示されている問題を解いています。
目次
問題
2.44
「〜up-splitを定義せよ。belowとbesideの働きを切り替える他は、right-splitと同様である」という設問だけれど、どういう意味か、というところで悩んだ。
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
painterの上に小さくしたpainterを重ねるから、こうなるわけだ。
うーん、このへんの問題をグラフィック環境があるところで取り組みたいんだけれど、うちのMacだとSlibインストールは成功していても、画面に何も表示されない。何でダメなんだろう？
2.45
これは2.44を少し変えるだけ。手続きを返すからlambdaで始まって、その引数はright/up-splitと同じ。ポイントはsplitが受け取る２引数はどちらも手続きであること。画像ではなく、画像を描く処理なので要注意。
(define (split op1 op2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split op1 op2) painter (- n 1))))
(op1 painter (op2 smaller smaller))))))
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 v1 v2) (let ((x1 (xcor-vect v1)) (y1 (ycor-vect v1)) (x2 (xcor-vect v2)) (y2 (ycor-vect v2))) (cons (+ x1 x2) (+ y1 y2)))) (define (sub-vect v1 v2) (let ((x1 (xcor-vect v1)) (y1 (ycor-vect v1)) (x2 (xcor-vect v2)) (y2 (ycor-vect v2))) (cons (- x1 x2) (- y1 y2)))) (define (scale-vect s v) (let ((x (xcor-vect v)) (y (ycor-vect v))) (cons (* s x) (* s y))))
これはヒネリなしでOK。
2.47
問題に出てくる「構成子」と「選択子」の意味が分からなくなっていたので再確認。
| 構成子 | （抽象化した）データ構造 |
| 選択子 | 構成子から特定のデータを取り出すアクセッサ |
なので、ここもヒネリなしでそのまま実装。ただし手続きの名前だけは解答を参考にした。
(define (make-frame-l o e1 e2) (list o e1 e2)) (define (make-frame-c o e1 e2) (cons o (cons e1 e2)))
(define (origin-frame-l f) (car f)) (define (edge1-frame-l f) (cadr f)) (define (edge2-frame-l f) (caddr f))
(define (origin-frame-c f) (car f)) (define (edge1-frame-c f) (cadr f)) (define (edge2-frame-c f) (cddr f))
2.48
(define (make-segment s e) (cons s e)) (define (start-segment seg) (car seg)) (define (end-segment seg) (cdr seg))
2.49
省略。何で画像が表示できないんだ・・・。
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 0.0 0.0) (make-vect -1.0 0.0) (make-vect 0.0 -1.0)))
(define (rotate270 painter) (transform-painter painter (make-vect 0.0 0.0) (make-vect 0.0 -1.0) (make-vect 1.0 0.0)))
と単純に作ってみたけれど、rotateXはテキストに載っているrotate90の繰り返しでも定義できるので、使い回した方が良いと思う。
(define (rotate180 painter) (rotate90 (rotate90 painter)))
のようにね。
2.51
(define (below p1 p2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-lower
(transform-painter p1
split-point
(make-vect 0.0 1.0)
(make-vect 1.0 0.5)))
(paint-upper
(transform-painter p2
(make-vect 0.0 0.0)
split-point
(make-vect 1.0 0.0))))
(lambda (frame)
(paint-upper frame)
(paint-lower frame)))))
と、
(define (below-2 p1 p2)
(transform-painter (flip-vert
(rotate270 (beside p1 p2)))
(make-vect 0.0 0.0)
(make-vect 0.0 1.0)
(make-vect 1.0 0.0)))
の２種類。特に注記することはないかな。
ただ、Schemeなどの関数型言語を勉強していて思うんだけど、リソースの節約や処理の簡約化はあまり意識されていないっぽい。
無限のリソースがあるかのように話が進んでいくので、不思議だ。
無限のリソースがあるかのように話が進んでいくので、不思議だ。
2.52
すみません、これも省略。
だって画像が実際に表示されないからつまんないし。
だって画像が実際に表示されないからつまんないし。
2.53
gosh> (list 'a 'b 'c) (a b c) gosh> (list (list 'george)) ((george)) gosh> (cadr '((x1 x2) (y1 y2))) ((y1 y2)) gosh> (cadr '((x1 x2) (y1 y2))) (y1 y2) ← かっこが1つ取れている gosh> (pair? (car '(a short list))) #f gosh> (memq 'red '((red shoes) (blue socks))) #f gosh> (memq 'red '(red shoes blue socks)) (red shoes blue socks) gosh> (list ' a) ← 1個離れていてもOKみたい (a)
2.54
うぅぅ、久しぶりに再開したので色々と忘れている・・・。Gaucheだと真偽が#t/#fで、ヌルが()。
(define (equal? a b)
(cond ((and (null? a) (null? b)) #t)
((not (eq? (car a) (car b))) #f)
(else (equal? (cdr a) (cdr b)))))
とりあえずはこれで問題文を満たしている。けれど、資料の備考欄には「equal?は数値を含むリストを比較する場合にも使う」とあるから、これじゃだめだ。
リストかどうかを調べるのはpair?手続きだったから、
リストかどうかを調べるのはpair?手続きだったから、
(define (equal? a b)
(cond ((and (not (pair? a)) (not (pair? b))) (eq? a b))
((and (null? a) (null? b)) #t)
((not (eq? (car a) (car b))) #f)
(else (equal? (cdr a) (cdr b)))))
とすればいいのか。でも何だか汚いな。まずヌルかどうかの判定はcondの最初の条件で行えているから不要になるし。
(define (equal? a b)
(cond ((and (not (pair? a)) (not (pair? b))) (eq? a b))
((not (eq? (car a) (car b))) #f)
(else (equal? (cdr a) (cdr b)))))
2.55
(car ''abracadabra)
と入力すると、なぜ「quote」が返ってくるか、という問題。これは簡単で、
(cdr ''abracadabra) -> 'abracadabra
となるし、そもそも省略表記ではない書き方をすると
(car (quote (quote abracadabra)))
となるため、carで左値を取得すれば「'」、すなわちquoteが返ってくるため
2.56
微分プログラムを拡張する第１歩として、u^xなど指数関数の微分を可能にするような手続きをderivに追加しろ、という問題。
他の流儀に従うならば、
他の流儀に従うならば、
- 式から基数(っていうんだっけ？)を返す手続きbase
- 式から指数を返す手続きexponent
- (** u x)という指数の式表記かどうかを返すexponentiation?
- 指数の式を作成するmake-exponentiation
を作らなければいけない。あと、Gaucheでは指数を求める手続きもないみたいだから，それも作らないとね。
(define (exponentiation? x)
(and (pair? x) (eq? (car x) '**)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation a1 a2)
(cond ((=number? a2 0) 1)
((=number? a2 1) a1)
((and (number? a1) (number? a2)) (in-exp a1 a2))
(else (list '** a1 a2))))
(define (in-exp x y)
(define (in n)
(if (= n 0)
1
(* x (in (- n 1)))))
(in y))
まずはここまで。次にこれをderiv手続きの中に組み込まなければいけない。
- と思ったけれど、in-expはもっと簡単に書けることに気づいたよ。上の形式で書くならば、状態を持つ引数も一緒に渡して、末尾再帰が有効になるよう書かないと。
(define (in-exp x y)
(if (= y 0)
1
(* x (su x (- y 1)))))
そして、これらをp86で定義されているderiv手続きの中に埋め込んであげる（だけ）。
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
* ((exponentiation? exp)
* (make-product
* (make-product (exponent exp)
* (make-exponentiation (base exp)
* (- (exponent exp) 1)))
* (deriv (base exp) var)))
(else
(error "unknown expression type -- DERIV" exp))))
そうすると、
gosh> (deriv '(+ (** x 3) (+ (** x 2) (+ x 1))) 'x)
(+ (* (* 3 (** x 2)) 1) (+ (* (* 2 x) 1) 1))
gosh>
というように微分してくれるようになるわけで。ちなみに追加したのは文頭に「*」がついた部分です。
フレームワークがあって、その中に適切に埋め込みさえすれば動く仕組みっていうのは素晴らしいなあ。
2.57
式をaugendの中で評価・展開していって・・・と考えてみたけれど、どうにも煮詰まってしまったので解答を見てしまった。
(define (augend s) (if (null? (cdddr s)) (caddr s) (cons '+ (cddr s))))
(define (multiplicand p) (if (null? (cdddr p)) (caddr p) (cons '* (cddr p))))
そうか、別にaugendやmultiplicandの中で式を完成させなくても、とりあえず次の式を作っていけば良いのか。テクニックとしては再帰なんだけど（実際deriv手続きでは再帰を使用しているし）、その枝葉では再帰をしなくてもいいんだね。
大きなプログラムをSchemeで書くことになった場合、誰が再帰を行うか、とかいう役割の決定は結構問題になりそうだ。
（deriv手続きをちゃんと読んでいないのがバレバレ・・・）
（deriv手続きをちゃんと読んでいないのがバレバレ・・・）
2.58
まず、a.の中置記法（ただし完全なカッコ付き）を実現するにはどうしたらいいかを解く問題。これは式を見る・作るときの順序を変更するだけで良いので、選択子（アクセッサのことだね）を変更すればいい。
(define (sum? x) (and (pair? x) (eq? (cadr x) '+))) (define (addend s) (car s)) (define (augend s) (caddr s)) (define (product? e) (and (pair? e) (eq? (cadr e) '*))) (define (multiplier e) (car e)) (define (multiplicand e) (caddr e)) (define (exponentiation? x) (and (pair? x) (eq? (cadr x) '**))) (define (base e) (car e)) (define (exponent e) (caddr e))
(define (make-product m1 m2) (cond ((=number? m1 0) 0) ((=number? m2 0) 0) ((=number? m1 1) m2) ((=number? m2 1) m1) ((and (number? m1) (number? m2)) (* m1 m2)) (else (list m1 '* m2)))) (define (make-sum a1 a2) (cond ((=number? a1 0) a2) ((=number? a2 0) a1) ((and (number? a1) (number? a2)) (+ a1 a2)) (else (list a1 '+ a2)))) (define (make-exponentiation a1 a2) (cond ((=number? a2 0) 1) ((=number? a2 1) a1) ((and (number? a1) (number? a2)) (in-exp a1 a2)) (else (list a1 '** a2))))
それぞれの順番を変えただけ。
さあ、bの「演算子の優先度を考慮した微分手続きが実現できるか」という問題ですが・・・僕には出来ません。解答を読みました。
ふーん、フィルタプログラム（コンパイラ）を作って、元の式をa.で作った手続きでも扱える式にすると書いてあったよ。つまり
- 実現する手続きをそのまま構成する、と言うのはあまり現実的ではない（複雑になってしまう）。
- フィルタによって適切な形式に変換し、既存手続きでも使用できるようなアプローチを採る
ことがポイントなんだな。一応、自学のためにコピペしておきます。
(define (compile exp)
(cond ((symbol? exp) exp)
((number? exp) exp)
((eq? (car exp) '+) exp)
((eq? (car exp) '*) exp)
((= (length exp) 3)
(list (cadr exp) (compile (car exp)) (compile (caddr exp))))
((> (length exp) 4)
(cond ((eq? (cadr exp) (cadddr exp))
(compile (cons (list (cadr exp) (compile (car exp))
(compile (caddr exp)))
(cdddr exp))))
((and (eq? (cadr exp) '+) (eq? (cadddr exp) '*))
(let ((a (car exp)) (b (cadr exp)) (c (caddr exp))
(d (cadddr exp)) (e (list-ref exp 4))
(f (list-tail exp 5)))
(compile (cons a (cons b (cons
(list d (compile c) (compile e)) f))))))))))
2.59
ここからしばらくはデータ構造に対する演算や構成の話。まずはランダム値（重複無し）からなるリスト集合を取り扱う。
(define (element-of-set? x set)
(cond ((null? set) #f)
((equal? x (car set)) #t)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(if (element-of-set? x set)
set
(cons x set)))
(define (intersection-set s1 s2)
(cond ((or (null? s1) (null? s2)) '())
((element-of-set? (car s1) s2)
(cons (car s1)
(intersection-set (cdr s1) s2)))
(else (intersection-set (cdr s1) s2))))
と、ここまでは説明したので後は和集合(union-set)を作ってね、という問題。
(define (union-set s1 s2)
(cond ((null? s1) s2)
((null? s2) s1)
((element-of-set? (car s1) s2)
(union-set (cdr s1) s2))
(else
(cons (car s2) (union-set (cdr s2) s1)))))
ポイントは特にないけれど、5行目で(car s1)を無視して次に進んでいるのは、最終的に((null? s1) s2)でカバーできているから。一応解答を見てみると((null? s2) s1)すら書かないでいるけれど、効率を考えたら書いた方が良いと思う。
2.60
2.59までで作成した演算４つを、重複が有るリストに対する手続きとして再定義せよ、という問題。
これ、まずは重複があったときの結果がどうあるべきかについて考えないといけないと思う。重複は完全に許されるわけだから、
これ、まずは重複があったときの結果がどうあるべきかについて考えないといけないと思う。重複は完全に許されるわけだから、
- 要素かどうか？：1個でも含まれていれば#t
- 和集合：2つの集合を1つにまとめただけ
- 積集合：同じ要素が1つでも含まれていれば条件を満たすと考える
- 要素の追加：そのまま追加するだけ
という解釈とした。で、こうなった。
(define (element-of-set? x set)
(cond ((null? set) #f)
((equal? x (car set)) #t)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(cons x set))
(define (intersection-set s1 s2)
(cond ((or (null? s1) (null? s2)) '())
((element-of-set? (car s1) s2)
(cons (car s1)
(intersection-set (cdr s1) s2)))
(else (intersection-set (cdr s1) s2))))
(define (union-set s1 s2)
(append s1 s2))
変化したのはunion-setとadjoin-setの2つだけ。
けれどその効果はかなりあり、Θ(n^2)だったunion-setがΘ(1)で済むし、同様にadjoin-setもΘ(n)からΘ(1)になっているので相当の高速化はできそうだ。
けれどその効果はかなりあり、Θ(n^2)だったunion-setがΘ(1)で済むし、同様にadjoin-setもΘ(n)からΘ(1)になっているので相当の高速化はできそうだ。
とはいえ、これが必要な場面といってもコレといったものが思いつきません。こういうデータ構造があったときの操作、として逆の方向から覚えておこう。
2.61
今度は順序付けられた（＝ソートされた）データ構造に対する演算を考える。まず、element-of-set?とintersection-setの2つは本書に書かれていて、このテクニックをもとにadjoin-setをランダムデータの半分のステップ数（もちろん、平均）で作ってみよう、という問題。
ただ、元となる手続きは
(define (adjoin-set x set)
(if (element-of-set? x set)
set
(cons x set)))
ということで。これじゃ何もしなくてもelement-of-set?が半分にステップ数を削減してくれている・・・けれど、ちゃんと作らないと駄目なんだろうなぁ。
と思ったら、駄目だ駄目だ。上は間違い。
adjoin-setでできあがるリストも、元のルール：「順序付けられたリスト」を満たさないといけないんだ。
なので、作り直し。リストの途中に値を挿入する、という操作が再帰においてどういうように表現すれば良いか、という点で苦労した。
adjoin-setでできあがるリストも、元のルール：「順序付けられたリスト」を満たさないといけないんだ。
なので、作り直し。リストの途中に値を挿入する、という操作が再帰においてどういうように表現すれば良いか、という点で苦労した。
(define (adjoin-set x set)
(cond ((null? set) (list x))
((= x (car set)) set)
((< x (car set)) (cons x set))
(else (cons (car set) (adjoin-set x (cdr set))))))
えーとつまり、挿入を実現するためには、再帰を行う時点でリストを作り上げながら（上の例ではconsで対にしながら）潜っていく、という表現になるわけだね。
これは、ちゃんとテクニックとして覚えておこう。
（以前の演習問題でも出てきたような気がするし・・・）
これは、ちゃんとテクニックとして覚えておこう。
（以前の演習問題でも出てきたような気がするし・・・）
「リストへの挿入を実現するには、リストを作り上げる表現の中で再帰を繰り返す」
だ。
2.62
で、順序付きリストの最後はunion-setをΘ(n)で実装すること。これは本書p.90にある手続きintersection-setの実装を真似ればよい。
(define (union-set s1 s2)
(cond ((null? s1) s2)
((null? s2) s1)
(else (let ((x1 (car s1)) (x2 (car s2)))
(cond ((= x1 x2)
(cons x1 (union-set (cdr s1) (cdr s2))))
((< x1 x2)
(cons x1 (union-set (cdr s1) s2)))
(else
(cons x2 (union-set s1 (cdr s2)))))))))
実際に実行してみて（本来なら先にテストプログラムを用意しておかないといけないな）、
gosh> (define v '(5 6 7))
v
gosh> (define w '(0 1 2 3 4 5))
w
gosh> (union-set v w)
(0 1 2 3 4 5 6 7)
となり、OK!
2.63
ツリーをリストに変換する2種類の手続きについて、
a.同じ結果となるか、それともツリーによっては異なる結果になるか
b.必要なステップ数の増加度合いは同じか、異なるか
b.必要なステップ数の増加度合いは同じか、異なるか
を求める。まず、aは同じ。アルゴリズムを見る限り、左右の木を分解して2つに違いはないから（でもどうやって証明したらよいか分からない・・・）。とりあえず、前者は再帰的手続きで後者は反復的手続きではある。
次に増加度合いに関してはよく分からなかったので、実際にトレースを出力して試してみたら（方法はメモ（第2章）を参照）、tree->list-2の方がステップ数の増加度合いが鈍かった。つまりtree->list-1の方が変換に関しては非効率的だということのようだ。
（他の人の解答例を見ると、tree->list-1がΘ(n log n)、tree->list-2がΘ(n)であるとのこと）
次に増加度合いに関してはよく分からなかったので、実際にトレースを出力して試してみたら（方法はメモ（第2章）を参照）、tree->list-2の方がステップ数の増加度合いが鈍かった。つまりtree->list-1の方が変換に関しては非効率的だということのようだ。
（他の人の解答例を見ると、tree->list-1がΘ(n log n)、tree->list-2がΘ(n)であるとのこと）
これはなぜだろう？？
tree->list-2はresult-listを作りながら再帰を繰り返すから、いったん端までのリストが出来上がったら計算の必要が無いから？そしてtrree->list-1は再帰から戻ってくるときにappendが都度評価されるから、計算数が多くなってしまう、ということはいえると思う。でもBig O Notationで何故ああなるかは分からない・・・。
まあいいや。
まあいいや。
2.64
まず問題を解く前に思ったのが、このソースコードはとても面白いということ。
(define (list->tree elements) (car (partial-tree elements (length elements))))
(define (partial-tree elts n) (if (= n 0) (cons '() elts) (let ((left-size (quotient (- n 1) 2))) (let ((left-result (partial-tree elts left-size))) (let ((left-tree (car left-result)) (non-left-elts (cdr left-result)) (right-size (- n (+ left-size 1)))) (let ((this-entry (car non-left-elts)) (right-result (partial-tree (cdr non-left-elts) right-size))) (let ((right-tree (car right-result)) (remaining-elts (cdr right-result))) (cons (make-tree this-entry left-tree right-tree) remaining-elts))))))))
何が面白いって、let構文を続けて書くことで、手続き言語的に逐次処理を進めていること。まずleft-sizeを定めて、その次にleft-result、次はleft-tree/non-left-elts/right-size...というように、関数型言語では普段意識しない評価の順序を定めている。
ふーん、こういう方法もあるんだね。
ふーん、こういう方法もあるんだね。
さて、では問題を解こう。まずはa。この式がどのように動くかを簡潔・明快に書けとのこと。
再帰を考えずに１階層だけで考えると、与えられたリストから真ん中の値と左の木の最上段の値、右の木の最上段の値とでmake-treeして、残りのリストとconsして新しいリストを作っている。
この残りのリストというのは、再帰が深まったときにリスト左側から木が作られていくので、そのときの右の残り、ということになる。
この残りのリストというのは、再帰が深まったときにリスト左側から木が作られていくので、そのときの右の残り、ということになる。
(make->tree '(1 3 5 7 9))したときの結果は、
gosh> (list->tree '(1 3 5 7 9 11)) (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
だ。
次にb。この手続きのステップ増加度合いを答えよ、という問題。
う・・・。すみません、わかりません。解答を見てしまいました。
う・・・。すみません、わかりません。解答を見てしまいました。
| 最大で要素の数だけ partial-tree が再帰することになるのでΘ(n)。 |
とのことです。確かに、partial-treeは要素の数だけ呼ばれる処理になっている、ということをソースから納得して、ここは次に進もう。
2.65
ここは単純に考えて、
- 2つの木をそれぞれリストに戻す
- 和集合/積集合を求める
- 木に戻す
という方針で進めればいいかな。それぞれがΘ(n)ならΘ(3n)＝Θ(n)なわけだし。
Θ(n)で実装されている、tree->list2と問題2.62のunion-set、2.61直前に記されているintersection-setを使えばいい。
Θ(n)で実装されている、tree->list2と問題2.62のunion-set、2.61直前に記されているintersection-setを使えばいい。
(define (union-set-tree t1 t2) (list->tree (union-set (tree->list-2 t1) (tree->list-2 t2))))
(define (intersection-set-tree t1 t2) (list->tree (intersection-set (tree->list-2 t1) (tree->list-2 t2))))
ちょっとずるい気もするけれど、まあこれでいいでしょう。
gosh> (union-set-tree (list->tree '(1 2 3)) (list->tree '(1 2 4))) (2 (1 () ()) (3 () (4 () ()))) gosh> (intersection-set-tree (list->tree '(1 2 3)) (list->tree '(1 2 4))) (1 () (2 () ()))
2.66
2ヶ月ぶりくらいなので、だいぶ忘れてしまった。というわけで、次のHuffman符号化木に進むために解答を見てしまうことにする・・・。
(define (look-up given-key set-of-record)
(cond ((null? set-of-record) false)
((equal? given-key (key (car set-of-record)))
(car set-of-record))
((< (order given-key) (order (key (car set-of-record))))
(look-up given-key (cadr set-of-record)))
(else (look-up given-key (caddr set-of-record)))))
という手続きでOK,らしい（全然勉強になっていない）。ちなみにkey手続きは例文にも載っていないけれど、set-of-recordからキーの部分を取り出す手続きで、orderはキーを数値比較が出来るように変換する手続き。どちらもどんなデータ構造かを意識しないと実装できない選択子と構成子なので、ここでは触れていない。つまり、実行できない。
2.67
前の問題から1ヶ月経ってしまているけれど、ちゃんと続けていきます。
Huffman符号化木の、まずはサンプルコードを用いた実験。
Huffman符号化木の、まずはサンプルコードを用いた実験。
(define sample-tree
(make-code-tree (make-leaf 'A 4)
(make-code-tree
(make-leaf 'B 2)
(make-code-tree (make-leaf 'D 1)
(make-leaf 'C 1)))))
(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
としたときの、decode手続き（テキストに載っている）の結果を示せ、というだけの問題。入力して実行するだけなのですぐ済みます。
gosh> (decode sample-message sample-tree) (A D A B B C A)
となって、OK。
2.68
で、今度はdecodeではなくencode手続き。とはいえガワは出来ていて、
(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))
このencode-symbolを実装することが、ここでの問題になるわけで。encode-symbolは与えられた文字に対する符号（のリスト）を返す手続きで、えっと・・・すみません、解答を見てしまいました。ダメじゃん。
解答によると、
- まず指定した木に値が含まれているかどうかを返す手続きを定義
- できた手続きを使い、値を掘り下げながらリストを再帰的に作成
という順序で符号を作成していた。とりあえず方針だけは見たけれど細部は読んでいないので、せめてここからは自分で作ってみよう。
(define (value-in-set? x set)
(cond ((null? set) #f)
((eq? x (car set)) #t)
(else (value-in-set? x (cdr set)))))
(define (encode-symbol char tree)
(cond ((leaf? tree) '())
((value-in-set? char (symbols (left-branch tree)))
(cons 0 (encode-symbol char (left-branch tree))))
((value-in-set? char (symbols (right-branch tree)))
(cons 1 (encode-symbol char (right-branch tree))))
(else '())))
なんとか出来た。
gosh> (encode (decode sample-message sample-tree) sample-tree) (0 1 1 0 0 1 0 1 0 1 1 1 0) gosh> sample-message (0 1 1 0 0 1 0 1 0 1 1 1 0) gosh> (encode '(E) sample-tree) () gosh> (encode '(D) sample-tree) (1 1 0) gosh>
となって、無事に完了。
（実はcond式の括弧が少しずれていて、なかなか問題を解決できなかったのは内緒）
（実はcond式の括弧が少しずれていて、なかなか問題を解決できなかったのは内緒）
2.69
はい、ご無沙汰しております。どうしても解けなかったのでこの問題も回答を見てしまいました。
(define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs)))
ここでの問題は上のsuccessive-mergeを実装するわけで、p.96にある木が作成されるまでのステップを実装することに他ならない。
こういう問題、やっぱり手続き型言語で代入を駆使しつつトライ＆エラーしていくという方針が身体に刻まれているとむずかしいです。ステップ実行ができるGaucheデバッガのようなものの導入を本格的に考えた方がよいかもしれないなあ。
こういう問題、やっぱり手続き型言語で代入を駆使しつつトライ＆エラーしていくという方針が身体に刻まれているとむずかしいです。ステップ実行ができるGaucheデバッガのようなものの導入を本格的に考えた方がよいかもしれないなあ。
(define (successive-merge set)
(if (= (length set) 1) (car set)
(let ((sorted-set (sort set (lambda (x y) (< (weight x) (weight y))))))
(successive-merge
(cons (make-code-tree (car sorted-set) (cadr sorted-set))
(cddr sorted-set))))))
結局回答を見たわけだけど、これまであまり使ったことのない関数が出て来ている。length、sortなど。上で書いたデバッガもそうだけど、そろそろ生活の至るところでSchemeを登場させ、色々な語彙を増やしていかないとテキストに付いていけない気がしてきた。
うぅむ、危機感。
2.70
ここはさすがに実行するだけなので自分でやりましたよ。
(define old_rock_pairs '((A 2) (NA 16) (BOOM 1) (SHA 3)
(GET 2) (YIP 9) (JOB 2) (WAH 1)))
(define old_rock_tree (generate-huffman-tree old_rock_pairs))
(define old_rock '(GET A JOB SHA NA NA NA NA NA NA NA NA
GET A JOB SHA NA NA NA NA NA NA NA NA
WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP
SHA BOOM))
としておいて、下のように実行する。すると、
gosh> (encode old_rock old_rock_tree) (1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1)
となる。長さはlengthを使えばいいので（さっきの問題で使ったばっかりだもんね）、
gosh> (length (encode old_rock old_rock_tree)) 84
これにより符号化には84bitsが必要であることが分かった。各単語を1つの記号とし、3bits固定長の符号化を行った場合は、(length old_rock) => 36だから、36(単語)×3bits＝108bitsとなる。
つまり50年代のイカれた歌詞はHuffman符号化により資源を節約できる、というわけか。ん？ちょっと違うって？
2.71
グラフは省略。でも、
| n=5 | (generate-huffman-tree '( (a 1) (b 2) (c 4) (d 8) (e 16))) |
| n=10 | (generate-huffman-tree '( (a 1) (b 2) (c 4) (d 8) (e 16) (f 32) (g 64) (h 128) (i 256) (j 512)) |
で書ける。このような相対頻度が1,2,4,...,2^(n-1)のグラフは
- 最高頻度：1bit
- 最低頻度：n-1bit
となる。
2.72
ごめんなさい、省略です。
