Scheme实现二叉查找树及基本操作（添加、删除、并、交）

表转化成平衡二叉树

其中有一种分治的思想。

(define (list->tree 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))))))))
  (car (partial-tree elements (length elements))))
(display (list->tree '(3 1 2 4 1 2)))

二叉查找树实现集合

#lang planet neil/sicp

(define (entry tree) (car tree))

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

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

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

(define (element-of-tree? x tree)
  (cond ((null? tree) #f)
        ((= x (entry tree)) #t)
        ((< x (entry tree)) (element-of-tree? x (left-branch tree)))
        ((> x (entry tree)) (element-of-tree? x (right-branch tree)))))

(define (adjoin-tree x tree)
  (cond ((null? tree) (make-tree x '() '()))
        ((= x (entry tree)) tree)
        ((< x (entry tree))
         (make-tree (entry tree) (adjoin-tree x (left-branch tree)) (right-branch tree)))
        ((> x (entry tree))
         (make-tree (entry tree) (left-branch tree) (adjoin-tree x (right-branch tree))))))

(define (delete-tree x tree)
  (define (find-max tree)
    (if (and (null? (left-branch tree)) (null? (right-branch tree)))
        (entry tree)
        (find-max (right-branch tree))))
  (define (dlt x tree)
    (if (null? tree)
        '()
        (if (= (entry tree) x)
            (let ((left (left-branch tree)) (right (right-branch tree)))
              (cond ((and (null? left) (null? right)) '())
                    ((null? left) right)
                    ((null? right) left)
                    (else
                     (let ((mx (find-max left)))
                       (make-tree mx (dlt mx left) right)))))
            (make-tree (entry tree) (dlt x (left-branch tree)) (dlt x (right-branch tree))))))
(if (element-of-tree? x tree)
      (dlt x tree)
      tree))

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

(define (list->tree 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))))))))
  (car (partial-tree elements (length elements))))

(define (union-tree tree1 tree2)
  (define (union-list list1 list2)
    (cond ((null? list1) list2)
          ((null? list2) list1)
          ((< (car list1) (car list2))
           (cons (car list1) (union-list (cdr list1) list2)))
          ((< (car list2) (car list1))
           (cons (car list2) (union-list (cdr list2) list1)))
          ((= (car list1) (car list2))
           (cons (car list1) (union-list (cdr list1) (cdr list2))))))
    (list->tree (union-list (tree->list tree1) (tree->list tree2))))

(define (intersection-tree tree1 tree2)
  (define (intersection-list list1 list2)
    (cond ((or (null? list1) (null? list2)) '())
          ((< (car list1) (car list2))
           (intersection-list (cdr list1) list2))
          ((< (car list2) (car list1))
           (intersection-list (cdr list2) list1))
          ((= (car list1) (car list2))
           (cons (car list1) (intersection-list (cdr list1) (cdr list2))))))
  (list->tree (intersection-list (tree->list tree1) (tree->list tree2))))

(define (getlist n MAX)
  (if (= n 0)
      '()
      (cons (random MAX) (getlist (- n 1) MAX))))

(define (list->BST lst)
  (if (null? lst)
      '()
      (adjoin-tree (car lst) (list->BST (cdr lst)))))

注：

• list->tree和tree->list行为恰好相反。
• 树转化成表是从右往左放数。
• 最大的值一定是树最右边的结点，而这个结点正好在转化成表的时候处于表的最右端，保证了转化成的表的有序性（当然前提树是二叉查找树）。
• 要想通过list->tree得到一棵二叉查找树，必须保证是有序表。

---

添加、删除操作

(define tree '())
(set! tree (adjoin-tree 3 tree))
(set! tree (adjoin-tree 1 tree))
(set! tree (adjoin-tree 5 tree))
(set! tree (adjoin-tree 8 tree))
(set! tree (adjoin-tree 9 tree))
(set! tree (adjoin-tree 7 tree))
(set! tree (adjoin-tree 2 tree))
(set! tree (adjoin-tree 4 tree))
(set! tree (adjoin-tree 11 tree))
(display tree) (newline)
; (3 (1 () (2 () ())) (5 (4 () ()) (8 (7 () ()) (9 () (11 () ())))))

(set! tree (delete-tree 3 tree))
(display tree) (newline)
; (2 (1 () ()) (5 (4 () ()) (8 (7 () ()) (9 () (11 () ())))))

(display (delete-tree 8 tree)) (newline)
; (2 (1 () ()) (5 (4 () ()) (7 () (9 () (11 () ())))))

(display (delete-tree 9 tree)) (newline)
; (2 (1 () ()) (5 (4 () ()) (8 (7 () ()) (11 () ()))))

(display (delete-tree 5 tree)) (newline)
; (2 (1 () ()) (4 () (8 (7 () ()) (9 () (11 () ())))))

(set! tree (delete-tree 2 tree))
(display tree) (newline)
; (1 () (5 (4 () ()) (8 (7 () ()) (9 () (11 () ())))))

(display (delete-tree 1 tree)) (newline)
; (5 (4 () ()) (8 (7 () ()) (9 () (11 () ()))))

(set! tree (delete-tree 5 tree))
(set! tree (delete-tree 4 tree))
(set! tree (delete-tree 8 tree))
(set! tree (delete-tree 7 tree))
(set! tree (delete-tree 9 tree))
(set! tree (delete-tree 11 tree))
(display tree) (newline)
; (1 () ())
(set! tree (delete-tree 1 tree))
(display tree)
; ()

---

对两棵二叉查找树取 交、并 操作。

(define list1 (list 1 2 3 9))
(define list2 (list 3 4 7 9))
(define tree1 (list->tree list1))
(define tree2 (list->tree list2))
(display tree1)(newline)
; (2 (1 () ()) (3 () (9 () ())))
(display tree2)(newline)
; (4 (3 () ()) (7 () (9 () ())))
(display (union-tree tree1 tree2))(newline)
; (3 (1 () (2 () ())) (7 (4 () ()) (9 () ())))
(display (intersection-tree tree1 tree2))
; (3 () (9 () ()))

---

利用上面的函数也可以实现\(O(n+nlogn)\)的排序操作。

(define list1 (getlist 10 10)) ; 生成随机表
(define bst1 (list->BST list1)) ; 转化成二叉查找树
(display list1)(newline)
(display bst1)(newline)
(display (tree->list bst1)) ; 有序表

---

总结

用 Scheme 实现二叉查找树真的很有意思，首先是代码结构非常紧凑，加上有意义的变量名、函数名会显得更加直观，但是要想一次写好，必须对整个过程进行设计，不然很容易写到后面发现前面有缺漏从而影响全局的代码。

其中一些代码来自于 SICP，自己按照 BST 删除的原理实现了删除的过程。

关于递归的理解更深了一点。首先要明确这个过程到底要做什么？会返回什么值？是什么类型的值？