SICP 問題 2.68（語頭符号の符号化処理）

Scheme SICP

なんでうまくいかねーのかさっぱりわからねぇ。。
（※2010/08/24追記：アホだった。。エラー情報をよく見れ！！）

問題

encode 手続は引数として通信文と木をとり、符号化された通信文のビットのリストを作る。

(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
	      (encode (cdr message) tree))))

encode-symbol は自分で書く手続きで、与えられた木に従って与えられた記号を符号化ビットのリストを返すものである。encode-symbol の設計では、記号が木になければ、エラーとしなければならない。出来た手続きを問題 2.67 で得た結果と、例題の木を使って符号化し、元の例題の通信文と同じかどうかをみてテストせよ。

解答

符号化についてだ。

(define (encode-symbol symbol tree)

  (define (element-of-tree? symbol tree)
    (pair? (memq symbol (symbols tree))))

  (let loop ((branch tree) ;枝
	     (ans '()))    ;ビット並び
    (if (leaf? branch) ;葉だった場合は累積してきたビットデータを返却
	(reverse ans)
	((let ((left (left-branch branch))
	       (right (right-branch branch)))
	   (cond (;左側の枝に存在する場合は左側の枝で再帰処理。
		  (element-of-tree? symbol left)
		  (loop left (cons 0 ans)))
		 (;右側の枝に存在する場合は右側の枝で再帰処理。
		  (element-of-tree? symbol right)
		  (loop right (cons 1 ans)))))))))

このコードで、前エントリで使用したsample-treeなんかを使うとこんな出力になる。。なんで？



gosh> (encode-symbol 'A sample-tree)




    
ERROR: invalid application: ( (0))

    
Stack Trace:

_______________________________________

gosh> (encode-symbol 'B sample-tree)






    
ERROR: invalid application: ( (1 0))

    
Stack Trace:

_______________________________________

  0  (loop right (cons 1 ans))

        At line 229 of "(stdin)"

gosh> (encode-symbol 'C sample-tree)






    
ERROR: invalid application: ( (1 1 1))

    
Stack Trace:

_______________________________________

  0  (loop right (cons 1 ans))

        At line 229 of "(stdin)"

  1  (loop right (cons 1 ans))

        At line 229 of "(stdin)"

gosh> (encode-symbol 'D sample-tree)






    
ERROR: invalid application: ( (1 1 0))

    
Stack Trace:

_______________________________________

  0  (loop right (cons 1 ans))

        At line 229 of "(stdin)"

  1  (loop right (cons 1 ans))

        At line 229 of "(stdin)"

gosh>
マジわかんねっす！！誰か教えて！！

※2010/08/24追記：

アホすぎました。↓こいつが原因です。

(define (encode-symbol symbol tree)

  (define (element-of-tree? symbol tree)
    (pair? (memq symbol (symbols tree))))

  (let loop ((branch tree)
	     (ans '()))
    (if (leaf? branch)
	(reverse ans)
	;((let ((left (left-branch branch)) ←let の外側のカッコが２重になってる！！
        (let ((left (left-branch branch)   ;←なので１重に修正。
	      (right (right-branch branch)))
	  (cond ((element-of-tree? symbol left)
		 (loop left (cons 0 ans)))
		((element-of-tree? symbol right)
		 ;(loop right (cons 1 ans))))))))) ←閉じカッコが多いので、
		 (loop right (cons 1 ans))))))))  ;←１つ減らす。

これで改めて・・・



gosh> (encode-symbol 'A sample-tree)

(0)

gosh> (encode-symbol 'B sample-tree)

(1 0)

gosh> (encode-symbol 'C sample-tree)

(1 1 1)

gosh> (encode-symbol 'D sample-tree)

(1 1 0)

gosh> (encode-symbol 'E sample-tree)

#

gosh> (encode '(A D A B B C A) sample-tree)

(0 1 1 0 0 1 0 1 0 1 1 1 0)

gosh>
できてんじゃ〜ん。。なんつー時間のムダを。。