Author: abaine Date: Fri Jun 15 13:57:14 2007 New Revision: 14
Modified: trunk/funds/src/trees/tests/avl-tree-test.lisp Log: Wrote unit tests for insert and empty
Modified: trunk/funds/src/trees/tests/avl-tree-test.lisp ============================================================================== --- trunk/funds/src/trees/tests/avl-tree-test.lisp (original) +++ trunk/funds/src/trees/tests/avl-tree-test.lisp Fri Jun 15 13:57:14 2007 @@ -4,29 +4,80 @@ (defun random-tree () (reduce #'(lambda (tr v) (avl-insert tr v v)) - (loop for i below 100 collect (random 10000)) + (loop for i below 20 collect (random 10)) :initial-value (empty-avl-tree)))
-(define-test empty-avl-tree - (assert-true (avl-empty-p (empty-avl-tree))) - (assert-equal 0 (avl-height (empty-avl-tree)))) - +(defmacro assert-avl-valid (tree) + `(progn + (assert-true (height-correct-p ,tree) ,tree) + (assert-true (balanced-p ,tree) ,tree) + (assert-true (ordered-p ,tree) ,tree)))
-(define-test avl-insert - (assert-true (balanced (random-tree)))) +(define-test test-avl-empty-p + (assert-true (avl-empty-p (empty-avl-tree))) + (assert-avl-valid (empty-avl-tree)))
-(defun balanced (tree) +(define-test test-avl-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 +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." + (if (avl-empty-p tree) + (zerop (avl-height tree)) + (and (height-correct-p (avl-left tree)) + (height-correct-p (avl-right tree)) + (let* ((a (avl-height (avl-left tree))) + (b (avl-height (avl-right tree))) + (c (if (> a b) a b))) + (eql (1+ c) (avl-height tree)))))) + +(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 (avl-left tree)) - (balanced (avl-right tree)) + (and (balanced-p (avl-left tree)) + (balanced-p (avl-right tree)) (< -2 (- (avl-height (avl-left tree)) (avl-height (avl-right tree))) 2))))
- -(defun root-height-correct (tree) - (let* ((a (avl-height (avl-left tree))) - (b (avl-height (avl-right tree))) - (c (if (> a b) a b))) - (eql (1+ c) (avl-height tree)))) - +(defun ordered-p (tree &optional (less-than #'<)) + "Whether this AVL tree is properly ordered. To be ordered, +the tree must be either (a) empty or (b) satisfy each of the following +requirements: + + 1. the left sub-tree is properly ordered; + 2. the right sub-tree is properly ordered; + 3. every key in the left sub-tree is less than + 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 less-than (avl-key tree) + (greatest-key (avl-left tree))))) + (or (avl-empty-p (avl-right tree)) + (not (funcall less-than (least-key (avl-right tree)) + (avl-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)))) + +(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))))