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