[funds-cvs] r76 - trunk/funds/tests/trees

[abaine at common-lisp.net]

Author: abaine
Date: Tue Jul 10 22:19:09 2007
New Revision: 76

Modified:
   trunk/funds/tests/trees/avl-tree-test.lisp
Log:
Tests adapted to rewrite.

Modified: trunk/funds/tests/trees/avl-tree-test.lisp
==============================================================================
--- trunk/funds/tests/trees/avl-tree-test.lisp	(original)
+++ trunk/funds/tests/trees/avl-tree-test.lisp	Tue Jul 10 22:19:09 2007
@@ -15,56 +15,56 @@
 ;;;; limitations under the License.
 ;;;; 
 
-(in-package :funds.tests.trees)
+(in-package :funds-tests)
 
 (defun random-tree (&key (test #'eql) (order #'<))
   (reduce #'(lambda (tr v)
-	      (avl-insert  tr v v :test test :order order))
+	      (tree-insert  tr v v :test test :order order))
 	  (loop for i below 40 collect (random 20))
-	  :initial-value (empty-avl-tree)))
+	  :initial-value (make-avl-tree)))
 
 (defconstant +never-equal+ #'(lambda (a b) (declare (ignore a b)) nil))
 
 (defmacro assert-avl-valid (tree &key (order #'<))
   `(progn
-    (assert-true (height-correct-p ,tree) ,tree)
-    (assert-true (balanced-p ,tree) ,tree)
-    (assert-true (ordered-p ,tree :order ,order) ,tree)))
-
-(define-test test-avl-empty-p
-  (assert-true (avl-empty-p (empty-avl-tree)))
-  (assert-avl-valid (empty-avl-tree)))
+    (assert-true (height-correct-p ,tree) (funds::tree-as-pre-order-alist ,tree))
+    (assert-true (balanced-p ,tree) (funds::tree-as-pre-order-alist ,tree))
+    (assert-true (ordered-p ,tree :order ,order) (funds::tree-as-pre-order-alist ,tree))))
+
+(define-test test-tree-empty-p
+  (assert-true (tree-empty-p (make-avl-tree)))
+  (assert-avl-valid (make-avl-tree)))
 
-(define-test test-avl-insert
+(define-test test-tree-insert
   (let ((tree (random-tree)))
     (assert-avl-valid tree)))
 
 (defun height-correct-p (tree)
-  "Whether (avl-height tree) returns the correct height of the given 
+  "Whether (tree-height tree) returns the correct height of the given 
 AVL Tree.  The height is correct if (a) the tree is empty and zero
 is returned or (b) each of the following is true:
     1.  the height of the left sub-tree is correct;
     2.  the height of the right sub-tree is correct;
     3.  the height of the given tree is 1 more than the greater
         of the heights of the left and right sub-trees."
-  (or (and (avl-empty-p tree)
-	   (zerop (avl-height tree)))                ; (a)
-      (and (height-correct-p (avl-left tree))        ; (1)
-	   (height-correct-p (avl-right tree))       ; (2)
-	   (let* ((a (avl-height (avl-left tree)))
-		  (b (avl-height (avl-right tree)))
+  (or (and (tree-empty-p tree)
+	   (zerop (tree-height tree)))                ; (a)
+      (and (height-correct-p (funds::bt-left tree))        ; (1)
+	   (height-correct-p (funds::bt-right tree))       ; (2)
+	   (let* ((a (tree-height (funds::bt-left tree)))
+		  (b (tree-height (funds::bt-right tree)))
 		  (c (if (> a b) a b))) 
-	     (eql (1+ c) (avl-height tree))))))      ; (3)
+	     (eql (1+ c) (tree-height tree))))))      ; (3)
 
 (defun balanced-p (tree)
   "Whether the given AVL Tree is properly balanced.  To be balanced,
 the tree must be either (a) empty or (b) have left and right sub-trees
 that differ in height by no more than 1."
-  (or (avl-empty-p tree)
-      (and (balanced-p (avl-left tree))
-	   (balanced-p (avl-right tree))
-	   (< -2 (- (avl-height (avl-left tree))
-		    (avl-height (avl-right tree)))
+  (or (tree-empty-p tree)
+      (and (balanced-p (funds::bt-left tree))
+	   (balanced-p (funds::bt-right tree))
+	   (< -2 (- (tree-height (funds::bt-left tree))
+		    (tree-height (funds::bt-right tree)))
 	      2))))
 
 (defun ordered-p (tree &key (order #'<))
@@ -78,24 +78,24 @@
         the root key; and
     4.  every key in the right sub-tree is not less
         than the root key."
-  (or (avl-empty-p tree)
-      (and (ordered-p (avl-left tree))
-	   (ordered-p (avl-right tree))
-	   (or (avl-empty-p (avl-left tree))
-	       (not (funcall order (avl-key tree)
-			     (greatest-key (avl-left tree)))))
-	   (or (avl-empty-p (avl-right tree))
-	       (not (funcall order (least-key (avl-right tree))
-			     (avl-key tree)))))))
+  (or (tree-empty-p tree)
+      (and (ordered-p (funds::bt-left tree))
+	   (ordered-p (funds::bt-right tree))
+	   (or (tree-empty-p (funds::bt-left tree))
+	       (not (funcall order (funds::bt-key tree)
+			     (greatest-key (funds::bt-left tree)))))
+	   (or (tree-empty-p (funds::bt-right tree))
+	       (not (funcall order (least-key (funds::bt-right tree))
+			     (funds::bt-key tree)))))))
 
 (defun least-key (tree)
   "The least key in a properly ordered AVL tree."
-  (if (avl-empty-p (avl-left tree))
-      (avl-key tree)
-      (least-key (avl-left tree))))
+  (if (tree-empty-p (funds::bt-left tree))
+      (funds::bt-key tree)
+      (least-key (funds::bt-left tree))))
 
 (defun greatest-key (tree)
   "The greatest key in a properly ordered AVL tree."
-  (if (avl-empty-p (avl-right tree))
-      (avl-key tree)
-      (greatest-key (avl-right tree))))
+  (if (tree-empty-p (funds::bt-right tree))
+      (funds::bt-key tree)
+      (greatest-key (funds::bt-right tree))))