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

[abaine at common-lisp.net]

Author: abaine
Date: Tue Jul 10 17:36:04 2007
New Revision: 75

Modified:
   trunk/funds/src/trees/avl.lisp
   trunk/funds/src/trees/bt.lisp
Log:
Moved some avl-specific functions from bt.lisp to avl.lisp.

Modified: trunk/funds/src/trees/avl.lisp
==============================================================================
--- trunk/funds/src/trees/avl.lisp	(original)
+++ trunk/funds/src/trees/avl.lisp	Tue Jul 10 17:36:04 2007
@@ -17,6 +17,23 @@
 
 (in-package :funds)
 
+
+(defun parent-height (t1 t2)
+  (let ((h1 (tree-height t1))
+	(h2 (tree-height t2)))
+    (1+ (if (> h1 h2) h1 h2))))
+
+(defun height-difference (t1 t2)
+  (- (tree-height t1) (tree-height t2)))
+
+(defun heavier-p (tree &key side)
+  (funcall (if (left-p side) #'plusp #'minusp)
+	   (height-difference (bt-left tree)
+			      (bt-right tree))))
+
+(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) 

Modified: trunk/funds/src/trees/bt.lisp
==============================================================================
--- trunk/funds/src/trees/bt.lisp	(original)
+++ trunk/funds/src/trees/bt.lisp	Tue Jul 10 17:36:04 2007
@@ -32,21 +32,3 @@
 		 tree
 		 (f (bt-left tree)))))
     (f (bt-right tree))))
-
-(defun parent-height (t1 t2)
-  (let ((h1 (tree-height t1))
-	(h2 (tree-height t2)))
-    (1+ (if (> h1 h2) h1 h2))))
-
-(defun balanced-p (t1 t2)
-  (< -2 (height-difference t1 t2) 2))
-
-(defun height-difference (t1 t2)
-  (- (tree-height t1) (tree-height t2)))
-
-(defun heavier-p (tree &key side)
-  (funcall (if (left-p side) #'plusp #'minusp)
-	   (height-difference (bt-left tree)
-			      (bt-right tree))))
-
-