問題解答

問2.69

(define (successive-merge  trees)
  (if (= (length trees) 1)
      trees
      (letrec* ((l (length trees))
                (carTrees (take trees (- l 2)))
                (cdrTrees (drop trees (- l 2)))
                (leaf (make-code-tree (car cdrTrees) (cadr cdrTrees)))
               (successive-merge (adjoin-set leaf carTrees))
               )
      ))

(define (generate-huffman-tree pairs)
  (successive-merge (make-leaf-set pairs)))

(define pairs (list (list 'A 2)
                    (list 'B 2)
                    (list 'C 1)
                    (list 'D 1)))
(define hTree (generate-huffman-tree pairs))
(define code (encode '(A D A B B C A) hTree))
(decode code hTree)

Lisp への信心が足りなさすぎて、処理をコードに落とすところでものすごく時間がかかっちゃいます。

細かい処理で時間をとられがちなので、letrec* とか take とか drop とか、SICP では言及されてないけど存在する便利機能も今後はある程度調べて使っていこうかと思います。

ちなみに解答例は違うアプローチ。

(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))))))

ソートして、頭から繋げていくのか。たしかにこっちの方が自然ですよね、、、、

一日空いてしまったので復習から。

問題解答

問2.68

(define (encode-symbol symbol tree)
  (define (it symbol tree code)
    (cond ((null? symbol) '())
          ((leaf? tree) code)
          ((element-of-set? symbol (symbols (left-branch tree)))
           (it symbol (left-branch tree) (append code '(0))))
          ((element-of-set? symbol (symbols (right-branch tree)))
           (it symbol (right-branch tree) (append code '(1))))
          (else (error "bad symbol" symbol))))

  (it symbol tree '()))

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

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

答えはでたけど何かコードが汚い。

本文

2.3.4 例:Huffman 符号木

このあたりは昔も勉強して一通り押さえている内容なので、コードは把握しつつザクザク進める。

問2.67 は単なる動作確認。今日は問2.68　のコードを入力するまでで終了。

問題解答

問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 (adjoint-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))

(define (union-set set1 set2)
  (if (null? set1)
      set2
      (adjoint-set (car set1) (union-set (cdr set1) set2))))

(define s1 (list 1 2 3 4))
(define s2 (list 3 4 5 6))

(union-set s1 s2)

問2.60
adjoin-set を変更するだけで対応できる

(define (adjoint-set x set)
  (cons x set))

重複しているアイテムを全て処理しなければいけないので CPU 時間もメモリも負荷は増える。
ただ、オーダー的には一緒。

本文

順序づけられたリストとしての集合

集合の要素をソートした状態で格納した場合の計算量への影響

問2.61,2.62 は手の運動なのでパス。

二進木としての集合、集合と情報検索
このあたりは一通り把握している内容なので問題の中身はきちんと確認しつつ飛ばす。

問題解答

問2.57

(define (augend s)
	(if (null? (cdddr s))
      (caddr s)
      (cons '+ (cddr s))))

(define (multiplicand p)
  (if (null? (cdddr p))
      (caddr p)
      (cons '* (cddr p))))

問 2.58
a:以下のような感じで構成子や選択子を定義していく

(define v (list 1 '+ 2))

(define (addend s) (car s))
(define (augend s) (caddr s))
(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))

b:そのまま解くのは大変そう?一度前置記法に変換する処理を入れるのがいいかも。
→答えを見るとその通りっぽい。コンパイラを書いていた。

本文

2.3.3 例:集合の表現
集合の定義・演算について議論。

問題解答

問2.56

(define (make-exponentiation base exp)
  (cond ((= exp 0) 1)
        ((= exp 1) base)
        (else (list '** base exp))))

(define (exponentiation? x)
  (if (eq? (car x) '**) #t #f))

(define (base x)
  (cadr x))

(define (exponent x)
  (caddr x))

(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) (make-sum (exponent exp) -1)))
          (deriv (base exp) var)))
        (else
         (error "unknown expression type -- DERIV" exp))))


(deriv '(** x 2) 'x)
(deriv '(** x 3) 'x)

問題だけ見るとなんじゃこりゃこんなの解けないよ?って思うんですが、ヒントを元にやってみると簡単で驚きます。こんな簡単な方法で記号微分って表現できるんですね。すごい。

問題解答

問2.54

(define (equal? a b)
  (cond
   ((and (eq? a ()) (eq? b ())) #t)
   ((eq? (car a) (car b)) (equal? (cdr a) (cdr b)))
   (else #f)))

(equal? '(this is a list) '(this is a list))
(equal? '(this is a list) '(this (is a) list))

問2.55
” で quote として解釈されるため。

→不正解。

”abracadabra は (quote (quote abracadabra)) と等価。

本文

2.3.2 記号微分
ここはちょっと感動。ものすごく簡単なルールと実装で記号微分が実現できている。

今日は本のコードを写経して動作確認しておわり。

本文

頑健な設計のための言語レベル

成層設計の考え方を用いることでプログラムを構成するレベル毎に適した抽象手段を持つことができる。

問2.52 は手の運動なのでパス。

2.3 記号データ
シングルクォートをクォートするオブジェクトの前に置くことで、リストや記号を評価される式としてではなくデータオブジェクトとして扱うことができる

gosh> (define a '(1 2 3))
a
gosh> a
(1 2 3)
gosh> (define s1 'apple)
s1
gosh> s1
apple
gosh> (define s2 "apple")
s2
gosh> s2
"apple"
gosh> (define s 'apple)
s
gosh> s
apple

問題解答

問2.53

gosh> (list 'a 'b 'c)
(a b c)
gosh> (list (list 'george))
((george))
gosh> (cdr '((x1 x2) (y1 y2)))
((y1 y2))
gosh> (cadr '((x1 x2) (y1 y2)))
(y1 y2)
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)