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