1 ;;; heap.el --- Heap (a.k.a. priority queue) data structure
3 ;; Copyright (C) 2004-2006, 2008, 2012 Free Software Foundation, Inc
5 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
7 ;; Keywords: extensions, data structures, heap, priority queue
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/predictive.git
11 ;; This file is part of Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; A heap is a form of efficient self-sorting tree. In particular, the root
30 ;; node is guaranteed to be the highest-ranked entry in the tree. (The
31 ;; comparison function used for ranking the data can, of course, be freely
32 ;; defined). Therefore repeatedly removing the root node will return the data
33 ;; in order of increasing rank. They are often used as priority queues, for
34 ;; scheduling tasks in order of importance.
36 ;; This package implements ternary heaps, since they are about 12% more
37 ;; efficient than binary heaps for heaps containing more than about 10
38 ;; elements, and for very small heaps the difference is negligible. The
39 ;; asymptotic complexity of ternary heap operations is the same as for a
40 ;; binary heap: 'add', 'delete-root' and 'modify' operations are all O(log n)
41 ;; on a heap containing n elements.
43 ;; Note that this package implements a heap as an implicit data structure on a
44 ;; vector. Therefore, the maximum size of the heap has to be specified in
45 ;; advance. Although the heap will grow dynamically if it becomes full, this
46 ;; requires copying the entire heap, so insertion has worst-case complexity
47 ;; O(n) instead of O(log n), though the amortized complexity is still
48 ;; O(n). (For applications where the maximum size of the heap is not known in
49 ;; advance, an implementation based on binary trees might be more suitable,
50 ;; but is not currently implemented in this package.)
52 ;; You create a heap using `make-heap', add elements to it using `heap-add',
53 ;; delete and return the root of the heap using `heap-delete-root', and modify
54 ;; an element of the heap using `heap-modify'. A number of other heap
55 ;; convenience functions are also provided, all with the prefix
56 ;; `heap-'. Functions with prefix `heap--' are for internal use only, and
57 ;; should never be used outside this package.
63 ;; * converted heap data structures into defstructs
64 ;; * increased default resize-factor to 2
65 ;; * added `heap-build' function for efficiently building a heap out of a
67 ;; * added `heap-merge' function for merging heaps (not very efficient for
68 ;; binary -- or ternary -- heaps, only O(n))
71 ;; * fixed bug in `heap-copy'
74 ;; * modified Commentary
77 ;; * fixed efficiency issue: vectors are no longer copied all the time (thanks
78 ;; to Stefan Monnier for pointing this out)
81 ;; * renamed `vswap' to `heap--vswap'
82 ;; * removed cl dependency
85 ;; * fixed internal function and macro names
88 ;; * added more commentary
91 ;; * moved defmacros before their first use so byte-compilation works
94 ;; * added cl dependency
103 (eval-when-compile (require 'cl))
106 ;;; ================================================================
107 ;;; Internal functions for use in the heap package
112 (:constructor heap--create
113 (cmpfun &optional (size 10) (resize 2)
115 (vect (make-vector size nil))
118 vect cmpfun count size resize)
121 (defun heap--child (heap i) ; INTERNAL USE ONLY
122 ;; Compare the 3 children of element I, and return element reference
123 ;; of the smallest/largest (depending on whethen it's a min- or
125 (let* ((vect (heap--vect heap))
126 (cmpfun (heap--cmpfun heap))
127 (count (heap--count heap))
129 ;; Lots of if's in case I has less than three children.
130 (if (>= (1+ k) count) nil
131 (if (>= (+ 2 k) count) (1+ k)
132 (setq j (if (funcall cmpfun (aref vect (1+ k))
135 (if (>= (+ 3 k) count) j
136 (if (funcall cmpfun (aref vect j) (aref vect (+ 3 k)))
140 (defmacro heap--vswap (vect i j) ; INTERNAL USE ONLY
141 ;; Swap elements I and J of vector VECT.
142 `(let ((tmp (aref ,vect ,i)))
143 (aset ,vect ,i (aref ,vect ,j))
144 (aset ,vect ,j tmp) ,vect))
147 (defun heap--sift-up (heap n) ; INTERNAL USE ONLY
148 ;; Sift-up starting from element N of vector belonging to HEAP.
149 (let* ((i n) (j nil) (vect (heap--vect heap)) (v (aref vect n)))
150 ;; Keep moving element up until it reaches top or is smaller/bigger
153 (funcall (heap--cmpfun heap) v
154 (aref vect (setq j (/ (1- i) 3)))))
155 (heap--vswap vect i j)
159 (defun heap--sift-down (heap n) ; INTERNAL USE ONLY
160 ;; Sift-down from element N of the heap vector belonging HEAP.
161 (let* ((vect (heap--vect heap))
162 (cmpfun (heap--cmpfun heap))
163 (i n) (j (heap--child heap i))
165 ;; Keep moving the element down until it reaches the bottom of the
166 ;; tree or reaches a position where it is bigger/smaller than all
168 (while (and j (funcall cmpfun (aref vect j) v))
169 (heap--vswap vect i j)
171 (setq j (heap--child heap i)))))
175 ;;; ================================================================
176 ;;; The public functions which operate on heaps.
180 (compare-function &optional initial-size resize-factor)
181 "Create an empty heap with comparison function COMPARE-FUNCTION.
183 COMPARE-FUNCTION takes two arguments, A and B, and returns
184 non-nil or nil. To implement a max-heap, it should return non-nil
185 if A is greater than B. To implemenet a min-heap, it should
186 return non-nil if A is less than B.
188 Optional argument INITIAL-SIZE sets the initial size of the heap,
189 defaulting to 10. Optional argument RESIZE-FACTOR sets the factor
190 by which the heap's size is increased if it runs out of space,
192 ;; sadly, passing null values over-rides the defaults in the defstruct
193 ;; `heap--create', so we have to explicitly set the defaults again
195 (or initial-size (setq initial-size 10))
196 (or resize-factor (setq resize-factor 2))
197 (heap--create compare-function initial-size resize-factor))
201 (defalias 'heap-create 'make-heap)
204 (defun heap-copy (heap)
205 "Return a copy of heap HEAP."
206 (let ((newheap (heap--create (heap--cmpfun heap) (heap--size heap)
207 (heap--resize heap))))
208 (setf (heap--vect newheap) (vconcat (heap--vect heap) [])
209 (heap--count newheap) (heap--count heap))
213 (defun heap-empty (heap)
214 "Return t if the heap is empty, nil otherwise."
215 (= 0 (heap--count heap)))
218 (defun heap-size (heap)
219 "Return the number of entries in the heap."
223 (defun heap-compare-function (heap)
224 "Return the comparison function for the heap HEAP."
228 (defun heap-add (heap data)
229 "Add DATA to the heap, and return DATA."
230 ;; Add data to bottom of heap and sift-up from bottom.
231 (let ((count (heap--count heap))
232 (size (heap--size heap))
233 (vect (heap--vect heap)))
234 ;; if there's no space left, grow the heap
236 (aset vect count data)
237 (setf (heap--vect heap)
238 (vconcat (heap--vect heap) (vector data)
240 (1- (ceiling (* size (1- (heap--resize heap)))))
243 (ceiling (* size (heap--resize heap)))))
244 (setq count (setf (heap--count heap) (1+ (heap--count heap))))
245 (heap--sift-up heap (1- count)))
246 ;; return inserted data
250 (defun heap-root (heap)
251 "Return the root of the heap, without removing it"
252 (if (= (heap--count heap) 0) nil (aref (heap--vect heap) 0)))
255 (defun heap-delete-root (heap)
256 "Return the root of the heap and delete it from the heap."
257 (let ((vect (heap--vect heap))
259 ;; deal with empty heaps and heaps with just one element
260 (if (= 0 (heap--count heap)) nil
261 (setq root (aref vect 0)
262 count (decf (heap--count heap)))
264 (setf (heap--vect heap) (make-vector 10 nil))
265 ;; delete root, swap last element to top, and sift-down from top
266 (aset vect 0 (aref vect count))
267 (aset vect count nil)
268 (heap--sift-down heap 0))
272 (defun heap-modify (heap match-function data)
273 "Replace the first heap entry identified by MATCH-FUNCTION
274 with DATA, if a match exists. Return t if there was a match, nil
277 The function MATCH-FUNCTION should take one argument of the type
278 stored in the heap, and return non-nil if it should be modified,
281 Note that only the match highest up the heap is modified."
282 (let ((vect (heap--vect heap))
283 (count (heap--count heap))
285 ;; search vector for the first match
286 (while (and (< i count)
287 (not (funcall match-function (aref vect i))))
289 ;; if a match was found, modify it
291 (let ((olddata (aref vect i)))
293 ;; if the new data is greater than old data, sift-up,
294 ;; otherwise sift-down
295 (if (funcall (heap--cmpfun heap) data olddata)
296 (heap--sift-up heap i)
297 (heap--sift-down heap i))
298 t) ; return t if the match was successfully modified
299 nil))) ; return nil if no match was found
302 (defun heap-build (compare-function vec &optional resize-factor)
303 "Build a heap from vector VEC with COMPARE-FUNCTION
304 as the comparison function.
306 Note that VEC is modified, and becomes part of the heap data
307 structure. If you don't want this, copy the vector first and pass
310 COMPARE-FUNCTION takes two arguments, A and B, and returns
311 non-nil or nil. To implement a max-heap, it should return non-nil
312 if A is greater than B. To implemenet a min-heap, it should
313 return non-nil if A is less than B.
315 RESIZE-FACTOR sets the factor by which the heap's size is
316 increased if it runs out of space, defaulting to 2."
317 (or resize-factor (setq resize-factor 2))
318 (let ((heap (heap--create compare-function (length vec) resize-factor))
319 (i (ceiling (1- (expt 3
320 (ceiling (1- (log (1+ (* 2 (length vec))) 3))))) 2)))
321 (setf (heap--vect heap) vec
322 (heap--count heap) (length vec))
323 (while (>= (decf i) 0) (heap--sift-down heap i))
327 (defun heap-merge (heap &rest heaps)
328 "Merge HEAP with remaining HEAPS.
330 The merged heap takes the comparison function and resize-fector
331 of the first HEAP argument.
333 \(Note that in this heap implementation, the merge operation is
334 not very efficient, taking O(n) time for combined heap size n\)."
335 (setq heaps (mapcar 'heap--vect heaps))
336 (heap-build (heap--cmpfun heap)
337 (apply 'vconcat (heap--vect heap) heaps)
338 (heap--resize heap)))
344 ;;; heap.el ends here