Author: abaine Date: Tue Jul 10 23:18:01 2007 New Revision: 80
Modified: trunk/funds/src/trees/tree-insert.lisp Log: Greatly simplified tree-insert.
Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Tue Jul 10 23:18:01 2007 @@ -38,31 +38,34 @@
(defmethod tree-insert ((tree binary-tree) key value &key (test #'eql) (order #'<)) - (cond ((funcall test key (bt-key tree)) - (make-instance 'binary-tree - :key key - :value value - :left (bt-left tree) - :right (bt-right tree))) - ((funcall order key (bt-key tree)) - (insert tree key value - :test test :order order :side :left)) - (t (insert tree key value - :test test :order order :side :right)))) + (if (funcall test key (bt-key tree)) + (make-instance 'binary-tree + :key key + :value value + :left (bt-left tree) + :right (bt-right tree)) + (let* ((side (if (funcall order key (bt-key tree)) + :left + :right)) + (other-side (other-side side))) + (attach-bt tree + side (tree-insert (tree-child tree :side side) key value + :test test + :order order) + other-side (tree-child tree :side other-side)))))
-(defmethod insert ((tree binary-tree) key value &key test order side) - (make-instance 'binary-tree - :key (bt-key tree) - :value (bt-value tree) - side (tree-insert (tree-child tree :side side) - key value - :test test - :order order) - (other-side side) (tree-child tree :side (other-side side)))) - -(defmethod insert ((tree avl-tree) key value &key test order side) - (declare (ignore test order)) - (let* ((temp (call-next-method)) ; the temp object will be a bt, not an avl tree. - (outside (tree-child temp :side side)) - (inside (tree-child temp :side (other-side side)))) - (balance inside temp outside :heavy-side side))) +(defmethod tree-insert ((tree avl-tree) key value + &key (test #'eql) (order #'<)) + (if (funcall test key (bt-key tree)) + (make-avl-tree :key key + :value value + :left (bt-left tree) + :right (bt-right tree)) + (let* ((temp (call-next-method)) + (side (if (funcall order key (bt-key tree)) + :left + :right)) + (outside (tree-child temp :side side)) + (inside (tree-child temp :side (other-side side)))) + (balance inside temp outside :heavy-side side)))) +