Author: abaine Date: Thu Aug 2 15:40:23 2007 New Revision: 111
Modified: trunk/funds/src/trees/avl.lisp Log: Totally changed balance function so that it doesn't require the creation of intermediate nodes.
Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 15:40:23 2007 @@ -33,24 +33,26 @@ (defun balanced-p (t1 t2) (< -2 (height-difference t1 t2) 2))
-(defun balance (inside root outside &key heavy-side) - (let ((other-side (other-side heavy-side))) - (if (balanced-p inside outside) - (stitch-avl-tree :root root - heavy-side outside - other-side inside) - (rotate inside root - (if (heavier-p outside :side other-side) - (rotate (tree-child outside :side heavy-side) - outside - (tree-child outside :side other-side) - :side heavy-side) - outside) - :side other-side)))) +(defun balance (key value left right) + (let ((height-difference (- (tree-height left) (tree-height right)))) + (if (< -2 height-difference 2) + (stitch-avl-tree :key key :value value :left left :right right) + (let* ((heavy-side (if (plusp height-difference) :left :right)) + (other-side (other-side heavy-side)) + (inside (if (left-p heavy-side) right left)) + (outside (if (left-p heavy-side) left right))) + (rotate inside key value + (if (heavier-p outside :side other-side) + (rotate (tree-child outside :side heavy-side) + (bt-key outside) (bt-value outside) + (tree-child outside :side other-side) + :side heavy-side) + outside) + :side other-side)))))
-(defun rotate (inside root outside &key side) +(defun rotate (inside root-key root-value outside &key side) (let* ((t1 (tree-child outside :side side)) - (new-inside (stitch-avl-tree :root root + (new-inside (stitch-avl-tree :key root-key :value root-value side inside (other-side side) t1)) (new-outside (tree-child outside :side (other-side side))))