[Cl-heap-cvs] r16 - cl-heap/tags/release-0.1.5
rneeser at common-lisp.net
rneeser at common-lisp.net
Wed Apr 4 04:43:51 UTC 2012
Author: rneeser
Date: Tue Apr 3 21:43:50 2012
New Revision: 16
Log:
Tagged the 0.1.5 release
Added:
cl-heap/tags/release-0.1.5/
- copied from r14, cl-heap/trunk/
Replaced:
cl-heap/tags/release-0.1.5/AUTHORS
- copied unchanged from r15, cl-heap/trunk/AUTHORS
cl-heap/tags/release-0.1.5/ChangeLog
- copied unchanged from r15, cl-heap/trunk/ChangeLog
cl-heap/tags/release-0.1.5/cl-heap-tests.asd
- copied unchanged from r15, cl-heap/trunk/cl-heap-tests.asd
cl-heap/tags/release-0.1.5/cl-heap.asd
- copied unchanged from r15, cl-heap/trunk/cl-heap.asd
cl-heap/tags/release-0.1.5/fibonacci-heap.lisp
- copied unchanged from r15, cl-heap/trunk/fibonacci-heap.lisp
cl-heap/tags/release-0.1.5/heap.lisp
- copied unchanged from r15, cl-heap/trunk/heap.lisp
Copied: cl-heap/tags/release-0.1.5/AUTHORS (from r15, cl-heap/trunk/AUTHORS)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/AUTHORS Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/AUTHORS)
@@ -0,0 +1,5 @@
+Authors:
+ Rudolph Neeser <rudy.neeser at gmail.com>
+
+Contributors:
+ Michał Psota
\ No newline at end of file
Copied: cl-heap/tags/release-0.1.5/ChangeLog (from r15, cl-heap/trunk/ChangeLog)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/ChangeLog Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/ChangeLog)
@@ -0,0 +1,40 @@
+2012-03-31 Rudy Neeser <rudy.neeser at gmail.com>
+
+ * cl-heap-tests.asd (:cl-heap-tests): Updated version number to
+ 0.1.5
+
+ * cl-heap.asd (:cl-heap): Updated version number to 0.1.5
+
+ * heap.lisp (print-object):
+ Removed unnecessary slot accessor. Patch by Michał Psota.
+
+ * fibonacci-heap.lisp (concatenate-node-lists):
+ Removed unnecessary slot accessors. Patch by Michał Psota.
+
+2010-09-04 Rudy Neeser <rudy.neeser at gmail.com>
+
+ * binary-heap.lisp (children-positions, parent-position)
+ (percolate-down, percolate-up, decrease-key, delete-from-heap):
+ Changed the specialising class for various index arguments to
+ these functions from FIXNUM to INTEGER in order to increase
+ portabilty.
+
+2010-03-17 Rudy Neeser <rudy.neeser at gmail.com>
+
+ * cl-heap-tests.asd: Added a new system definition file to run the
+ testing framework for the package.
+
+ * cl-heap.asd: Removed the automatic loading of the testing
+ framework.
+
+2009-12-20 Rudy Neeser <rudy.neeser at gmail.com>
+
+ * binary-heap.lisp (add-to-heap, add-all-to-heap): Fixed a bug in
+ updating the size of the DATA array in the BINARY-HEAP class.
+
+2009-06-18 Rudy Neeser <rudy.neeser at gmail.com>
+
+ * fibonacci-heap.lisp (pop-heap): Fixed a bug which created an
+ array one size too small, causing POP-HEAP operations to
+ intermittently fail.
+
Copied: cl-heap/tags/release-0.1.5/cl-heap-tests.asd (from r15, cl-heap/trunk/cl-heap-tests.asd)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/cl-heap-tests.asd Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/cl-heap-tests.asd)
@@ -0,0 +1,37 @@
+;;; -*- Mode: Lisp; -*-
+;;;
+;;; Copyright 2009-2010, 2012 Rudolph Neeser <rudy.neeser at gmail.com>
+;;;
+;;; This file is part of CL-HEAP
+;;;
+;;; CL-HEAP is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; CL-HEAP is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with CL-HEAP. If not, see <http://www.gnu.org/licenses/>.
+
+;;;----------------------------------------------------------------
+
+
+(defpackage #:cl-heap-tests-asdf
+ (:use :common-lisp :asdf))
+
+(in-package #:cl-heap-tests-asdf)
+
+(defsystem :cl-heap-tests
+ :description "Tests for the CL-HEAP package, an implementation of
+ heap and priority queue data structures."
+ :version "0.1.5"
+ :author "Rudy Neeser <rudy.neeser at gmail.com>"
+ :license "GPLv3"
+ :depends-on (:xlunit :cl-heap)
+ :serial t
+ :components ((:file "tests")))
+
Copied: cl-heap/tags/release-0.1.5/cl-heap.asd (from r15, cl-heap/trunk/cl-heap.asd)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/cl-heap.asd Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/cl-heap.asd)
@@ -0,0 +1,40 @@
+;;; -*- Mode: Lisp; -*-
+;;;
+;;; Copyright 2009-2010, 2012 Rudolph Neeser <rudy.neeser at gmail.com>
+;;;
+;;; This file is part of CL-HEAP
+;;;
+;;; CL-HEAP is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; CL-HEAP is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with CL-HEAP. If not, see <http://www.gnu.org/licenses/>.
+
+;;;----------------------------------------------------------------
+
+
+(defpackage #:cl-heap-asdf
+ (:use :common-lisp :asdf))
+
+(in-package #:cl-heap-asdf)
+
+(defsystem :cl-heap
+ :description "An implementation of heap and priority queue data structures."
+ :version "0.1.5"
+ :author "Rudy Neeser <rudy.neeser at gmail.com>"
+ :license "GPLv3"
+ :serial t
+ :components ((:file "package")
+ (:file "condition")
+ (:file "heap")
+ (:file "binary-heap")
+ (:file "fibonacci-heap")
+ (:file "priority-queue")))
+
Copied: cl-heap/tags/release-0.1.5/fibonacci-heap.lisp (from r15, cl-heap/trunk/fibonacci-heap.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/fibonacci-heap.lisp Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/fibonacci-heap.lisp)
@@ -0,0 +1,388 @@
+;;; Copyright 2009-2010 Rudolph Neeser <rudy.neeser at gmail.com>.
+;;; Copyright 2012 CL-HEAP (See AUTHORS file).
+;;;
+;;; This file is part of CL-HEAP
+;;;
+;;; CL-HEAP is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; CL-HEAP is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with CL-HEAP. If not, see <http://www.gnu.org/licenses/>.
+
+;;;----------------------------------------------------------------
+
+(in-package #:cl-heap)
+
+;;;----------------------------------------------------------------
+
+(defclass fibonacci-heap (heap)
+ ((root :initform nil
+ :documentation "The minimum element in the tree.")
+ (count :initform 0
+ :documentation "The number of items in the heap."))
+ (:documentation "A heap made up of item-disjoint, heap-ordered
+ trees. Has some good time constraints on various heap operations."))
+
+;;;----------------------------------------------------------------
+
+(defclass node ()
+ ((item :initform nil
+ :initarg :item
+ :accessor node-item)
+ (parent :initform nil
+ :accessor node-parent)
+ (child :initform nil
+ :accessor node-child)
+ (rank :initform 0
+ :accessor node-rank
+ :documentation "The number of children the node has.")
+ (marked :initform nil
+ :accessor node-marked-p
+ :documentation "Used to implement cascading cuts.")
+ (next :initform nil
+ :accessor node-next)
+ (last :initform nil
+ :accessor node-last))
+ (:documentation "A class used for storing data in a FIBONACCI-HEAP."))
+
+(defmethod initialize-instance :after ((node node) &key)
+ (with-slots (next last) node
+ (setf next node
+ last node)))
+
+(defmethod print-object ((node node) stream)
+ (print-unreadable-object (node stream :type t :identity t)
+ (format stream "Item: ~a" (slot-value node 'item))))
+
+;;;----------------------------------------------------------------
+;;; Unexported functions for handling nodes.
+
+(defgeneric unmark-node (node)
+ (:method ((node node))
+ (setf (node-marked-p node) nil)))
+
+(defgeneric mark-node (node)
+ (:method ((node node))
+ (setf (node-marked-p node) t)))
+
+(defgeneric is-node-root-p (node)
+ (:method ((node node))
+ (null (node-parent node))))
+
+(defgeneric concatenate-node-lists (lhs rhs)
+ (:method ((lhs node) (rhs null))
+ lhs)
+ (:method ((lhs null) (rhs node))
+ rhs)
+ (:method ((lhs node) (rhs node))
+ (psetf (node-next lhs) rhs
+ (node-last (node-next lhs)) (node-last rhs)
+ (node-last rhs) lhs
+ (node-next (node-last rhs)) (node-next lhs))
+ lhs))
+
+
+(defgeneric delete-node (node)
+ (:documentation "Deletes this node from the linked list that it
+ represents, and returns the new list. Nulls the node's parent, and
+ resets its rank if appropriate.")
+ (:method ((node null))
+ nil)
+ (:method ((node node))
+ (with-slots (next last parent) node
+ (let ((result (when (not (eq next node))
+ next)))
+ (when result ; There was something to delete.
+ (psetf (node-last next) last
+ (node-next last) next
+ next node
+ last node))
+ (when parent ; Remove the item from any parents.
+ (decf (node-rank parent))
+ (when (eq (node-child parent) node)
+ (setf (node-child parent) result))
+ (setf parent nil))
+ result))))
+
+
+
+(defmacro do-each-node ((symbol node) &body body)
+ (let ((node node)
+ (last (gensym))
+ (next (gensym)))
+ `(when ,node
+ (loop
+ with ,last = (node-last ,node)
+ for ,symbol = ,node then ,next
+ for ,next = (node-next ,node) then (node-next ,next)
+ while (not (eq ,symbol ,last))
+ do (progn
+ , at body)
+ finally (progn
+ , at body)))))
+
+
+;;;--------------------
+;;; Unexported functions
+
+(defgeneric meld (one two)
+ (:documentation "Joins together two fibonacci heaps."))
+
+;; This should not increase the heap's count of its items, since it's
+;; used in areas such as linking, where this must not occur.
+(defmethod meld ((heap fibonacci-heap) (item node))
+ "Adds a node to the heap."
+ (with-slots (root) heap
+ (cond
+ ((null root)
+ (setf root item))
+ ((compare-items heap (node-item root) (node-item item))
+ (setf root (concatenate-node-lists root item)))
+ (t
+ (setf root (concatenate-node-lists item root)))))
+ heap)
+
+;; This should adjust the heap's count of its children, since it's use
+;; only makes sense in places where more items are added.
+(defmethod meld ((heap1 fibonacci-heap) (heap2 fibonacci-heap))
+ (with-slots ((heap1-root root)
+ (heap1-count count)) heap1
+ (with-slots ((heap2-root root)
+ (heap2-count count)) heap2
+ (setf heap1-root (concatenate-node-lists heap1-root heap2-root))
+ (unless (compare-items heap1 (node-item heap1-root) (node-item heap2-root))
+ (setf heap1-root heap2-root
+ heap1-count (+ heap1-count heap2-count))))))
+
+(defgeneric link (heap node-one node-two)
+ (:documentation "Places node-two as a child of node-one if
+ node-one's item is smaller, or vice versa.")
+ (:method ((heap fibonacci-heap) (node-one node) (node-two node))
+ (with-slots ((one-child child)
+ (one-item item)
+ (one-rank rank)) node-one
+ (with-slots ((two-child child)
+ (two-item item)
+ (two-rank rank)) node-two
+ (cond
+ ((compare-items heap one-item two-item)
+ (delete-node node-two)
+ (unless (is-node-root-p node-two)
+ (unmark-node node-two))
+ (setf one-child (concatenate-node-lists one-child node-two)
+ (node-parent node-two) node-one)
+ (incf one-rank)
+ node-one)
+ (t
+ (delete-node node-one)
+ (setf two-child (concatenate-node-lists two-child node-one)
+ (node-parent node-one) node-two)
+ (incf two-rank)
+ node-two))))))
+
+(defgeneric cut-node (heap node)
+ (:documentation "Cuts a child from its parent and makes and places
+ it in the root list.")
+ (:method ((heap fibonacci-heap) (node node))
+ (let ((parent (node-parent node)))
+ (with-slots (root) heap
+ (delete-node node)
+ (concatenate-node-lists root node)
+ (cond
+ ((and parent (not (is-node-root-p parent)) (node-marked-p parent))
+ (cut-node heap parent))
+ ((and parent (not (is-node-root-p parent)))
+ (mark-node parent)
+ heap))))))
+
+
+;;;----------------------------------------------------------------
+;;; Exported Functions
+
+(defmethod empty-heap ((heap fibonacci-heap))
+ "Clears all items from the heap. This is a constant time operation."
+ (with-slots (root count) heap
+ (setf root nil
+ count 0))
+ heap)
+
+(defmethod is-empty-heap-p ((heap fibonacci-heap))
+ (unless (slot-value heap 'root)
+ t))
+
+(defmethod heap-size ((heap fibonacci-heap))
+ (slot-value heap 'count))
+
+(defmethod add-to-heap ((heap fibonacci-heap) item)
+ "Adds an item to a Fibonacci-heap. This is a constant time
+operation. Returns the item added to the heap."
+ (let ((node (make-instance 'node :item item)))
+ (meld heap node)
+ (incf (slot-value heap 'count))
+ (values item node)))
+
+(defmethod add-all-to-heap ((heap fibonacci-heap) (items list))
+ "Adds the following list of items into the heap. This is an O(n) operation."
+ (with-slots (count) heap
+ (loop for i in items
+ do (progn
+ (meld heap (make-instance 'node :item i))
+ (incf count))))
+ heap)
+
+(defmethod peep-at-heap ((heap fibonacci-heap))
+ "See the heap's minimum value without modifying the heap. This is a
+constant time operation."
+ (with-slots (root) heap
+ (when root
+ (node-item root))))
+
+(defmethod pop-heap ((heap fibonacci-heap))
+ "Remove the minimum element in the tree. This has an amortised
+running time of O(log(n)), where n is the number of items in the
+heap."
+ (unless (is-empty-heap-p heap)
+ (let ((item (peep-at-heap heap)))
+ (with-slots (root count) heap
+ ;; Delete the minimum.
+ (concatenate-node-lists root (node-child root))
+ (setf root (delete-node root))
+ (when root
+ (let ((ranks (make-array (1+ (ceiling (log count 2))) :initial-element nil))
+ (min nil))
+ ;; Merge all trees of the same rank.
+ (labels ((sort-node (node)
+ (let ((position (node-rank node)))
+ (cond
+ ((aref ranks position)
+ (let ((new (link heap node (aref ranks position))))
+ (setf (aref ranks position) nil)
+ (sort-node new)))
+ (t
+ (setf (aref ranks position) node))))))
+ (do-each-node (node root)
+ ;; The newly added nodes should not have a parent
+ (setf (node-parent node) nil)
+ (delete-node node)
+ (sort-node node)))
+ (loop for tree across ranks
+ do (when (not (null tree))
+ (cond
+ ((null min)
+ (setf min tree))
+ ((compare-items heap
+ (node-item min)
+ (node-item tree))
+
+ (setf min (concatenate-node-lists min tree)))
+ (t
+ (setf min (concatenate-node-lists tree min))))))
+ (setf root min)))
+ (decf (slot-value heap 'count))
+ item))))
+
+
+(defmethod nmerge-heaps ((first fibonacci-heap) (second fibonacci-heap))
+ "Destructively marges the two heaps. This is a constant time
+operation."
+ (with-slots ((first-root root)
+ (first-key key)
+ (first-fun sort-fun)) first
+ (with-slots ((second-root root)
+ (second-key key)
+ (second-fun sort-fun)) second
+ (unless (and (eq first-key second-key)
+ (eq first-fun second-fun))
+ (error 'heap-error :message "These two heaps were constructed using different
+ access keys and sorting functions."))))
+ (meld first second)
+ first)
+
+(defmethod merge-heaps ((first fibonacci-heap) (second fibonacci-heap))
+ "Returns the merge of the two given heaps. This operation runs in
+O(n + m), where n and m are the number of items in each heap."
+ (with-slots ((first-root root)
+ (first-key key)
+ (first-fun sort-fun)) first
+ (with-slots ((second-root root)
+ (second-key key)
+ (second-fun sort-fun)) second
+ (unless (and (eq first-key second-key)
+ (eq first-fun second-fun))
+ (error 'heap-error :message "These two heaps were constructed using different
+ access keys and sorting functions."))
+ (let ((result (make-instance 'fibonacci-heap
+ :sort-fun first-fun
+ :key first-key)))
+ (labels ((add-from-level (node-list)
+ (when node-list
+ (do-each-node (node node-list)
+ (add-from-level (node-child node))
+ (add-to-heap result (node-item node))))))
+ (add-from-level first-root)
+ (add-from-level second-root))
+ result))))
+
+;;; This method decreases the node's key, removes the node from the
+;;; tree and adds it to the root list (unless this is of course where
+;;; the node originally was.
+(defmethod decrease-key ((heap fibonacci-heap) (item-index node) value)
+ "Changes the value of an item represented by the ITEM-INDEX to
+ VALUE. This index is returned as the second argument to
+ ADD-TO-HEAP. This is an amortised constant time operation."
+ (with-slots (key sort-fun) heap
+ (unless (funcall sort-fun value (funcall key (node-item item-index)))
+ (error 'key-error :message
+ (format nil "The given value (~a) must be less than the current value (~a)."
+ value (funcall key (node-item item-index)))))
+ (if (eq key #'identity)
+ (setf (node-item item-index) value)
+ (handler-case
+ (funcall key (node-item item-index) value)
+ (error (e)
+ (declare (ignore e))
+ (error 'key-error))))
+ (cond
+ ;; A child of something. See if cascading cuts should occur.
+ ((node-parent item-index)
+ (let ((parent (node-parent item-index)))
+ (delete-node item-index)
+ (meld heap item-index)
+ (when (not (is-node-root-p parent))
+ (if (node-marked-p parent)
+ (cut-node heap parent)
+ (mark-node parent)))))
+ (t ; In the list with the root.
+ (with-slots (root) heap
+ (unless (compare-items heap (node-item root) (node-item item-index))
+ (setf root item-index))))))
+ heap)
+
+(defmethod delete-from-heap ((heap fibonacci-heap) (item-index node))
+ "Removes an item from the heap, as pointed to by item-index. This
+ operation is amortised O(1), unless the item removed is the minimum item, in
+ which case the operation is equivalent to a POP-HEAP."
+ (with-slots (root count) heap
+ (let ((parent (node-parent item-index)))
+ (cond
+ ((eq root item-index)
+ (pop-heap heap))
+ (t
+ (do-each-node (child (node-child item-index))
+ (setf (node-parent child) nil))
+ ;; Add children to root level.
+ (concatenate-node-lists root (node-child item-index))
+ (delete-node item-index)
+ (decf count)))
+ (when (and parent (not (is-node-root-p parent)))
+ (if (node-marked-p parent)
+ (cut-node heap parent)
+ (mark-node parent)))))
+ heap)
Copied: cl-heap/tags/release-0.1.5/heap.lisp (from r15, cl-heap/trunk/heap.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cl-heap/tags/release-0.1.5/heap.lisp Tue Apr 3 21:43:50 2012 (r16, copy of r15, cl-heap/trunk/heap.lisp)
@@ -0,0 +1,118 @@
+;;; Copyright 2009-2010 Rudolph Neeser <rudy.neeser at gmail.com>.
+;;; Copyright 2012 CL-HEAP (See AUTHORS file).
+;;;
+;;; This file is part of CL-HEAP
+;;;
+;;; CL-HEAP is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; CL-HEAP is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with CL-HEAP. If not, see <http://www.gnu.org/licenses/>.
+
+;;;----------------------------------------------------------------
+
+(in-package #:cl-heap)
+
+;;;--------------------------------------------------------------------
+;;; Some useful definitions: Through the use of SORT-FUN, each HEAP
+;;; can be used as either a min or a max heap, or even as something
+;;; abstract by defining an arbitrary total relation on the objects
+;;; being inserted into the heap. For any relation R and two items x
+;;; and y for which x R y is a true, we will call x the lesser of the
+;;; two items.
+;;; --------------------------------------------------------------------
+
+(defclass heap ()
+ ((sort-fun :initform #'<
+ :reader heap-sorting-function
+ :initarg :sort-fun
+ :documentation "The function used to apply an order to
+ elements in the heap.")
+ (key :initform #'identity
+ :reader heap-key
+ :initarg :key
+ :documentation "A function used to obtain the elements which
+ should be compared to give an order to the items in the
+ heap."))
+ (:documentation "The base type of the two HEAP implementations."))
+
+;;;--------------------------------------------------------------------
+;;; Exported functions.
+
+(defgeneric heap-size (heap)
+ (:documentation "Returns the number of elements in the heap."))
+
+(defgeneric add-to-heap (heap item)
+ (:documentation "Inserts an item into the given HEAP data
+ structure. Returns two values: first, the item added, and then an
+ index-key which can be used to identify the item for DECREASE-KEY
+ and DELETE-FROM-HEAP operations."))
+
+
+(defgeneric add-all-to-heap (heap items)
+ (:documentation "Adds a list of items to a HEAP. This can typically
+ be done more efficiently than by using repeated calls to
+ ADD-TO-HEAP, since the heap order only needs to be reinstated after
+ all of the items have been inserted, rather than maintained through
+ each operation. Returns the heap object."))
+
+(defgeneric peep-at-heap (heap)
+ (:documentation "Returns the heap's root, without modifying the
+ heap. Returns nil if the heap is empty."))
+
+(defgeneric pop-heap (heap)
+ (:documentation "Removes the top element from the heap and returns
+ it."))
+
+(defgeneric empty-heap (heap)
+ (:documentation "Removes all contents from the given heap. Returns the heap."))
+
+(defgeneric is-empty-heap-p (heap)
+ (:documentation "Returns true iff the given heap is empty."))
+
+(defgeneric merge-heaps (first second)
+ (:documentation "Returns a new heap that is the merged copy of those
+ given here. Can only merge heaps which use the same key and sorting
+ function. The two arguments are nt modified by this function."))
+
+(defgeneric nmerge-heaps (first second)
+ (:documentation "Destructively updates the arguments to contain the
+ merge of both heaps, which is then returned. Can only merge heaps
+ which use the same key and sorting function."))
+
+(defgeneric decrease-key (heap item-index value)
+ (:documentation "Decreases the value of the item represented by
+ ITEM-INDEX. ITEM-INDEX is the index returned by ADD-TO-HEAP for a
+ particular item. VALUE is the item's new value, and this must be
+ \"less\" than its old value. Returns the heap."))
+
+
+(defgeneric delete-from-heap (heap item-index)
+ (:documentation "Removes the item from the heap represented by the
+ ITEM-INDEX. This index is returned as the second value of
+ ADD-TO-HEAP. Returns the heap."))
+
+;;;--------------------------------------------------------------------
+;;; Unexported functions
+
+(defgeneric compare-items (heap parent child)
+ (:documentation "Compares two items, using the HEAP's SORT-FUN and
+ KEY functions.")
+ (:method ((heap heap) parent child)
+ (with-slots (sort-fun key) heap
+ (funcall sort-fun (funcall key parent) (funcall key child)))))
+
+;;;--------------------------------------------------------------------
+;;; Various implementation details
+
+(defmethod print-object ((heap heap) stream)
+ (print-unreadable-object (heap stream :type t :identity t)
+ (format stream "Size: ~A" (heap-size heap))))
+
More information about the Cl-heap-cvs
mailing list