Author: abaine Date: Tue Jun 12 10:11:16 2007 New Revision: 7

Modified: trunk/funds/src/trees/avl-tree.lisp Log: avl insertion now seems to work.

Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Tue Jun 12 10:11:16 2007 @@ -8,60 +8,79 @@ left right)

-(defun make-avl () +(defun make-avl-tree () nil)

(defun avl-insert (tree key value) - (cond ((null tree) (make-avl :height 1 - :key key - :value value - :left nil - :right nil)) - ((< key (avl-key tree)) (left-insert tree)) - (t (right-insert tree)))) + (cond ((avl-empty tree) (make-avl :height 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) - (let* ((left (avl-insert (avl-left tree))) - (right (avl-right tree))) + (let ((left (avl-insert (avl-left tree) key value)) + (right (avl-right tree))) (if (imbalanced left right) (if (left-heavy left) (right-rotate left tree right) - (right-rotate (left-rotate left (avl-left left) ) + (right-rotate (left-rotate (avl-left left) + left + (avl-right left)) tree - right) - ()) + right)) (make-avl :height (parent-height left right) :key (avl-key tree) :value (avl-value tree) :left left :right right))))

-(defun right-rotate (b c t3) - (let ((a (avl-left b)) - (new-c (make-avl :height (avl-height c); not sure if this needs to be recalculated - :key (avl-key c) - :value (avl-value c) - :left (avl-right b) - :right t3))) - (make-avl :height (parent-height a new-c) - :key (avl-key b) - :value (avl-value b) - :left a - :right new-c))) +(defun right-insert (tree key value) + (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) + right + (avl-left right)))) + (make-avl :height (parent-height left right) + :key (avl-key tree) + :value (avl-value tree) + :left left + :right right))))

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

+(defun right-rotate (b c t3) + (let ((a (avl-left b)) + (new-c (make-avl :height (1- (avl-height 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? + :key (avl-key b) + :value (avl-value b) + :left a + :right new-c))) + (defun imbalanced (left right) (> (abs (- (height right) (height left))) 1)) @@ -72,9 +91,6 @@ (defun right-heavy (tree) (> (balance-factor tree) 0))

-(defun right-insert (tree key value) - ()) - (defun balance-factor (tree) (- (height (avl-right tree)) (height (avl-left tree)))) @@ -83,3 +99,8 @@ (if (null tree) 0 (avl-height tree))) + +(defun parent-height (left right) + (let ((a (height left)) + (b (height right))) + (1+ (if (> a b) a b))))