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

abaine at common-lisp.net abaine at common-lisp.net
Wed Jun 20 22:27:13 UTC 2007


Author: abaine
Date: Wed Jun 20 18:27:13 2007
New Revision: 35

Modified:
   trunk/funds/src/trees/avl-tree.lisp
Log:
Rearranged avl-tree.lisp to put public interface at top.

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 20 18:27:13 2007
@@ -1,12 +1,8 @@
 
 (in-package :funds.trees)
 
-(defstruct avl
-  ht
-  key
-  value
-  left
-  right)
+;;;; Public Interface
+
 
 (defun empty-avl-tree ()
   "An empty AVL Tree."
@@ -37,6 +33,32 @@
 	((funcall order key (avl-key tree)) (left-insert tree key value test order))
 	(t (right-insert tree key value test order))))
 
+(defun avl-find-value (tree key &key (order #'<) (test #'eql))
+  "The value associated with the given key in the given AVL Tree.  The function
+returns nil if the key is not found in the given tree; a second value is returned
+to indicate whether nil is returned because it is in fact the value associated with
+the given key or, instead, the key could not be found."
+  (cond ((avl-empty-p tree) (values nil nil))
+	((funcall test key (avl-key tree)) (values (avl-value tree) t))
+	((funcall order key (avl-key tree)) 
+	 (avl-find-value (avl-left tree) key :order order :test test))
+	(t (avl-find-value (avl-right tree) key :order order :test test))))
+
+(defstruct avl
+  ht
+  key
+  value
+  left
+  right)
+
+(defun avl-height (tree)
+  "The height of the given AVL Tree."
+  (if (avl-empty-p tree)
+      0
+      (avl-ht tree)))
+
+;;;; 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 
@@ -77,6 +99,8 @@
 		  :left left
 		  :right right))))
 
+;;;; Rotation Functions
+
 (defun left-rotate (t0 a b)
   (let ((c (avl-right b))
 	(new-a (make-avl :ht (1- (avl-ht a)) ; re-calculate?
@@ -103,16 +127,7 @@
 	      :left a
 	      :right new-c)))
 
-(defun avl-find-value (tree key &key (order #'<) (test #'eql))
-  "The value associated with the given key in the given AVL Tree.  The function
-returns nil if the key is not found in the given tree; a second value is returned
-to indicate whether nil is returned because it is in fact the value associated with
-the given key or, instead, the key could not be found."
-  (cond ((avl-empty-p tree) (values nil nil))
-	((funcall test key (avl-key tree)) (values (avl-value tree) t))
-	((funcall order key (avl-key tree)) 
-	 (avl-find-value (avl-left tree) key :order order :test test))
-	(t (avl-find-value (avl-right tree) key :order order :test test))))
+;;;; AVL Tree utility functions
 
 (defun imbalanced (left right)
   "Whether the heights of the given sub-trees differ,
@@ -128,12 +143,6 @@
   "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."
@@ -151,7 +160,7 @@
 		     (avl-left tree)))
 
 (defun parent-height (left right)
-  "The height of the parent of the given sub-trees."
+  "The height the tree should be, whose children are the given sub-trees."
   (let ((a (avl-height left))
 	(b (avl-height right)))
     (1+ (if (> a b) a b))))



More information about the Funds-cvs mailing list