AVL trees
This is an example showcasing the usage of libraries to implement abstract data types.
As opposed to the R7RS standard, LispPad allows users to define local libraries in programs
directly. Such local libraries can be defined and imported just like globally installed
libraries in .sld
files. They are useful to hide internal functions and to document the
official interface of a datatype.
The AVL tree library example below implements purely functional AVL trees: inserting or
deleting an element from an AVL tree results in a new AVL tree. Internally, AVL trees are
implemented using algebraic datatypes. In standard Scheme implementations, algebraic
datatypes usually do not exist. LispPad provides a lightweight algebraic datatype implementation
via library (lispkit datatype)
.
(define-library (avl-tree)
(export make-avl-tree
avl-tree?
avl-empty?
avl-size
avl-contains?
avl-insert
avl-delete
avl-tree->list)
(import (lispkit base)
(lispkit datatype))
(begin
;; Define data type. AVL trees are implemented as an algebraic datatype with two
;; constructors: `empty` and `node`, for representing an empty AVL tree and AVL
;; trees of at least one element.
(define-datatype avl-tree avl-tree?
(empty)
(node elem left right height))
;;; Make a new AVL tree containing the given elements.
(define (make-avl-tree . elems)
(if (null? elems)
empty-tree
(avl-insert (car elems) (apply make-avl-tree (cdr elems)))))
;; Constant defining the empty AVL tree.
(define empty-tree (empty))
;; Constructor creating an AVL tree with one element.
(define (make-leaf elem)
(node elem empty-tree empty-tree 1))
;; Constructor creating an AVL tree with a left and right subtree.
(define (make-tree elem left right)
(node elem left right (fx1+ (max (height left) (height right)))))
;; Returns the height of the given tree.
(define (height tree)
(match tree
((empty) 0)
((node _ _ _ h) h)))
;; Computes the height difference between the left and right subtrees of the given tree.
(define (height-diff tree)
(match tree
((empty) 0)
((node _ l r _) (fx- (height r) (height l)))))
;; Returns #t if the given tree is an empty tree.
(define (avl-empty? tree)
(match tree
((empty) #t)
(else #f)))
;; Returns the number of elements in the given AVL tree.
(define (avl-size tree)
(match tree
((empty) 0)
((node _ l r _) (fx1+ (fx+ (avl-size l) (avl-size r))))))
;; Returns #t if the AVL tree contains the given element.
(define (avl-contains? x tree)
(match tree
((empty) #f)
((node e l r _) (cond ((= x e) #t)
((< x e) (avl-contains? x l))
((> x e) (avl-contains? x r))))))
;; Returns a balanced version of the given AVL tree.
(define (avl-balance tree)
(match tree
((empty) tree)
((node _ l r _) (case (fx- (height r) (height l))
((2) (if (negative? (height-diff r))
(rotate-right-left tree)
(rotate-right tree)))
((-2) (if (positive? (height-diff l))
(rotate-left-right tree)
(rotate-left tree)))
(else tree)))))
(define (rotate-left tree)
(match tree
((empty) tree)
((node e (node le ll lr _) r _) (make-tree le ll (make-tree e lr r)))))
(define (rotate-right tree)
(match tree
((empty) tree)
((node e l (node re rl rr _) _) (make-tree re (make-tree e l rl) rr))))
(define (rotate-left-right tree)
(match tree
((node e (node le ll (node lre lrl lrr _) _) r _)
(make-tree lre (make-tree le ll lrl) (make-tree e lrr r)))))
(define (rotate-right-left tree)
(match tree
((node e l (node re (node rle rll rlr _) rr _) _)
(make-tree rle (make-tree e l rll) (make-tree re rlr rr)))))
;; Returns a new AVL tree with the given element inserted.
(define (avl-insert x tree)
(if (avl-contains? x tree) tree (avl-insert-internal x tree)))
(define (avl-insert-internal x tree)
(match tree
((empty) (make-leaf x))
((node e l r h) (cond ((< x e) (avl-balance (make-tree e (avl-insert-internal x l) r)))
((> x e) (avl-balance (make-tree e l (avl-insert-internal x r))))
(else tree)))))
;; Returns a new AVL tree with the given element removed.
(define (avl-delete x tree)
(if (avl-contains? x tree) (avl-delete-internal x tree) tree))
(define (avl-delete-internal x tree)
(match tree
((node e l r _)
(cond ((< x e) (avl-balance (make-tree e (avl-delete-internal x l) r)))
((> x e) (avl-balance (make-tree e l (avl-delete-internal x r))))
((= x e) (cond ((avl-empty? r) l)
((avl-empty? l) r)
(else (match (avl-delete-leftmost r)
((node lme _ lmr _) (make-tree lme l lmr))))))))))
(define (avl-delete-leftmost tree)
(match tree
((node _ (empty) _ _) tree)
((node e l r _) (match (avl-delete-leftmost l)
((node lme _ lmr _)
(make-tree lme empty-tree (avl-balance (make-tree e lmr r))))))))
;; Returns the elements of the given AVL tree as a list in sorted order.
(define (avl-tree->list tree)
(match tree
((empty) '())
((node e l r _) (append (avl-tree->list l) (list e) (avl-tree->list r)))))
)
)
The following lines show how to use the AVL tree library and access functionality defined by the library.
(import (avl-tree))
(define tree1 (make-avl-tree 39 21 99 4 1 19 78 41 21))
(define tree2 (avl-insert 50 tree1))
(display "tree1 is a subset of tree2: ")
(display (every? (lambda (x) (avl-contains? x tree2)) (avl-tree->list tree1)))
(newline)
(define tree3 (avl-delete 21 tree2))
(display "tree1 is a subset of tree3: ")
(display (every? (lambda (x) (avl-contains? x tree3)) (avl-tree->list tree1)))
(newline)
(display "elements in tree1: ")
(display (avl-size tree1))
(newline)
(display "elements in tree2: ")
(display (avl-size tree2))
(newline)
(display "elements in tree3: ")
(display (avl-size tree3))
(newline)