emacs-2.3

符号

字符串和程序还是存在一些区别的,尤其是那些代码字符串。

(define a 1)

a a a是什么,在运算层面,我们说它是 1 1 1;在代码层面,我们说它是一个变量;但是文本怎么说的呢?

在程序里面直接的 a a a永远无法描述变量本身,因为代码里面的 a a a代表的是 1 1 1,"a"只是一个字符。

或者应该这样描述更加直观 a = 1 a=1 a=1,等式两边,我们一直描述的都能是右边,也就是值,不是 1 1 1就是"a"

但是我们其实想表达的是 a ( 1 ) a(1) a(1),它是这样一个值:它代表代码中的一个变量,也就是一个占位符。

大声的说出你的名字你的名字并不是四个字,也不是就是这四个字,它只是一种占位。

或者还可以这种理解,它就是代码字符,作为一种二阶的值,路由(计算)二次才是真正的值。

好比shell或者js中的eval方法,去获取某种值的真正的值。

(define (memq item x) 
  (cond ((null? x) false)
        ((eq item (car x)) (cdr x))
        (else (memq item (cdr x)))))
(memq 'apple '(pear banana prune)) ;; #f
(memq 'apple '(x (apple sause) y apple pear)) ;; (apple pear)

这里还能看出一个有意思的点:符号不仅可以索引到值,它本身也是一个值

  • 2.53
(list 'a 'b 'c) ;; (a b c)
(list (list 'george)) ;; ((genrge))
(cdr '((x1 x2) (y1 y2))) ;; ((y1 y2))
(cadr '((x1 x2) (y1 y2)));; (y1 y2)
(pair? (car '(a short list))) ;; #f
(memq 'red '((red shoes) (blue socks))) ;; #f
(memq 'red '(red shoes blue socks)) ;; (red shoes blue socks)
  • 2.54
(define (equal? x y)
  (if (and (pair? x) (pair? y))
      (and (equal? (car x) (car y)) (equal? (cdr x) (cdr y)))
      (eq? x y)))
  • 2.55
(cat '' abracadabra)

其中单引号的字符表示为quote,全部用字符表达,该等式为

(cat quote quote abracadabra)

有意思的时候来了,我们使用 ’(1 2 3) \text{'(1 2 3)} ’(1 2 3)来替换 (list 1 2 3) \text{(list 1 2 3)} (list 1 2 3),也就是使用字符串来指示运算,也就是一串可执行代码

也就是这个字符串的值是作为代码执行之后的结果,现在就多了这么一个特殊的值,他的值是作为代码执行之后产生的值。

从这一刻,值不再是单纯的值了,它可以是一个间接的量,它经由二次引导产生一个值。

是的,值不再单纯的是值,它可以是字面的值,而字面也是值的一种。

(display ''1) ;; '1

你看,既然字面作为一种值,而quote的字面是可以进行二次引导,如果引导出的结果仍然是可引导的字面值呢?

也就是说,我们可以不断的衍生这个引导的链条。

求导

∂ c ∂ x = 0 ∂ x ∂ x = 1 ∂ ( μ + v ) ∂ x = ∂ μ ∂ x + ∂ y ∂ x ∂ ( μ v ) ∂ x = μ ⋅ ∂ v ∂ x + v ⋅ ∂ μ ∂ x \begin{aligned} \frac{\partial c}{\partial x} &= 0 \\ \frac{\partial x}{\partial x} &= 1 \\ \frac{\partial {(\mu + v)}}{\partial x} &= \frac{\partial \mu}{\partial x} + \frac{\partial y}{\partial x} \\ \frac{\partial {(\mu v)}}{\partial x} &=\mu \cdot \frac{\partial v}{\partial x} + v \cdot \frac{\partial \mu}{\partial x} \end{aligned} ∂x∂c​∂x∂x​∂x∂(μ+v)​∂x∂(μv)​​=0=1=∂x∂μ​+∂x∂y​=μ⋅∂x∂v​+v⋅∂x∂μ​​

  • 谓词
(variable? e) ;; e是变量?
(same-variable? a b) ;; a和b是同一变量?
(sum? e) ;; e是和式?
(addend e) ;; e的被加数
(augend e) ;; e的加数
(make-sum a b) ;;构筑a和b的和式
(product? e) ;; e是乘式?
(multiplier? e) ;; e的被乘数
(multiplicand e) ;; e的乘数
(make-product a b) ;; 构筑a和b的乘式
(number? a) ;; 是否是数值
(define (deriv exp var)
  ;; c
  (cond ((number? exp) 0)
        ;; ax
        ((variable? exp) (if (same-variable? exp var) 1 0))
        ;; ax + bx
        ((sum? exp) (make-sum
                     (deriv (addend exp) var)
                     (deriv (augend exp) var)))
        ;; f(x)g(x)
        ((product? exp) (make-sum
                         (make-product (multiplier exp)
                                       (deriv (multiplicand exp) var))
                         (make-product (deriv (multiplier exp) var)
                                       (multiplicand exp))))
        (else (error "unknow expression type " exp))))
  • 表示
;; 是否是变量
(define (variable? e) (symbol? e))
;; 变量相等?
(define (same-variable? a b) (and (variable? a) (variable? b) (eq? a b)))
;; 和
(define (make-sum a b) (list '+ a b))
;; 乘
(define (make-product a b) (list '* a b))
;; 和式?
(define (sum? e) (and (pair? e) (eq? (car e) '+)))
;; 乘式
(define (product? e) (and (pair? e) (eq? (car e) '*)))
;; 被加
(define (addend e) (cadr e))
;; 被乘
(define (multiplier e) (cadr e))
;; 加数
(define (augend e) (caddr e))
;; 乘数
(define (multiplicand e) (caddr e))
(deriv '(+ x 3) 'x) ;; (+ 1 0)
  • 修改
(define (make-sum a b)
  ;; 其中一个为0,返回另一个
  (cond ((=number? a 0) b)
        ((=number? b 0) a)
        ;; 都是数字直接相加
        ((and (number? a)
              (number? b)) (+ a b))
        ;; 不可计算,直接拼接
        (else (list '+ a b))))

(define (=number? a b) 
  (and (number a) (= a b)))

(define (make-product a b)
  ;; 零乘任何数为0
  (cond ((or (=number? a 0) (=number? b 0)) 0)
        ;; 1乘任何数为任何数
        ((=number? a 1) b)
        ((=number? b 1) a)
        ;; 都是数据直接相乘
        ((and (number? a) (number? b)) (* a b))
        ;; 无法计算,直接拼接
        (else (list '* a b))))
  • 2.56

∂ μ n ∂ x = n μ ⋅ ∂ μ ∂ x \frac{\partial \mu^n}{\partial x} = n\mu\cdot\frac{\partial \mu}{\partial x} ∂x∂μn​=nμ⋅∂x∂μ​

;; 幂式
(define (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
;; 底数
(define (base e) (cadr e))
;; 幂次
(define (exponent e) (caddr e))
;; 构建
(define (make-exponentiation a b)
  (cond ((=number? b 0) 1)
        ((=number? b 1) a)
        (else (list '** a b))))


(define (deriv exp var)
  ;; c
  (cond ((number? exp) 0)
        ;; ax
        ((variable? exp) (if (same-variable? exp var) 1 0))
        ;; ax + bx
        ((sum? exp) (make-sum
                     (deriv (addend exp) var)
                     (deriv (augend exp) var)))
        ;; f(x)g(x)
        ((product? exp) (make-sum
                         (make-product (multiplier exp)
                                       (deriv (multiplicand exp) var))
                         (make-product (deriv (multiplier exp) var)
                                       (multiplicand exp))))
        ((exponentiation? exp)
         (let ((a (base exp))
               (b (exponent exp)))
           (make-product (make-product (- b 1) a)
                         (deriv a var))))
        (else (error "unknow expression type " exp))))
(deriv '(** x 5)) ;; (* 4 x)
  • 2.57
(define (combine x)
  (let ((mark (car x)))
    (define (combine-iter collect residue)
      (if (null? residue)
          collect
          (let ((a (car residue))
                (b (cdr residue)))
            ;; 如果是集合,并且符号相同
            (if (and (pair? a) (eq? mark (car a)))
                ;; 忽略符号,添加内容元素,然后继续添加后续元素
                (combine-iter (combine-iter collect (cdr a)) b)
                ;; 如果是基本元素,或者不匹配的序对,直接添加,并进行后续元素判断处理
                (combine-iter (cons a collect) b)))))
    ;; 拼接符号和其他元素
    (cons mark (combine-iter nil (cdr x)))))
(combine '(* (* a b) (+ c d) (* x y))) ;; (* y x (+ c d) b a)
  • 2.58

a)

;; 是否是变量
(define (variable? e) (symbol? e))
;; 变量相等?
(define (same-variable? a b) (and (variable? a) (variable? b) (eq? a b)))
;; 和
;(define (make-sum a b) (list a '+ b))
;; 乘
;(define (make-product a b) (list a '* b))
;; 和式?
(define (sum? e) (and (pair? e) (eq? (cadr e) '+)))
;; 乘式
(define (product? e) (and (pair? e) (eq? (cadr e) '*)))
;; 被加
(define (addend e) (car e))
;; 被乘
(define (multiplier e) (car e))
;; 加数
(define (augend e) (caddr e))
;; 乘数
(define (multiplicand e) (caddr e))
;; 幂式
(define (exponentiation? e) (and (pair? e) (eq? (cadr e) '**)))
;; 底数
(define (base e) (car e))
;; 幂次
(define (exponent e) (caddr e))
;; 构建
(define (make-exponentiation a b)
  (cond ((=number? b 0) 1)
        ((=number? b 1) a)
        (else (list a '** b))))


(define (make-sum a b)
  (cond ((=number? a 0) b)
        ((=number? b 0) a)
        ((and (number? a)
              (number? b)) (+ a b))
        (else (list a '+ b))))

(define (=number? a b) (and (number? a) (= a b)))

(define (make-product a b)
  (cond ((or (=number? a 0) (=number? b 0)) 0)
        ((=number? a 1) b)
        ((=number? b 1) a)
        ((and (number? a) (number? b)) (* a b))
        (else (list a '* b))))


(define (deriv exp var)
  ;; c
  (cond ((number? exp) 0)
        ;; ax
        ((variable? exp) (if (same-variable? exp var) 1 0))
        ;; ax + bx
        ((sum? exp) (make-sum
                     (deriv (addend exp) var)
                     (deriv (augend exp) var)))
        ;; f(x)g(x)
        ((product? exp) (make-sum
                         (make-product (multiplier exp)
                                       (deriv (multiplicand exp) var))
                         (make-product (deriv (multiplier exp) var)
                                       (multiplicand exp))))
        ((exponentiation? exp)
         (let ((a (base exp))
               (b (exponent exp)))
           (make-product (make-product (- b 1) a)
                         (deriv a var))))
        (else (error "unknow expression type " exp))))

b)

#lang sicp


;; 是否是变量
(define (variable? e) (symbol? e))
;; 变量相等?
(define (same-variable? a b) (and (variable? a) (variable? b) (eq? a b)))
(define (sum? e)
  (cond ((null? e) #f)
        ((eq? '+ (car e)) #t )
        (else (sum? (cdr e)))))
(define (product? e)
  (cond ((null? e) #f)
        ((eq? '* (car e)) #t)
        (else (product? (cdr e)))))
(define (addend e)
  (define (addend-iter collect residue)
    (if (or (null? residue) (eq? (car residue) '+))
        (if (null? (cdr collect))
            (car collect)
            collect)
        (addend-iter (cons (car residue) collect) (cdr residue))))
  (addend-iter nil e))
(define (multiplier e)
  (define (multiplier-iter collect residue)
    (if (or (null? residue) (eq? (car residue) '*))
        (if (null? (cdr collect))
            (car collect)
            collect)
        (multiplier-iter (cons (car residue) collect) (cdr residue))))
  (multiplier-iter nil e))

(define (augend e)
  (if (eq? (car e) '+)
      (if (null? (cddr e))
          (cadr e)
          (cdr e))
      (augend (cdr e))))

(define (multiplicand e)
  (if (eq? (car e) '*)
      (if (null? (cddr e))
          (cadr e)
          (cdr e))
      (multiplicand (cdr e))))
(define (make-sum a b)
  (cond ((=number? a 0) b)
        ((=number? b 0) a)
        ((and (number? a)
              (number? b)) (+ a b))
        (else (list a '+ b))))

(define (=number? a b) (and (number? a) (= a b)))

(define (make-product a b)
  (cond ((or (=number? a 0) (=number? b 0)) 0)
        ((=number? a 1) b)
        ((=number? b 1) a)
        ((and (number? a) (number? b)) (* a b))
        (else (list a '* b))))

(define (deriv exp var)
  ;; c
  (cond ((number? exp) 0)
        ;; ax
        ((variable? exp) (if (same-variable? exp var) 1 0))
        ;; ax + bx
        ((sum? exp) (make-sum
                     (deriv (addend exp) var)
                     (deriv (augend exp) var)))
        ;; f(x)g(x)
        ((product? exp) (make-sum
                         (make-product (multiplier exp)
                                       (deriv (multiplicand exp) var))
                         (make-product (deriv (multiplier exp) var)
                                       (multiplicand exp))))
        (else (error "unknow expression type " exp))))

(deriv '(s * x + x * y) 'x) ;; (s + y)

集合

  • 属于
(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((equal? x (car set)) #t)
        (else (element-of-set? x (cdr set)))))
  • 添加
(define (join-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))
  • 交集
(define (intersection-set set1 set2)
  (cond ((dor (null? set1) (null? set2)) '())
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))
  • 并集
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (if (element-of-set? (car set1) set2)
            (union-set (cdr set1) set2)
            (union-set (cdr set1) (cons (car set1) set2)))))
  • 2.59

如上

  • 2.60

关于可重复的集合存在两种理解方式:字符和重复同时作为元素仅字符作为元素

字符和重复作为元素

这种情况下,具体的元素应该为 ( x ⋅ n ) (x \cdot n) (x⋅n),其他的和之前的方法不变,但是equal?方法需要比对两个属性。

仅字符作为元素

这种情况下比较为难的是什么算得上交集,也就是说,相同的元素,你有一个,我有五个。

我们是相交了五个,还是相交了一个,或者说,相交了二十五个,如果一遍三个,一遍五个的情况呢?


综上所述,如果是集合情况下,很少去用到类似的定义,除非是每个元素都代表自身个体,即使属性相同也作为个体对待。

也就是list,否则,这种集合统计无实际的意义。

有序

  • 属于
(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((= x (car set)) #t)
        ((< x (car set)) #f)
        (else (element-of-set? x (cdr set)))))
  • 交集
(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
      '()
      (let ((x1 (car set1)) (x2 (car set2)))
        (cond ((= x1 x2)
               (cons x1 (intersection-set (cdr set1) (cdr set2))))
              ((< x1 x2) (intersection-set (cdr set1) set2))
              ((< x2 x1) (intersection-set (cdr set2) set1))))))
  • 2.61
(define (addjoin-set x set)
  (define (join-iter prev next)
    (if (null? next)
        (append prev (list x))
        (let ((mark (car next)))
          (cond ((equal? mark x) set)
                ((> mark x) (append prev (list x) next))
                (else (join-iter (append prev (list mark)) (cdr next)))))))
  (join-iter '() set))
  • 2.62
(define (union-set set1 set2)
  (define (union-iter collect prev next)
    (cond ((null? prev) (append collect next))
          ((null? next) (append collect prev))
          (else
           (let ((x1 (car prev)) (x2 (car next)))
             (cond ((= x1 x2) (union-iter (append collect (list x1)) (cdr prev) (cdr next)))
                   ((> x1 x2) (union-iter (append collect (list x2)) prev (cdr next)))
                   (else (union-iter (append collect (list x1))  (cdr prev) next)))))))
  (union-iter '() set1 set2))

二叉树

(define (make-tree value left right)
  (list value left right))

(define (left-branch tree)
  (cadr tree))

(define (right-branch tree)
  (caddr tree))

(define (value-of-tree tree)
  (car tree))
  • 属于
(define (element-of-set? x set)
  (if (null? set)
      false
      (let ((value (value-of-tree set)))
        (cond ((= x value) true)
              ((< x value) (element-of-set? x (left-branch set)))
              ((> x value) (element-of-set? x (right-branch set)))))))
  • 添加
(define (addjoin-set x set)
  (if (null? set)
      (make-tree x '() '())
      (let ((value (value-of-tree set)))
        (cond ((= x value) set)
              ((< x value)
               (make-tree value
                          (adjoin-set x (left-branch set))
                          (right-branch set)))
              ((> x value)
               (make-tree value
                          (left-branch set)
                          (addjoin-set x (right-branch set))))))))
  • 2.63
(define (tree->list-1 tree)
  (if (null? tree)
      '()
      (append (tree-list-1 (left-branch tree))
              (cons (value-of-tree tree) (tree->list-1 (right-branch tree))))))

(define (tree->list-2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
        result-list
        (copy-to-list (left-branch tree)
                      (cons (value-of-tree tree)
                            (copy-to-list (right-branch tree) result-list)))))
  (copy-to-list tree '()))

a)

用一个例子就能够算出来了

    1
   / \
  2   3

第一种: 2 → 1 → 3 2 \rightarrow 1 \rightarrow 3 2→1→3

第二种: 2 → 1 → 3 2 \rightarrow 1 \rightarrow 3 2→1→3

可以看到的是两种程度的递归思想:第一种比较完善,第二种半吊子,所以才会分步的去递归。

完整的递归显得不易理解,但是圆润完满,越是想分阶段拆分,也就越难以梳理。

b)

把第二种方法拉平,其实和第一种方法是等效的,两者的区别操作在于合并的方式。

第一种方式比较偷懒,对于计算好的列表,采用append的方式直接进行了合并,而第二种,是采用cons逐个进行拼接生成。

合并的步数都是一致的,问题在于第二种方法部分的cons对应第一种方法中的append

考虑到指令执行的复杂度,cons必然要比append简单快捷一些。

  • 2.64
;; 有序表转为平衡二叉树
(define (list->tree elements)
  (car (partial-tree elements (length elements))))
;; 将前面n个元素转化为平衡二叉树,和剩余元素组成序对返回
(define (partial-tree elts n)
  (if (= n 0)
      ;; 指定0个元素,直接返回
      (cons '() elts)
      ;; 前取出一半的数量
      (let ((left-size (quotient (- n 1) 2)))
        ;; 首先整合一半的数据
        (let ((left-result (partial-tree elts left-size)))
          ;; 左边结果为树结构,取出
          (let ((left-tree (car left-result))
                ;; 右边元素为剩余的list
                (non-left-elts (cdr left-result))
                ;; 剩下的应该计算的tree的元素
                (right-size (- n (+ left-size 1))))
            ;; 右边序列的第一个值
            (let ((this-entry (car non-left-elts))
                  ;; 剩下的操作好的序对
                  (right-result (partial-tree
                                 (cdr non-left-elts)
                                 right-size)))
              ;; 第二次取出的剩下的tree
              (let ((right-tree (car right-result))
                    ;; 第二次的list
                    (remaining-elts (cdr right-result)))
                ;; 中间值作为根节点,两端的tree进行拼接
                (cons (make-tree this-entry left-tree right-tree) remaining-elts))))))))

a)

如注释所述,它总是进行这样的步骤

  • 生成左边的树
  • 找到根节点值
  • 生成右边的树
  • 拼接两边和根

这样必然是平衡二叉的。题目中的长度始终是数据长度,如果使用(1 3 5 7 9 11),我们单纯的使用f作为方法即可。
(f ’(1 3 5 7 9 11)) = (f ’(1 3 5)) + (f ’(7 9 11)) \begin{aligned} \text{(f '(1 3 5 7 9 11))} &= \text{(f '(1 3 5))} + \text{(f '(7 9 11))} \\ \end{aligned} (f ’(1 3 5 7 9 11))​=(f ’(1 3 5))+(f ’(7 9 11))​
左边的三分,生成的树如下

   3
  / \
 1   5

右边却不是如此,它首先要抛开第一个元素,然后进行拆分,也就是说,真正的树元素只有(9 11),补全(9 11 nil)

   11
  /
 9

拼接起来也就是

     7
   /   \
  3    11
 / \   /
1   5 9

b)

可以看到,该方法还是秉承的二分思想,因此复杂度为 O ( log ⁡ n ) \Large {O}(\log n) O(logn)

  • 2.65
;; 用好话说,那就是再次强调了标准化接口的好处
;; 难听点说,绕来绕去没新东西,还让我想复杂了
(define (union-tree-set set1 set2) 
  (list->tree (union-set (tree->list set1) (tree->list set2))))

(define (intersection-tree-set set1 set2) 
  (list->tree (intersection-set 
               (tree->list set1)
               (tree->list set2))))

未排序表

(define (look-up given-key set-of-records)
  (cond ((null? set-of-records) false)
        ((equal? given-key (car set-of-records))
         (car set-of-records))
        (else (look-up given-key (cdr set-of-records)))))
  • 2.66
(define (look-up given-key set-of-records)
  (if (null? set-of-records)
      #f
      (let ((key (value-of set-of-records)))
        (cond ((equal? key given-key) key)
              ((> key given-key) (look-up given-key (left-branch set-of-records)))
              (else (look-up given-key (right-branch set-of-records)))))))

Huffman

编码

(define (make-leaf symbol weight)
  (list 'leaf symbol weight))
(define (leaf? object)
  (eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))
(define (make-code-tree left right)
  (list left
        right
        (append (symbols left) (append (symbols right)))
        (+ (weight left) (weight right))))
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
  (if (leaf? tree)
      (list (symbol-leaf tree))
      (caddr tree)))
(define (weight tree)
  (if (leaf? tree)
      (weight-leaf tree)
      (cadddr tree)))

解码

(define (choose-branch bit branch)
  (cond ((= bit 0) (left-branch branch))
        ((= bit 1) (right-branch branch))
        (else (error "bad bit -- CHOOSE-BRANCH" bit))))

(define (decode bits tree)
  (define (decode-inner residue-bits current-branch)
    ;; code
    (if (null? residue-bits)
        '()
        (let ((next-branch (choose-branch (car residue-bits) current-branch)))
          ;; is leaf
          (if (leaf? next-branch)
              ;; combine symbol and decode next
              (cons (symbol-leaf next-branch) (decode-inner (cdr residue-bits) tree))
              ;; continue decode
              (decode-inner (cdr residue-bits) next-branch)))))
  (decode-inner bits tree))

权重排序

(define (add-join-set x set)
  (cond ((null? set) (list x))
        ((< (weight x) (weight (car set)))
         (cons x set))
        (else (cons (car set) (add-join-set x (cdr set))))))

(define (make-leaf-set pairs)
  (if (null? pairs)
      '()
      (let ((pair (car pairs)))
        (add-join-set (make-leaf (car pair)
                                 (cadr pair))
                      (make-leaf-pair (cdr pairs))))))
  • 2.67
(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 sample-message sample-tree)
;; (A D A B B C A)
  • 2.68
;; 检测符号是否在指定的树
(define (symbol-in-tree? symbol tree)
  (cond ((null? tree) #f)
        ;; 如果是叶子,直接比较
        ((leaf? tree)  (eq? symbol (symbol-leaf tree)))
        ;; 左侧有,递归计算
        (else (if (symbol-in-tree? symbol (left-branch tree))
                  #t
                  ;; 右侧递归计算
                  (symbol-in-tree? symbol (right-branch tree))))))

;; 加密单个字符
(define (encode-symbol symbol tree)
  (define (encode-inner collect current-tree)
    (cond ((null? tree) '())
          ((leaf? tree) collect)
          ;; 拿到两边分支的树
          (else (let ((left (left-branch current-tree))
                      (right (right-branch current-tree)))
                  ;; 左侧
                  (if (symbol-in-tree? symbol left)
                      ;; 如果是叶子,直接返回
                      (if (leaf? left)
                          (append collect '(0))
                          ;; 非叶子,继续递归,使用左边树进行解析
                          (encode-inner (append collect '(0)) left))
                      ;; 右侧,叶子直接返回
                      (if (leaf? right)
                          (append collect '(1))
                          ;; 非叶子,使用右边树进行递归
                          (encode-inner (append collect '(1)) right)))))))
  (encode-inner '() tree))

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

(encode '(A D A B B C A) sample-tree)
;; (0 1 1 0 0 1 0 1 0 1 1 1 0)

同上述题目。

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

棒棒哒

  • 2.69

有序集合,意味着我们永远的进行前两个元素的合并就行了,至于排序的规则交给它自己判断。

(define (successive-merge order-set)
  (cond ((= 0 (length order-set)) '())
        ((= 1 (length order-set)) (car order-set))
        (else (let ((first (car order-set))
                    (second (cadr order-set))
                    (residue (cddr order-set)))
                (successive-merge (add-join-set
                                   (make-code-tree first second)
                                   residue))))))

也就是专门做合并操作,如是而已。

  • 2.70
(generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (JOB 2) (YIP 9) (WAH 1)))
;;((leaf NA 16)
;; ((leaf YIP 9)
;;  (((leaf A 2) ((leaf WAH 1) (leaf BOOM 1) (WAH BOOM) 2) (A WAH BOOM) 4)
;;   ((leaf SHA 3) ((leaf JOB 2) (leaf GET 2) (JOB GET) 4) (SHA JOB GET) 7)
;;   (A WAH BOOM SHA JOB GET)
;;   11)
;;  (YIP A WAH BOOM SHA JOB GET)
;;  20)
;; (NA YIP A WAH BOOM SHA JOB GET)
;; 36)
(define song-tree (generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (JOB 2) (YIP 9) (WAH 1))))

(define song-words '(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))

(encode song-words song-tree) ;; 84
;; (1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 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 1 1)

总共8个基本元素,定长编码每个三位,歌词元素总共36,总共需要位数
3 × 36 = 108 3 \times 36 = 108 3×36=108
节省空间
108 − 84 = 22 108 - 84 = 22 108−84=22

  • 2.71

根据题意,元素总个数为 n n n,元素出现的频度为 2 n − 1 2^{n-1} 2n−1.

如果采用霍夫曼编码的话,频度最高的元素1位就足够了。

由于频度没有重复,树节点有一端必然是叶子节点,相当于无折叠的全部遍历,最不频繁的元素编码需要位数 n n n位。

  • 2.72

频繁和最不频繁,二话不说,反手就是一个, 1 1 1。反正不频繁的变长编码,如果频度不冲突的话,一位就够了。

而最频繁的,需要检查是否在叶子节点中,每次递归的深度为
T ( i ) = n − i T(i) = n-i T(i)=n−i
于是总共的步数就是
∑ 0 n − 1 T ( i ) = ∑ 0 n − 1 ( n − i ) = n + ( n − 1 ) + ⋯ + 1 = n ( n + 1 ) 2 \sum_0^ {n-1} T(i) = \sum_0^{n-1} (n-i) = n + (n-1) + \cdots + 1 = \frac{n(n+1)}{2} 0∑n−1​T(i)=0∑n−1​(n−i)=n+(n−1)+⋯+1=2n(n+1)​
增长率也就是 O ( n 2 ) \Large {O(n^2)} O(n2)

上一篇:emacs学习


下一篇:Gentoo 使Portage操作更简单的工具: Equery