branch: externals/heap
commit 17429eed7ba3b07db88a7a90b61848c9e729c4cc
Author: Toby Cubitt <toby-predict...@dr-qubit.org>
Commit: tsc25 <ts...@cantab.net>
Version 0.12 of the predictive completion package.
---
heap.el | 209 ++++++++++++++++++++++++++++++++++++++++++----------------------
1 file changed, 139 insertions(+), 70 deletions(-)
diff --git a/heap.el b/heap.el
index 17e5893..9b388f1 100644
--- a/heap.el
+++ b/heap.el
@@ -5,7 +5,7 @@
;; Copyright (C) 2004-2006 Toby Cubitt
;; Author: Toby Cubitt <toby-predict...@dr-qubit.org>
-;; Version: 0.1.4
+;; Version: 0.2
;; Keywords: heap, priority queue
;; URL: http://www.dr-qubit.org/emacs.php
@@ -47,6 +47,12 @@
;; second. To implement a min-heap, it should return non-nil if the
;; first argument is "less than" the second.
;;
+;; You create a heap using `heap-create', 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 convenience functions are
+;; also provided.
+;;
;; Note that this package implements a ternary heap, since ternary
;; heaps are about 12% more efficient than binary heaps for heaps
;; containing more than about 10 elements. And for very small heaps,
@@ -55,6 +61,14 @@
;;; Change log:
;;
+;; Version 0.2
+;; * fixed efficiency issue: vectors are no longer copied all the time
+;; (thanks to Stefan Monnier for pointing out this issue)
+;;
+;; Version 0.1.5
+;; * renamed `vswap' to `heap--vswap'
+;; * removed cl dependency
+;;
;; Version 0.1.4
;; * fixed internal function and macro names
;;
@@ -76,9 +90,6 @@
(provide 'heap)
-;; the only common lisp function required in `subseq', so this dependency
-;; should probably be removed
-(require 'cl)
@@ -87,47 +98,77 @@
;;; Internal functions for use in the heap package
-(defmacro heap--vect (heap)
- ;; Return the heap vector. ;; INTERNAL USE ONLY
- `(car (cdr ,heap))
+(defmacro heap--vect (heap) ; INTERNAL USE ONLY
+ ;; Return the heap vector.
+ `(aref ,heap 1)
+)
+
+
+(defmacro heap--set-vect (heap vect) ; INTERNAL USE ONLY
+ ;; Set the vector containing the heap itself to VECT.
+ `(aset ,heap 1 ,vect)
)
+(defmacro heap--cmpfun (heap) ; INTERNAL USE ONLY
+ ;; Return the comparison function of a heap.
+ `(aref ,heap 2)
+)
+
-(defmacro heap--cmpfun (heap)
- ;; Return the comparison function of a heap. ;; INTERNAL USE ONLY
- `(cdr (cdr ,heap))
+(defmacro heap--count (heap) ; INTERNAL USE ONLY
+ ;; Return number of items in HEAP
+ `(aref ,heap 3)
)
+(defmacro heap--set-count (heap count) ; INTERNAL USE ONLY
+ ;; Set number of items in HEAP
+ `(aset ,heap 3 ,count)
+)
-(defmacro heap--set-vect (heap vect)
- ;; Set the vector containing the heap itself to VECT.
- `(setcar (cdr ,heap) ,vect)
+
+(defmacro heap--size (heap) ; INTERNAL USE ONLY
+ ;; Return size of HEAP
+ `(aref ,heap 4)
+)
+
+
+(defmacro heap--set-size (heap size) ; INTERNAL USE ONLY
+ ;; Set size of HEAP
+ `(aset ,heap 4 ,size)
+)
+
+
+(defmacro heap--resize (heap) ; INTERNAL USE ONLY
+ ;; Return resize-factor of HEAP
+ `(aref ,heap 5)
)
-(defmacro heap--child (heap i)
- ;; 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).
- ;; INTERNAL USE ONLY
- `(let* ((vect (heap--vect ,heap))
- (cmpfun (heap--cmpfun ,heap))
- (len (length vect)) (j nil) (k (* 3 ,i)))
- ;; Lots of if's in case I has less than three children.
- (if (>= (1+ k) len) nil
- (if (>= (+ 2 k) len) (1+ k)
- (setq j (if (funcall cmpfun (aref vect (1+ k)) (aref vect (+ 2 k)))
- (1+ k) (+ 2 k)))
- (if (>= (+ 3 k) len) j
- (if (funcall cmpfun (aref vect j) (aref vect (+ 3 k))) j (+ 3 k)))
- )))
+(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 vswap (vect i j)
+(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))
@@ -136,32 +177,31 @@
-(defun heap--sift-up (heap n)
- ;; Sift-up starting from element N of the heap vector belonging to
- ;; heap HEAP. ;; INTERNAL USE ONLY
+(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)))))
- (vswap vect i j)
+ (heap--vswap vect i j)
(setq i j)))
)
-(defun heap--sift-down (heap n)
- ;; Sift-down from element N of the heap vector belonging to
- ;; heap HEAP. ;; INTERNAL USE ONLY
+(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)) (len (length vect)) (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.
+ (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))
- (vswap vect i j)
+ (heap--vswap vect i j)
(setq i j)
(setq j (heap--child heap i)))
)
@@ -175,40 +215,50 @@
;;; The public functions which operate on heaps.
-(defun heap-create (compare-function)
- "Create an empty heap using COMPARE-FUNCTION as the comparison
-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."
- (cons 'HEAP (cons [] compare-function))
+(defun heap-create (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 1.5"
+ (unless initial-size (setq initial-size 10))
+ (unless resize-factor (setq resize-factor 1.5))
+ (vector 'HEAP (make-vector initial-size nil) compare-function
+ 0 initial-size resize-factor)
)
(defun heap-copy (heap)
"Return a copy of heap HEAP."
- (let ((newheap (heap-create (heap--cmpfun heap))))
- (heap--set-vect newheap (heap--vect heap))
+ (let ((newheap (heap-create (heap--size heap) (heap--cmpfun heap))))
+ (heap--set-vect newheap (vconcat (heap--vect heap) []))
newheap)
)
(defun heap-p (obj)
"Return t if OBJ is a heap, nil otherwise."
- (eq (car-safe obj) 'HEAP)
+ (and (vectorp obj) (eq (aref obj 0) 'HEAP))
)
(defun heap-empty (heap)
"Return t if the heap is empty, nil otherwise."
- (= 0 (length (heap--vect heap)))
+ (= 0 (heap--count heap))
)
(defun heap-size (heap)
"Return the number of entries in the heap."
- (length (heap--vect heap))
+ (heap--count heap)
)
@@ -221,27 +271,42 @@ B. To implemenet a min-heap, it should return non-nil if
A is less than B."
(defun heap-add (heap data)
- "Add DATA to the heap."
+ "Add DATA to the heap, and return DATA."
;; Add data to bottom of heap and sift-up from bottom.
- (heap--set-vect heap (vconcat (heap--vect heap) (vector data)))
- (heap--sift-up heap (1- (length (heap--vect heap))))
+ (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)
+ (heap--set-vect
+ heap (vconcat (heap--vect heap) (vector data)
+ (make-vector
+ (1- (ceiling (* size (1- (heap--resize heap)))))
+ nil)))
+ (heap--set-size heap (* 2 size)))
+ (setq count (heap--set-count heap (1+ (heap--count heap))))
+ (heap--sift-up heap (1- count)))
+ ;; return inserted data
+ data
)
(defun heap-delete-root (heap)
"Return the root of the heap and delete it from the heap."
- (let ((vect (heap--vect heap))
- (root nil) (len nil))
+ (let (vect root (count (heap--count heap)))
- ;; Deal with special cases of empty heap and heap with just one element.
- (if (heap-empty heap) nil
- (setq len (length vect))
+ ;; deal with empty heaps and heaps with just one element
+ (if (= count 0) nil
+ (setq vect (heap--vect heap))
(setq root (aref vect 0))
- (if (= 1 len) (heap--set-vect heap [])
+ (heap--set-count heap (1- (heap--count heap)))
+ (if (= 1 count) (heap--set-vect heap (make-vector 10 nil))
;; Delete root, swap last element to top, and sift-down from top.
- (heap--set-vect heap (vconcat (vector (aref vect (1- len)))
- (subseq vect 1 (1- len))))
+ (setq vect (heap--vect heap))
+ (aset vect 0 (aref vect (1- count)))
+ (aset vect (1- count) nil)
(heap--sift-down heap 0))
root)
)
@@ -250,21 +315,25 @@ B. To implemenet a min-heap, it should return non-nil if
A is less than B."
(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.
+ "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.
+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)) (i 0))
+ (let ((vect (heap--vect heap))
+ (count (heap--count heap))
+ (i 0))
;; search vector for the first match
- (while (and (< i (length vect))
+ (while (and (< i count)
(not (funcall match-function (aref vect i))))
(setq i (1+ i)))
;; if a match was found, modify it
- (if (< i (length vect))
+ (if (< i count)
(let ((olddata (aref vect i)))
(aset vect i data)
;; if the new data is greater than old data, sift-up, otherwise
