Author: abaine Date: Wed Jun 13 22:07:48 2007 New Revision: 10

Modified: trunk/funds/src/trees/avl-tree.lisp Log: Added comments and fixed problem with right-rotate.

Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Wed Jun 13 22:07:48 2007 @@ -1,29 +1,35 @@

-(in-package :funds) +(in-package :funds-trees)

(defstruct avl - height + ht key value left right)

-(defun make-avl-tree () +(defun empty-avl-tree () + "An empty AVL Tree." nil)

+(defun avl-empty-p (tree) + "Whether the given AVL Tree is empty: +t if it is empty; nil else." + (null tree)) + (defun avl-insert (tree key value) - (cond ((avl-empty tree) (make-avl :height 1 - :key key - :value value - :left nil - :right nil)) + (cond ((avl-empty-p tree) (make-avl :ht 1 + :key key + :value value + :left nil + :right nil)) ((< key (avl-key tree)) (left-insert tree key value)) (t (right-insert tree key value))))

-(defun avl-empty (tree) - (null tree)) - (defun left-insert (tree key value) + "The AVL tree that results when the given key-value pair is inserted +into left sub-tree of the given AVL tree. Only non-empty avl-trees +should be supplied as arguments." (let ((left (avl-insert (avl-left tree) key value)) (right (avl-right tree))) (if (imbalanced left right) @@ -34,22 +40,27 @@ (avl-right left)) tree right)) - (make-avl :height (parent-height left right) + (make-avl :ht (parent-height left right) :key (avl-key tree) :value (avl-value tree) :left left :right right))))

(defun right-insert (tree key value) + "The AVL tree that results when the given key-value pair is inserted +into the right sub-tree of the given AVL tree. Only non-empty avl-trees +should be supplied as the tree argument." (let ((right (avl-insert (avl-right tree) key value)) (left (avl-left tree))) (if (imbalanced left right) (if (right-heavy right) (left-rotate left tree right) - (left-rotate (right-rotate (avl-right right) + (left-rotate left + tree + (right-rotate (avl-left right) right - (avl-left right)))) - (make-avl :height (parent-height left right) + (avl-right right)))) + (make-avl :ht (parent-height left right) :key (avl-key tree) :value (avl-value tree) :left left @@ -57,12 +68,12 @@

(defun left-rotate (t0 a b) (let ((c (avl-right b)) - (new-a (make-avl :height (1- (avl-height a)) ; re-calculate? + (new-a (make-avl :ht (1- (avl-ht a)) ; re-calculate? :key (avl-key a) :value (avl-value a) :left t0 :right (avl-left b)))) - (make-avl :height (1+ (avl-height new-a)) + (make-avl :ht (1+ (avl-ht new-a)) :key (avl-key b) :value (avl-value b) :left new-a @@ -70,37 +81,50 @@

(defun right-rotate (b c t3) (let ((a (avl-left b)) - (new-c (make-avl :height (1- (avl-height c)); re-calculate? + (new-c (make-avl :ht (1- (avl-ht c)); re-calculate? :key (avl-key c) :value (avl-value c) :left (avl-right b) :right t3))) - (make-avl :height (1+ (avl-height new-c)) ; re-calculate? + (make-avl :ht (1+ (avl-ht new-c)) ; re-calculate? :key (avl-key b) :value (avl-value b) :left a :right new-c)))

(defun imbalanced (left right) - (> (abs (- (height right) (height left))) - 1)) + "Whether the heights of the given sub-trees differ, +in their absolute values, by more than one." + (> (abs (height-difference left right)) 1)) + +(defun height-difference (a b) + "The difference in heights of the given sub-trees." + (- (avl-height a) (avl-height b))) + +(defun avl-height (tree) + "The height of the given AVL Tree." + (if (avl-empty-p tree) + 0 + (avl-ht tree)))

(defun left-heavy (tree) + "Whether the given imbalanced AVL Tree has a left sub-tree +taller than its right sub-tree." (< (balance-factor tree) 0))

(defun right-heavy (tree) + "Whether the given imbalanced AVL Tre has a right sub-tree +taller than its left sub-tree." (> (balance-factor tree) 0))

(defun balance-factor (tree) - (- (height (avl-right tree)) - (height (avl-left tree)))) - -(defun height (tree) - (if (null tree) - 0 - (avl-height tree))) + "The difference in heights of the right sub-tree and left +sub-tree of the given AVL Tree." + (height-difference (avl-right tree) + (avl-left tree)))

(defun parent-height (left right) - (let ((a (height left)) - (b (height right))) + "The height of the parent of the given sub-trees." + (let ((a (avl-height left)) + (b (avl-height right))) (1+ (if (> a b) a b))))