Scheme 序列和树

Scheme 序列和树

引言

在学习C语言描述的数据结构时，Lisp 表一头一尾的结构令人诧异。有同学认为 Lisp 表是区别于数组、链表和树的一种独特结构，但是，无论其表结构怎样复杂，似乎总能用树表示出来。

我们错了。Lisp 表不是逻辑结构层面的东西，而是存储结构。SICP 的前言中有这句话：

在Pascal里，过多的可声明数据结构导致了函数的专用化，这就造成了对合作的阻碍和惩罚。让100个函数在一个数据结构上操作，远比让10个函数在10个数据结构上操作更好些。

Lisp 用序对实现各种各样的逻辑结构。逻辑结构不同的对象存储结构相同，面向存储结构编写的函数就有机会适用于逻辑结构不同的对象。

本文是 SICP 2.2 层次数据和闭包性质 的学习笔记。

链表

存储

序对只有两个“插槽”，怎么存得下一张表呢？序对的闭包性质，让序对的元素也是序对。于是，像用递归实现迭代一样，又像 Scheme 程序层层嵌套的括号一样，像洋葱一样，表就这样被建立起来了。表尾用空表nil标识。

> (cons 1 (cons 2 (cons 3 (cons 4 nil))))
(1 2 3 4)

可以使用简写为，

(list 1 2 3 4)

函数

取n号元素

(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))

求表长

(define (length items)
  (if (null? items)
      0
      (+ 1 (length (cdr items)))))

null?是内建函数，用于检测空表。

表拼接

要拼接两个链表，只要将一个表的尾指针指向另一个表的表头就可以了。但是，在 Scheme 中值都是不可变的，包括用cons构造的复合数据。我们的 List 就是用cons构造的复合数据，所以不能使用修改尾指针的方法串联链表了。

下面的过程可以将新元素附加在表头：

(define (push x items)
  (cons x items))

可以看出，这个过程也没有修改原来的表items，而是构建了一个新表。反复应用该思路，一次添加一个元素，写出拼接表的过程：

(define (extend list1 list2)
  (if (null? list1)
      list2
      (cons (car list1) (extend (cdr list1) list2))))

可以从两个角度理解这个过程，

• 从逻辑角度看，如果 list1 为空表，结果就是 list2. 否则，结果是 list1 的表头组合其余部分。
• 从解释器的角度，递归调用过程将 list1 分解，递归返回过程将 list1 逆序依次添加到 list2 的表头

逻辑角度对结果做“是什么”的描述，解释器处理“怎么做”的问题。

逆序

观察不难发现，逆序操作有一种性质，就是如果将列表元素分组，先做组间逆序再做组内逆序，结果仍然正确。分组的大小任意，甚至可以为1、为0。使用分组，就可以减小问题规模。为了实现方便，将列表分为两组，记列表为$S$，逆序操作为$r$，逆序操作的递归描述如下：
$$\begin{gathered} S=S_1+S_2 \\ r(S)=r(S_1+S_2)=r(S_2)+r(S_1) \end{gathered}$$
但对 Scheme 来说，使递归问题规模减小的手段只有cdr这一种。这要求我们按car, cdr分组，即：
r ( S ) = c d r ( S ) + { c a r ( S ) } r(S)={\rm cdr}(S)+\{{\rm car}(S)\} r(S)=cdr(S)+{car(S)}

(define (reverse items)
  (if (null? items)
      '()
      (extend (reverse (cdr items)) (list (car items)))))

这个算法的复杂度是多少？我觉得是$n^2$，因为每次reverse返回都伴随一次extend。

虽然 python 在很多地方有函数式的影子，但其列表采用数组做存储结构，从而使取元素、逆序都有常数复杂度。

表过滤

(define (filter predicate? items)
  (if (null? items)
      '()
      (let ((head (car items))
            (tail (cdr items)))
        (if (predicate? head)
            (cons head (filter predicate? tail))
            (filter predicate? tail)))))

映射

递归：

(define (map proc items)
  (if (null? items)
      nil
      (cons (proc (car items))
            (map proc (cdr items)))))

迭代：

(define (map-list proc items)
  (define (iter proc items pick)
    (if (null? items)
        (pick items)
        (let ((head (proc (car items)))
              (tail (cdr items)))
          (iter proc tail (lambda (x) (pick (cons head x)))))))
  (iter proc items (lambda (x) x)))

这段程序非常有意思，它将数据蕴含在过程里，而实现这是通过迭代pick函数实现的。

树

我们可以将元素本身也是序列的序列看作树。序列里的元素就是树的分支，而那些本身也是序列的元素就形成了树中的子树。

存储

与list的区别在于car也可能给出pair了。

函数

叶子计数

将car和cdr作用于tree会产生什么结果？对于非空树来说，

• pair
• number
• '()

注意，car, cdr不能作用于'()，因为'()是空标志，类似 C 语言中的null。Scheme 从概念上没法表示“空的表”，一旦表失去最后一个元素，再将car, cdr作用于它就会报错。本文遵从习惯，还是将'()称为空表。

car, cdr的结果分类与相应检查函数（谓词）如图：

叶子计数的递归方程，
$$C(T)=C(\mathrm{c}\mathrm{a}\mathrm{r}(T))+C(\mathrm{c}\mathrm{d}\mathrm{r}(T))$$

类型	处理
空表	0
数	1
序对	分解

(define (count-leaves x)
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

树反转

对调所有的左右子树。

(define (deep-reverse tree)
  (if (not (list? tree))
      tree
      (reverse (map deep-reverse tree))))

列表的元素可能是列表也可能不是，和线性表的分组逆序异曲同工。存储结构的统一让算法设计需要考虑的边界条件的数量很少。

树展平

(define (fringe tree)
  (cond ((null? tree) '())
        ((not (pair? tree)) (list tree))
        (else (extend (fringe (car tree)) (fringe (cdr tree))))))

• 如果是空树，返回空树。extend是可以处理'()的。
• 如果是数值，装入列表返回。因为extend只能拼接两个列表。
• 其余情况，拼接表头与表尾。

这样处理比较方便，但会在输入数字时返回列表。

> (fringe (list (list 1 2) 3 4 (list 5 (list 6)) 7))
(1 2 3 4 5 6 7)

> (fringe 3)
(3)

如果这不是想要的结果，可以将判断移入函数extend内（用高阶函数修饰其输入）。具体来说，

(define (fringe tree)
  (define (push x items)
    (if (list? x)
        (extend x items)
        (extend (list x) items)))
  (cond ((null? tree) '())
        ((not (pair? tree)) tree)
        (else (push (fringe (car tree)) (fringe (cdr tree))))))

如此，

> (fringe (list (list 1 2) 3 4 (list 5 (list 6)) 7))
(1 2 3 4 5 6 7)
> (fringe 3)
3

映射

(define (tree-map func tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (tree-map func sub-tree)
             (func sub-tree)))
       tree))

应用

天平模拟

#lang sicp


(define (make-mobile left right)
  (list left right))

(define (left-branch mobile)
  (car mobile))

(define (right-branch mobile)
  (car (cdr mobile)))


(define (make-branch length structure)
  (list length structure))

(define (branch-length branch)
  (car branch))

(define (branch-structure branch)
  (car (cdr branch)))

(define (branch-moment branch)
  (* (branch-length branch)
     (total-weight (branch-structure branch))))


(define (total-weight structure)
  (if (number? structure)
      structure
      (let ((left-structure (branch-structure (left-branch structure)))
            (right-structure (branch-structure (right-branch structure))))
        (+ (total-weight left-structure)
           (total-weight right-structure)))))


(define (balence? structure)
  (if (number? structure)
      true
      (let ((left-moment (branch-moment (left-branch structure)))
            (right-moment (branch-moment (right-branch structure)))
            (left-structure (branch-structure (left-branch structure)))
            (right-structure (branch-structure (right-branch structure))))
        (if (and (= left-moment right-moment)
                 (balence? left-structure)
                 (balence? right-structure))
            true
            false))))


(define m1 (make-mobile (make-branch 2 6)
                        (make-branch 3 4)))

(define m2 (make-mobile (make-branch 2 5)
                        (make-branch 1 m1)))

> (balence? m2)
#t
> (balence? m1)
#t