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

[abaine at common-lisp.net]

Author: abaine
Date: Wed Jul 11 17:04:06 2007
New Revision: 91

Modified:
   trunk/funds/src/trees/tree-remove.lisp
Log:
Greatly simplified avl-remove.

Modified: trunk/funds/src/trees/tree-remove.lisp
==============================================================================
--- trunk/funds/src/trees/tree-remove.lisp	(original)
+++ trunk/funds/src/trees/tree-remove.lisp	Wed Jul 11 17:04:06 2007
@@ -29,11 +29,17 @@
   tree)
 
 (defmethod tree-remove ((tree binary-tree) key &key (test #'eql) (order #'<))
-  (cond ((funcall test key (bt-key tree))
-	 (remove-root tree :order order :test test))
-	((funcall order key (bt-key tree))
-	 (remove-side tree key :test test :order order :side :left))
-	(t (remove-side tree key :test test :order order :side :right))))
+  (if (funcall test key (bt-key tree))
+      (remove-root tree :order order :test test)
+      (let* ((side (if (funcall order key (bt-key tree))
+		      :left
+		      :right))
+	     (other-side (other-side side)))
+	(attach-bt 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))
@@ -47,34 +53,13 @@
 	       (outside (tree-child temp :side heavy-side)))
 	  (balance inside temp outside :heavy-side heavy-side)))))
 
-
-(defmethod remove-root ((tree binary-tree) &key test order)
+(defun remove-root (tree &key test order)
   (cond ((tree-empty-p (bt-left tree)) (bt-right tree))
 	((tree-empty-p (bt-right tree)) (bt-left tree))
 	(t (remove-root-with-children tree :test test :order order))))
 
-(defmethod remove-side ((tree binary-tree) key &key test order side)
-  (make-instance 'binary-tree
-		 :key (bt-key tree)
-		 :value (bt-value tree)
-		 side (tree-remove (tree-child tree :side side) key 
-				   :test test :order order)
-		 (other-side side) (tree-child tree :side (other-side side))))
-
-(defmethod remove-root-with-children ((tree binary-tree) &key test order)
-  (let* ((next (next-in-order tree))
-	 (k (bt-key next)))
-    (make-instance 'binary-tree
-		   :key k
-		   :value (bt-value next)
-		   :left (bt-left tree)
-		   :right (tree-remove (bt-right tree) k :test test :order order))))
-
-(defmethod remove-root-with-children ((tree avl-tree) &key test order)
-  (let* ((next (next-in-order tree))
-	 (k (bt-key next)))
-    (make-avl-tree :key k
-		   :value (bt-value next)
-		   :left (bt-left tree)
-		   :right (tree-remove (bt-right tree) k :test test :order order))))
-
+(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))))