[funds-cvs] r48 - trunk/funds/src/trees

[abaine at common-lisp.net]

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))