Author: abaine Date: Wed Jul 11 21:28:26 2007 New Revision: 94 Added: trunk/funds/src/trees/heap/heap.lisp Modified: trunk/funds/src/funds.asd trunk/funds/src/trees/heap/heap-insert.lisp trunk/funds/src/trees/heap/heap-remove.lisp Log: Eliminated attach-heap from heap-remove.lisp; moved attach-heap from heap-insert.lisp to heap.lisp; made sure that all calls were consistent. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Wed Jul 11 21:28:26 2007 @@ -42,7 +42,8 @@ (:file "tree-height") (:module heap :serial t - :components ((:file "heap-empty-p") + :components ((:file "heap") + (:file "heap-empty-p") (:file "heap-insert") (:file "heap-remove") (:file "heap-first"))))) Modified: trunk/funds/src/trees/heap/heap-insert.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-insert.lisp (original) +++ trunk/funds/src/trees/heap/heap-insert.lisp Wed Jul 11 21:28:26 2007 @@ -33,8 +33,8 @@ (if (funcall order (bt-key h1) (bt-key heap)) ; if we need to bubble up (attach-heap h1 side (attach-heap heap - :left (bt-left h1) - :right (bt-right h1)) + :left (bt-left h1) + :right (bt-right h1)) other-side h2) (attach-heap heap side h1 @@ -51,9 +51,3 @@ (if (< (- n (expt 2 lg)) (expt 2 (1- lg))) :left :right))) - -(defun attach-heap (root &key left right) - (make-heap :priority (heap-priority root) - :value (bt-value heap) - :left left - :right right)) Modified: trunk/funds/src/trees/heap/heap-remove.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-remove.lisp (original) +++ trunk/funds/src/trees/heap/heap-remove.lisp Wed Jul 11 21:28:26 2007 @@ -38,26 +38,20 @@ (or (heap-empty-p right) (in-order-p left right :order order))) (attach-heap left - (bubble-down root + :left (bubble-down root :left (bt-left left) :right (bt-right left) :order order) - right)) + :right right)) ((and (not (heap-empty-p right)) (in-order-p right root :order order)) (attach-heap right - left - (bubble-down root + :left left + :right (bubble-down root :left (bt-left right) :right (bt-right right) :order order))) - (t (attach-heap root left right)))) - -(defun attach-heap (root left right) - (make-heap :priority (heap-priority root) - :value (bt-value root) - :left left - :right right)) + (t (attach-heap root :left left :right right)))) (defun in-order-p (h1 h2 &key order) (funcall order (heap-priority h1) (heap-priority h2))) Added: trunk/funds/src/trees/heap/heap.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap.lisp Wed Jul 11 21:28:26 2007 @@ -0,0 +1,8 @@ + +(in-package :funds) + +(defun attach-heap (root &key left right) + (make-heap :priority (heap-priority root) + :value (bt-value root) + :left left + :right right))