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