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

[abaine at common-lisp.net]

Author: abaine
Date: Wed Jun 13 22:07:48 2007
New Revision: 10

Modified:
   trunk/funds/src/trees/avl-tree.lisp
Log:
Added comments and fixed problem with right-rotate.

Modified: trunk/funds/src/trees/avl-tree.lisp
==============================================================================
--- trunk/funds/src/trees/avl-tree.lisp	(original)
+++ trunk/funds/src/trees/avl-tree.lisp	Wed Jun 13 22:07:48 2007
@@ -1,29 +1,35 @@
 
-(in-package :funds)
+(in-package :funds-trees)
 
 (defstruct avl
-  height
+  ht
   key
   value
   left
   right)
 
-(defun make-avl-tree ()
+(defun empty-avl-tree ()
+  "An empty AVL Tree."
   nil)
 
+(defun avl-empty-p (tree)
+  "Whether the given AVL Tree is empty:
+t if it is empty; nil else."
+  (null tree))
+
 (defun avl-insert (tree key value)
-  (cond ((avl-empty tree) (make-avl :height 1
-				    :key key
-				    :value value
-				    :left nil
-				    :right nil))
+  (cond ((avl-empty-p tree) (make-avl :ht 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)
+  "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))
 	(right (avl-right tree)))
     (if (imbalanced left right)
@@ -34,22 +40,27 @@
 				       (avl-right left))
 			  tree 
 			  right))
-	(make-avl :height (parent-height left right)
+	(make-avl :ht (parent-height left right)
 		  :key (avl-key tree)
 		  :value (avl-value tree)
 		  :left left
 		  :right right))))
 
 (defun right-insert (tree key value)
+  "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))
 	(left (avl-left tree)))
     (if (imbalanced left right)
 	(if (right-heavy right)
 	    (left-rotate left tree right)
-	    (left-rotate (right-rotate (avl-right right)
+	    (left-rotate left
+			 tree
+			 (right-rotate (avl-left right)
 				       right
-				       (avl-left right))))
-	(make-avl :height (parent-height left right)
+				       (avl-right right))))
+	(make-avl :ht (parent-height left right)
 		  :key (avl-key tree)
 		  :value (avl-value tree)
 		  :left left
@@ -57,12 +68,12 @@
 
 (defun left-rotate (t0 a b)
   (let ((c (avl-right b))
-	(new-a (make-avl :height (1- (avl-height a)) ; re-calculate?
+	(new-a (make-avl :ht (1- (avl-ht a)) ; re-calculate?
 			 :key (avl-key a)
 			 :value (avl-value a)
 			 :left t0
 			 :right (avl-left b))))
-    (make-avl :height (1+ (avl-height new-a))
+    (make-avl :ht (1+ (avl-ht new-a))
 	      :key (avl-key b)
 	      :value (avl-value b)
 	      :left new-a
@@ -70,37 +81,50 @@
 
 (defun right-rotate (b c t3)
   (let ((a (avl-left b))
-	(new-c (make-avl :height (1- (avl-height c)); re-calculate?
+	(new-c (make-avl :ht (1- (avl-ht 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?
+    (make-avl :ht (1+ (avl-ht 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))
+  "Whether the heights of the given sub-trees differ,
+in their absolute values, by more than one."
+  (> (abs (height-difference left right)) 1))
+
+(defun height-difference (a b)
+  "The difference in heights of the given sub-trees."
+  (- (avl-height a) (avl-height b)))
+
+(defun avl-height (tree)
+  "The height of the given AVL Tree."
+  (if (avl-empty-p tree)
+      0
+      (avl-ht tree)))
 
 (defun left-heavy (tree)
+  "Whether the given imbalanced AVL Tree has a left sub-tree
+taller than its right sub-tree."
   (< (balance-factor tree) 0))
 
 (defun right-heavy (tree)
+  "Whether the given imbalanced AVL Tre has a right sub-tree
+taller than its left sub-tree."
   (> (balance-factor tree) 0))
 
 (defun balance-factor (tree)
-  (- (height (avl-right tree))
-     (height (avl-left tree))))
-
-(defun height (tree)
-  (if (null tree)
-      0
-      (avl-height tree)))
+  "The difference in heights of the right sub-tree and left
+sub-tree of the given AVL Tree."
+  (height-difference (avl-right tree)
+		     (avl-left tree)))
 
 (defun parent-height (left right)
-  (let ((a (height left))
-	(b (height right)))
+  "The height of the parent of the given sub-trees."
+  (let ((a (avl-height left))
+	(b (avl-height right)))
     (1+ (if (> a b) a b))))