[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ELPA-diffs] /srv/bzr/emacs/elpa r204: Add heap.el
From: |
Toby S. Cubitt |
Subject: |
[ELPA-diffs] /srv/bzr/emacs/elpa r204: Add heap.el |
Date: |
Sun, 29 Apr 2012 13:44:35 +0200 |
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 204
committer: Toby S. Cubitt <address@hidden>
branch nick: elpa
timestamp: Sun 2012-04-29 13:44:35 +0200
message:
Add heap.el
added:
packages/heap/
packages/heap/heap.el
=== added directory 'packages/heap'
=== added file 'packages/heap/heap.el'
--- a/packages/heap/heap.el 1970-01-01 00:00:00 +0000
+++ b/packages/heap/heap.el 2012-04-29 11:44:35 +0000
@@ -0,0 +1,345 @@
+;;; heap.el --- heap (a.k.a. priority queue) data structures
+
+
+;; Copyright (C) 2004-2006, 2008, 2012 Free Software Foundation, Inc
+
+;; Author: Toby Cubitt <address@hidden>
+;; Version: 0.3
+;; Keywords: extensions, data structures, heap, priority queue
+;; URL: http://www.dr-qubit.org/emacs.php
+;; Repository: http://www.dr-qubit.org/git/predictive.git
+
+;; This file is part of Emacs.
+;;
+;; GNU Emacs 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.
+;;
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;;
+;; A heap is a form of efficient self-sorting tree. In particular, the root
+;; node is guaranteed to be the highest-ranked entry in the tree. (The
+;; comparison function used for ranking the data can, of course, be freely
+;; defined). Therefore repeatedly removing the root node will return the data
+;; in order of increasing rank. They are often used as priority queues, for
+;; scheduling tasks in order of importance.
+;;
+;; This package implements ternary heaps, since they are about 12% more
+;; efficient than binary heaps for heaps containing more than about 10
+;; elements, and for very small heaps the difference is negligible. The
+;; asymptotic complexity of ternary heap operations is the same as for a
+;; binary heap: 'add', 'delete-root' and 'modify' operations are all O(log n)
+;; on a heap containing n elements.
+;;
+;; Note that this package implements a heap as an implicit data structure on a
+;; vector. Therefore, the maximum size of the heap has to be specified in
+;; advance. Although the heap will grow dynamically if it becomes full, this
+;; requires copying the entire heap, so insertion has worst-case complexity
+;; O(n) instead of O(log n), though the amortized complexity is still
+;; O(n). (For applications where the maximum size of the heap is not known in
+;; advance, an implementation based on binary trees might be more suitable,
+;; but is not currently implemented in this package.)
+;;
+;; You create a heap using `make-heap', add elements to it using `heap-add',
+;; delete and return the root of the heap using `heap-delete-root', and modify
+;; an element of the heap using `heap-modify'. A number of other heap
+;; convenience functions are also provided, all with the prefix
+;; `heap-'. Functions with prefix `heap--' are for internal use only, and
+;; should never be used outside this package.
+
+
+;;; Change Log:
+;;
+;; Version 0.3
+;; * converted heap data structures into defstructs
+;; * increased default resize-factor to 2
+;; * added `heap-build' function for efficiently building a heap out of a
+;; vector
+;; * added `heap-merge' function for merging heaps (not very efficient for
+;; binary -- or ternary -- heaps, only O(n))
+;;
+;; Version 0.2.2
+;; * fixed bug in `heap-copy'
+;;
+;; Version 0.2.1
+;; * modified Commentary
+;;
+;; Version 0.2
+;; * fixed efficiency issue: vectors are no longer copied all the time (thanks
+;; to Stefan Monnier for pointing this out)
+;;
+;; Version 0.1.5
+;; * renamed `vswap' to `heap--vswap'
+;; * removed cl dependency
+;;
+;; Version 0.1.4
+;; * fixed internal function and macro names
+;;
+;; Version 0.1.3
+;; * added more commentary
+;;
+;; Version 0.1.2
+;; * moved defmacros before their first use so byte-compilation works
+;;
+;; Version 0.1.1
+;; * added cl dependency
+;;
+;; version 0.1
+;; * initial release
+
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+
+;;; ================================================================
+;;; Internal functions for use in the heap package
+
+(defstruct (heap-
+ :named
+ (:constructor nil)
+ (:constructor heap--create
+ (cmpfun &optional (size 10) (resize 2)
+ &aux
+ (vect (make-vector size nil))
+ (count 0)))
+ (:copier nil))
+ vect cmpfun count size resize)
+
+
+(defun heap--child (heap i) ; INTERNAL USE ONLY
+ ;; Compare the 3 children of element I, and return element reference
+ ;; of the smallest/largest (depending on whethen it's a min- or
+ ;; max-heap).
+ (let* ((vect (heap--vect heap))
+ (cmpfun (heap--cmpfun heap))
+ (count (heap--count heap))
+ (j nil) (k (* 3 i)))
+ ;; Lots of if's in case I has less than three children.
+ (if (>= (1+ k) count) nil
+ (if (>= (+ 2 k) count) (1+ k)
+ (setq j (if (funcall cmpfun (aref vect (1+ k))
+ (aref vect (+ 2 k)))
+ (1+ k) (+ 2 k)))
+ (if (>= (+ 3 k) count) j
+ (if (funcall cmpfun (aref vect j) (aref vect (+ 3 k)))
+ j (+ 3 k)))))))
+
+
+(defmacro heap--vswap (vect i j) ; INTERNAL USE ONLY
+ ;; Swap elements I and J of vector VECT.
+ `(let ((tmp (aref ,vect ,i)))
+ (aset ,vect ,i (aref ,vect ,j))
+ (aset ,vect ,j tmp) ,vect))
+
+
+(defun heap--sift-up (heap n) ; INTERNAL USE ONLY
+ ;; Sift-up starting from element N of vector belonging to HEAP.
+ (let* ((i n) (j nil) (vect (heap--vect heap)) (v (aref vect n)))
+ ;; Keep moving element up until it reaches top or is smaller/bigger
+ ;; than its parent.
+ (while (and (> i 0)
+ (funcall (heap--cmpfun heap) v
+ (aref vect (setq j (/ (1- i) 3)))))
+ (heap--vswap vect i j)
+ (setq i j))))
+
+
+(defun heap--sift-down (heap n) ; INTERNAL USE ONLY
+ ;; Sift-down from element N of the heap vector belonging HEAP.
+ (let* ((vect (heap--vect heap))
+ (cmpfun (heap--cmpfun heap))
+ (i n) (j (heap--child heap i))
+ (v (aref vect n)))
+ ;; Keep moving the element down until it reaches the bottom of the
+ ;; tree or reaches a position where it is bigger/smaller than all
+ ;; its children.
+ (while (and j (funcall cmpfun (aref vect j) v))
+ (heap--vswap vect i j)
+ (setq i j)
+ (setq j (heap--child heap i)))))
+
+
+
+;;; ================================================================
+;;; The public functions which operate on heaps.
+
+;;;###autoload
+(defun make-heap
+ (compare-function &optional initial-size resize-factor)
+ "Create an empty heap with comparison function COMPARE-FUNCTION.
+
+COMPARE-FUNCTION takes two arguments, A and B, and returns
+non-nil or nil. To implement a max-heap, it should return non-nil
+if A is greater than B. To implemenet a min-heap, it should
+return non-nil if A is less than B.
+
+Optional argument INITIAL-SIZE sets the initial size of the heap,
+defaulting to 10. Optional argument RESIZE-FACTOR sets the factor
+by which the heap's size is increased if it runs out of space,
+defaulting to 2."
+ ;; sadly, passing null values over-rides the defaults in the defstruct
+ ;; `heap--create', so we have to explicitly set the defaults again
+ ;; here
+ (or initial-size (setq initial-size 10))
+ (or resize-factor (setq resize-factor 2))
+ (heap--create compare-function initial-size resize-factor))
+
+
+;;;###autoload
+(defalias 'heap-create 'make-heap)
+
+
+(defun heap-copy (heap)
+ "Return a copy of heap HEAP."
+ (let ((newheap (heap--create (heap--cmpfun heap) (heap--size heap)
+ (heap--resize heap))))
+ (setf (heap--vect newheap) (vconcat (heap--vect heap) [])
+ (heap--count newheap) (heap--count heap))
+ newheap))
+
+
+(defun heap-empty (heap)
+ "Return t if the heap is empty, nil otherwise."
+ (= 0 (heap--count heap)))
+
+
+(defun heap-size (heap)
+ "Return the number of entries in the heap."
+ (heap--count heap))
+
+
+(defun heap-compare-function (heap)
+ "Return the comparison function for the heap HEAP."
+ (heap--cmpfun heap))
+
+
+(defun heap-add (heap data)
+ "Add DATA to the heap, and return DATA."
+ ;; Add data to bottom of heap and sift-up from bottom.
+ (let ((count (heap--count heap))
+ (size (heap--size heap))
+ (vect (heap--vect heap)))
+ ;; if there's no space left, grow the heap
+ (if (< count size)
+ (aset vect count data)
+ (setf (heap--vect heap)
+ (vconcat (heap--vect heap) (vector data)
+ (make-vector
+ (1- (ceiling (* size (1- (heap--resize heap)))))
+ nil))
+ (heap--size heap)
+ (ceiling (* size (heap--resize heap)))))
+ (setq count (setf (heap--count heap) (1+ (heap--count heap))))
+ (heap--sift-up heap (1- count)))
+ ;; return inserted data
+ data)
+
+
+(defun heap-root (heap)
+ "Return the root of the heap, without removing it"
+ (if (= (heap--count heap) 0) nil (aref (heap--vect heap) 0)))
+
+
+(defun heap-delete-root (heap)
+ "Return the root of the heap and delete it from the heap."
+ (let ((vect (heap--vect heap))
+ root count)
+ ;; deal with empty heaps and heaps with just one element
+ (if (= 0 (heap--count heap)) nil
+ (setq root (aref vect 0)
+ count (decf (heap--count heap)))
+ (if (= 0 count)
+ (setf (heap--vect heap) (make-vector 10 nil))
+ ;; delete root, swap last element to top, and sift-down from top
+ (aset vect 0 (aref vect count))
+ (aset vect count nil)
+ (heap--sift-down heap 0))
+ root)))
+
+
+(defun heap-modify (heap match-function data)
+ "Replace the first heap entry identified by MATCH-FUNCTION
+with DATA, if a match exists. Return t if there was a match, nil
+otherwise.
+
+The function MATCH-FUNCTION should take one argument of the type
+stored in the heap, and return non-nil if it should be modified,
+nil otherwise.
+
+Note that only the match highest up the heap is modified."
+ (let ((vect (heap--vect heap))
+ (count (heap--count heap))
+ (i 0))
+ ;; search vector for the first match
+ (while (and (< i count)
+ (not (funcall match-function (aref vect i))))
+ (setq i (1+ i)))
+ ;; if a match was found, modify it
+ (if (< i count)
+ (let ((olddata (aref vect i)))
+ (aset vect i data)
+ ;; if the new data is greater than old data, sift-up,
+ ;; otherwise sift-down
+ (if (funcall (heap--cmpfun heap) data olddata)
+ (heap--sift-up heap i)
+ (heap--sift-down heap i))
+ t) ; return t if the match was successfully modified
+ nil))) ; return nil if no match was found
+
+
+(defun heap-build (compare-function vec &optional resize-factor)
+ "Build a heap from vector VEC with COMPARE-FUNCTION
+as the comparison function.
+
+Note that VEC is modified, and becomes part of the heap data
+structure. If you don't want this, copy the vector first and pass
+the copy in VEC.
+
+COMPARE-FUNCTION takes two arguments, A and B, and returns
+non-nil or nil. To implement a max-heap, it should return non-nil
+if A is greater than B. To implemenet a min-heap, it should
+return non-nil if A is less than B.
+
+RESIZE-FACTOR sets the factor by which the heap's size is
+increased if it runs out of space, defaulting to 2."
+ (or resize-factor (setq resize-factor 2))
+ (let ((heap (heap--create compare-function (length vec) resize-factor))
+ (i (ceiling (1- (expt 3
+ (ceiling (1- (log (1+ (* 2 (length vec))) 3))))) 2)))
+ (setf (heap--vect heap) vec
+ (heap--count heap) (length vec))
+ (while (>= (decf i) 0) (heap--sift-down heap i))
+ heap))
+
+
+(defun heap-merge (heap &rest heaps)
+ "Merge HEAP with remaining HEAPS.
+
+The merged heap takes the comparison function and resize-fector
+of the first HEAP argument.
+
+\(Note that in this heap implementation, the merge operation is
+not very efficient, taking O(n) time for combined heap size n\)."
+ (setq heaps (mapcar 'heap--vect heaps))
+ (heap-build (heap--cmpfun heap)
+ (apply 'vconcat (heap--vect heap) heaps)
+ (heap--resize heap)))
+
+
+
+(provide 'heap)
+
+;;; heap.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [ELPA-diffs] /srv/bzr/emacs/elpa r204: Add heap.el,
Toby S. Cubitt <=