Author: abaine Date: Tue Jul 3 16:35:35 2007 New Revision: 48
Modified: trunk/funds/src/trees/avl-tree.lisp Log: Refactoring of insert complete.
Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Tue Jul 3 16:35:35 2007 @@ -24,17 +24,14 @@ :value value :left (empty-avl-tree) :right (empty-avl-tree))) + ;; Duplicate keys are not allowed: ((funcall test key (avl-key tree)) (make-avl :ht (avl-ht tree) :key key :value value :left (avl-left tree) :right (avl-right tree))) -; ((funcall order key (avl-key tree)) (left-insert tree key value test order)) -; (t (right-insert tree key value test order)) - (t (funcall (if (funcall order key (avl-key tree)) - #'left-insert - #'right-insert) - tree key value test order)))) + (t (side-insert tree key value test order + :side (if (funcall order key (avl-key tree)) :left :right)))))
(defun avl-find-value (tree key &key (order #'<) (test #'eql)) "The value associated with the given key in the given AVL Tree. The function @@ -62,49 +59,6 @@
;;;; Insertion Helpers
-(defun left-insert (tree key value test order) - "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 :test test :order order)) -;; (right (avl-right tree))) -;; (if (imbalanced left right) -;; (if (left-heavy left) -;; (right-rotate right tree left) -;; (right-rotate right -;; tree -;; (left-rotate (avl-left left) -;; left -;; (avl-right left)))) -;; (make-avl :ht (parent-height left right) -;; :key (avl-key tree) -;; :value (avl-value tree) -;; :left left -;; :right right))) - (side-insert tree key value test order :side :left)) - -(defun right-insert (tree key value test order) - "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 :test test :order order)) -;; (left (avl-left tree))) -;; (if (imbalanced left right) -;; (if (right-heavy right) -;; (left-rotate left tree right) -;; (left-rotate left -;; tree -;; (right-rotate (avl-right right) -;; right -;; (avl-left right)))) -;; (make-avl :ht (parent-height left right) -;; :key (avl-key tree) -;; :value (avl-value tree) -;; :left left -;; :right right))) - (side-insert tree key value test order :side :right) -) - (defun side-insert (tree key value test order &key side) (let ((out (avl-insert (funcall (side-accessor side) tree) key value :test test :order order)) (in (funcall (other-side-accessor side) tree))) @@ -128,28 +82,6 @@
;;;; Rotation Functions
-(defun left-p (side) - (eq side :left)) - -(defun other-side (side) - (if (left-p side) :right :left)) - -(defun side-accessor (side) - (if (left-p side) #'avl-left #'avl-right)) - -(defun other-side-accessor (side) - (side-accessor (other-side side))) - -(defun side-rotator (side) - (if (left-p side) #'left-rotate #'right-rotate)) - -(defun other-side-rotator (side) - (side-rotator (other-side side))) - -(defun side-heavy-predicate (side) - (if (left-p side) #'left-heavy #'right-heavy)) - - (defun left-rotate (t0 a b) (rotate t0 a b :direction :left))
@@ -175,9 +107,6 @@
;;;; AVL Tree utility functions
-(defun avl-balanced-p (tree) - (< -2 (balance-factor tree) 2)) - (defun imbalanced (left right) "Whether the heights of the given sub-trees differ, in their absolute values, by more than one." @@ -192,12 +121,12 @@ "The difference in heights of the given sub-trees." (- (avl-height a) (avl-height b)))
-(defun left-heavy (tree) +(defun left-heavy-p (tree) "Whether the given imbalanced AVL Tree has a left sub-tree taller than its right sub-tree." (minusp (balance-factor tree)))
-(defun right-heavy (tree) +(defun right-heavy-p (tree) "Whether the given imbalanced AVL Tree has a right sub-tree taller than its left sub-tree." (plusp (balance-factor tree))) @@ -213,3 +142,26 @@ (let ((a (avl-height left)) (b (avl-height right))) (1+ (if (> a b) a b)))) + +;;; Functions that return side-appropriate functions + +(defun left-p (side) + (eq side :left)) + +(defun other-side (side) + (if (left-p side) :right :left)) + +(defun side-accessor (side) + (if (left-p side) #'avl-left #'avl-right)) + +(defun other-side-accessor (side) + (side-accessor (other-side side))) + +(defun side-rotator (side) + (if (left-p side) #'left-rotate #'right-rotate)) + +(defun other-side-rotator (side) + (side-rotator (other-side side))) + +(defun side-heavy-predicate (side) + (if (left-p side) #'left-heavy-p #'right-heavy-p))