数据结构(scheme) -- 抽象数据类型(ADT) -- 二叉查找树

; 二叉查找树 binary-search-tree

(define bst (bstree 10))              ; bst = '(10)
(bstree-add bst 5)                    ; bst = '(10 '(5) '())
(bstree-add bst 17)                   ; bst = '(10 '(5) '(17))
(bstree-add bst 13)                   ; bst = '(10 '(5) '(17 '(13) '()))
(bstree-add bst 9)                    ; bst = '(10 '(5 '() '(9)) '(17 '(13) '()))
(bstree-remove bst 13)                ; bst = '(10 '(5 '() '(9)) '(17))

(bstree-root bst)                     ; 10
(bstree-left bst)                     ; '(5 '() '(9))
(bstree-right bst)                    ; '(17)
(bstree-empty? bst)                   ; #f
(bstree-leaf? (bstree-right bst))     ; #t

(bstree-traverse bst (lambda (i) (printf "i = ~d\n" i)))
; 中序遍历每个节点，使用func处理
(bstree-find bst 9)                   ; '(9), 查找bst中是含有节点e的子树

(bstree->list bst)                    ; '(5 9 10 17) 输出bst的有序链表
(list->bstree '(10 5 17 13 9))        ; '(10 '(5 '() '(9)) '(17 '(13) '())), 从链表构建bst
(bstree-sort '(10 5 17 13 9))         ; '(5 9 10 13 17), 通过二叉树排序链表

; =================================================================
(define bstree list)
(define bstree-empty? null?)
(define (bstree-leaf? b) (null? (cdr b)))
(define bstree-root car)
(define (bstree-left b) (car (cdr b)))
(define (bstree-right b) (car (cdr (cdr b))))
(define (bstree-left-set! b l) (set-car! (cdr b) l))
(define (bstree-right-set! b r) (set-car! (cdr (cdr b)) r))

; (define (dbg loc bz)
;   (printf "~a/ bz = " loc) (display bz) (newline))

(define-syntax bstree-add
(syntax-rules ()
((_ b e)
(if (null? b)
(set! b (list e))
(let t ((bz b))
(if (bstree-leaf? bz)
(if (< e (car bz))
(set-cdr! bz (list (list e) '()))
(set-cdr! bz (list '() (list e))))
(if (< e (car bz))
(if (null? (bstree-left bz))
(bstree-left-set! bz (list e))
(t (bstree-left bz)))
(if (null? (bstree-right bz))
(bstree-right-set! bz (list e))
(t (bstree-right bz))))))))))

(define (bstree-traverse b f)
(if (not (null? b))
(if (bstree-leaf? b)
(f (car b))
(begin
(bstree-traverse (bstree-left b) f)
(f (car b))
(bstree-traverse (bstree-right b) f)))))

(define (bstree-find bz e)
(let t ((b bz) (p bz) (d 'root))
(if (null? b)
'()
(cond
((= e (car b))
(list b p d))
((< e (car b))
(if (or (bstree-leaf? b)
(null? (bstree-left b)))
'()
(t (bstree-left b) b 'left)))
(else
(if (or (bstree-leaf? b)
(null? (bstree-right b)))
'()
(t (bstree-right b) b 'right)))))))

(define (checkleaf b)
(if (and (null? (bstree-left b))
(null? (bstree-right b)))
(set-cdr! b '())))

(define-syntax bstree-remove
(syntax-rules ()
((_ b e)
(let ((bz (bstree-find b e)))
(if (not (null? bz))
(let ((base (list-ref bz 0))
(parent (list-ref bz 1))
(pos (list-ref bz 2)))
(case pos
((root) (set! b (remove-root b)))
((left) (begin (bstree-left-set! parent (remove-root base))
(checkleaf parent)))
((right) (begin (bstree-right-set! parent (remove-root base))
(checkleaf parent))))))))))

(define (remove-root b)
(if (bstree-leaf? b)
'()
(begin (set-car! b
(if (null? (bstree-left b))
(adjust-min 'right (bstree-right b) b)
(adjust-max 'left (bstree-left b) b)))
b)))

(define (adjust-min d b p)
(let ((turn (case d
((right) bstree-right-set!)
((left) bstree-left-set!))))
(if (null? (cdr b))
(begin (turn p '()) (checkleaf p) (car b))
(if (null? (bstree-left b))
(begin (turn p (bstree-right b)) (car b))
(adjust-min 'left (bstree-left b) b)))))

(define (adjust-max d b p)
(let ((turn (case d
((right) bstree-right-set!)
((left) bstree-left-set!))))
(if (null? (cdr b))
(begin (turn p '()) (checkleaf p) (car b))
(if (null? (bstree-right b))
(begin (turn p (bstree-left b)) (car b))
(adjust-max 'right (bstree-right b) b)))))

(define (bstree->list b)
(let ((ls '())
(tail '()))
(bstree-traverse
b
(lambda (i)
(if (null? tail)
(begin
(set! ls (list i))
(set! tail ls))
(begin
(set-cdr! tail (list i))
(set! tail (cdr tail))))))
ls))

(define (list->bstree lst)
(let ((b (bstree)))
(let t ((ls lst))
(if (not (null? ls))
(begin
(bstree-add b (car ls))
(t (cdr ls)))))
b))

(define (bstree-sort ls)
(bstree->list (list->bstree ls)))