;;; -*-lisp-*-
;;;
-;;; $Id$
-;;;
;;; Heap data structure; useful for priority queues and suchlike
;;;
;;; (c) 2006 Straylight/Edgeware
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:heap
- (:use #:common-lisp)
- (:export #:make-heap #:heap-count #:heap-empty-p
- #:heap-insert #:heap-head #:heap-remove
- #:heap-sort))
+ (:use #:common-lisp))
(in-package #:heap)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;;; High-level heap things
+(export '(heap heapp))
(defstruct (heap (:predicate heapp) (:constructor %make-heap))
"Data structure for a heap."
(v (make-array 16) :type vector)
(n 0 :type index)
- (key #'identity :type function)
- (compare #'<= :type function))
+ (key #'identity :type function :read-only t)
+ (compare #'<= :type function :read-only t))
+(export 'make-heap)
(defun make-heap
(&key (compare #'<=) (key #'identity)
(type 't) (init-size 16) (contents nil contentsp))
:initial-value 0))
(%make-heap :compare compare :key key :n n :v v))))
+(export 'heap-count)
(defun heap-count (heap)
"Return the number of elements in HEAP."
(declare (type heap heap))
(heap-n heap))
+(export 'heap-empty-p)
(defun heap-empty-p (heap)
"True if HEAP is empty."
(declare (type heap heap))
(zerop (heap-count heap)))
+(export 'heap-insert)
(defun heap-insert (heap item)
"Insert ITEM into the HEAP."
(declare (type heap heap))
(upheap v (heap-key heap) (heap-compare heap) n item)
(setf (heap-n heap) (1+ n))))
+(export 'heap-head)
(defun heap-head (heap)
"Peep at the head item on HEAP."
(declare (type heap heap))
(assert (not (heap-empty-p heap)))
(aref (heap-v heap) 0))
+(export 'heap-remove)
(defun heap-remove (heap)
"Remove the head item from HEAP and return it."
(declare (type heap heap))
(setf (heap-n heap) n)
(downheap v (heap-key heap) (heap-compare heap) n (aref v n)))))
+(export 'heap-sort)
(defun heap-sort (items compare &key (key #'identity))
"Return the ITEMS, least-first, as sorted by the ordering COMPARE."
(let ((heap (make-heap :compare compare :contents items :key key)))