[elpa] externals/heap 17429ee 07/31: Version 0.12 of the predictive completion package.

[Stefan Monnier]

branch: externals/heap
commit 17429eed7ba3b07db88a7a90b61848c9e729c4cc
Author: Toby Cubitt <toby-predictive@dr-qubit.org>
Commit: tsc25 <tsc25@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-predictive@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