[ELPA-diffs] /srv/bzr/emacs/elpa r204: Add heap.el

[Toby S. Cubitt]

------------------------------------------------------------
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