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

abaine at common-lisp.net abaine at common-lisp.net
Thu Aug 2 19:38:18 UTC 2007


Author: abaine
Date: Thu Aug  2 15:38:18 2007
New Revision: 110

Modified:
   trunk/funds/src/trees/tree-remove.lisp
Log:
Deleted avl specializer
for tree-remove because general bt method works fine; replaced attach-bt forms with
stitch-tree.

Modified: trunk/funds/src/trees/tree-remove.lisp
==============================================================================
--- trunk/funds/src/trees/tree-remove.lisp	(original)
+++ trunk/funds/src/trees/tree-remove.lisp	Thu Aug  2 15:38:18 2007
@@ -35,23 +35,11 @@
 		      :left
 		      :right))
 	     (other-side (other-side side)))
-	(attach-bt tree
-		   side (tree-remove (tree-child tree :side side) key
+	(stitch-tree tree
+		     side (tree-remove (tree-child tree :side side) key
 				     :test test
 				     :order order)
-		   other-side (tree-child tree :side other-side)))))
-
-(defmethod tree-remove ((tree avl-tree) key &key (test #'eql) (order #'<))
-  (declare (ignore test order))
-  (let ((temp (call-next-method)))
-    (if (tree-empty-p temp)
-	(make-avl-tree)
-	(let* ((heavy-side (if (heavier-p temp :side :left)
-			       :left
-			       :right))
-	       (inside (tree-child temp :side (other-side heavy-side)))
-	       (outside (tree-child temp :side heavy-side)))
-	  (balance inside temp outside :heavy-side heavy-side)))))
+		     other-side (tree-child tree :side other-side)))))
 
 (defun remove-root (tree &key test order)
   (cond ((tree-empty-p (bt-left tree)) (bt-right tree))
@@ -60,6 +48,6 @@
 
 (defun remove-root-with-children (tree &key test order)
   (let* ((next (next-in-order tree)))
-    (attach-bt next
-	       :left (bt-left tree)
-	       :right (tree-remove (bt-right tree) (bt-key next) :test test :order order))))
+    (stitch-tree next
+		 :left (bt-left tree)
+		 :right (tree-remove (bt-right tree) (bt-key next) :test test :order order))))



More information about the Funds-cvs mailing list