Author: abaine Date: Mon Jun 11 17:58:22 2007 New Revision: 6
Modified: trunk/funds/src/trees/avl-tree.lisp Log: Initial version of avl-tree.lisp
Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Mon Jun 11 17:58:22 2007 @@ -0,0 +1,85 @@ + +(in-package :funds) + +(defstruct avl + height + key + value + left + right) + +(defun make-avl () + 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)))) + +(defun left-insert (tree key value) + (let* ((left (avl-insert (avl-left tree))) + (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) ) + tree + 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 left-rotate (t0 a b) + (let ((c (avl-right b)) + (new-a (make-avl :height (avl-height a) + :key (avl-key a) + :value (avl-value a) + :left t0 + :right (avl-left b)))) + (make-avl :height (parent-height (new-a) c) + :key (avl-key b) + :value (avl-value b) + :left new-a + :right c))) + +(defun imbalanced (left right) + (> (abs (- (height right) (height left))) + 1)) + +(defun left-heavy (tree) + (< (balance-factor tree) 0)) + +(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)))) + +(defun height (tree) + (if (null tree) + 0 + (avl-height tree)))