;;; heap.el --- heap (a.k.a. priority queue) data structure package
;; Copyright (C) 2004-2006 Toby Cubitt ;; Author: Toby Cubitt <[EMAIL PROTECTED]> ;; Version: 0.1.3 ;; Keywords: heap, priority queue ;; URL: http://www.dr-qubit.org/emacs.php ;; This file is part of the Emacs Predictive Completion package. ;; ;; This program 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 2 ;; of the License, or (at your option) any later version. ;; ;; This program 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 this program; if not, write to the Free Software ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, ;; MA 02110-1301, USA. ;;; Commentary: ;; ;; A heap is a form of efficient self-sorting tree (sometimes called a ;; priority queue). 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. ;; ;; A heap consists of two cons cells, the first one holding the tag 'HEAP in ;; the car cell and the second one having the heap in the car and the compare ;; function in the cdr cell. The compare function must take two arguments of ;; the type which is to be stored in the heap and must return non-nil or ;; nil. To implement a max-heap, it should return non-nil if the first ;; argument is "greater" than the second. To implement a min-heap, it should ;; return non-nil if the first argument is "less than" the second. ;; ;; 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, ;; the difference is negligable. ;;; Change log: ;; ;; 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: (provide 'heap) ;; the only common lisp function required in `subseq', so this dependency ;; should probably be removed (require 'cl) ;;; ================================================================ ;;; Internal functions for use in the heap package (defmacro hp-vect (heap) ;; Return the heap vector. ;; INTERNAL USE ONLY `(car (cdr ,heap)) ) (defmacro hp-cmpfun (heap) ;; Return the comparison function of a heap. ;; INTERNAL USE ONLY `(cdr (cdr ,heap)) ) (defmacro hp-set-vect (heap vect) ;; Set the vector containing the heap itself to VECT. `(setcar (cdr ,heap) ,vect) ) (defmacro hp-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 (hp-vect ,heap)) (cmpfun (hp-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))) ))) ) (defmacro vswap (vect i j) ;; 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 hp-sift-up (heap n) ;; Sift-up starting from element N of the heap vector belonging to ;; heap HEAP. ;; INTERNAL USE ONLY (let* ((i n) (j nil) (vect (hp-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 (hp-cmpfun heap) v (aref vect (setq j (/ (1- i) 3))))) (vswap vect i j) (setq i j))) ) (defun hp-sift-down (heap n) ;; Sift-down from element N of the heap vector belonging to ;; heap HEAP. ;; INTERNAL USE ONLY (let* ((vect (hp-vect heap)) (cmpfun (hp-cmpfun heap)) (i n) (j (hp-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. (while (and j (funcall cmpfun (aref vect j) v)) (vswap vect i j) (setq i j) (setq j (hp-child heap i))) ) ) ;;; ================================================================ ;;; 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-copy (heap) "Return a copy of heap HEAP." (let ((newheap (heap-create (hp-cmpfun heap)))) (hp-set-vect newheap (hp-vect heap)) newheap) ) (defun heap-p (obj) "Return t if OBJ is a heap, nil otherwise." (eq (car-safe obj) 'HEAP) ) (defun heap-empty (heap) "Return t if the heap is empty, nil otherwise." (= 0 (length (hp-vect heap))) ) (defun heap-size (heap) "Return the number of entries in the heap." (length (hp-vect heap)) ) (defun heap-compare-function (heap) "Return the comparison function for the heap HEAP." (hp-cmpfun heap) ) (defun heap-add (heap data) "Add DATA to the heap." ;; Add data to bottom of heap and sift-up from bottom. (hp-set-vect heap (vconcat (hp-vect heap) (vector data))) (hp-sift-up heap (1- (length (hp-vect heap)))) ) (defun heap-delete-root (heap) "Return the root of the heap and delete it from the heap." (let ((vect (hp-vect heap)) (root nil) (len nil)) ;; Deal with special cases of empty heap and heap with just one element. (if (heap-empty heap) nil (setq len (length vect)) (setq root (aref vect 0)) (if (= 1 len) (hp-set-vect heap []) ;; Delete root, swap last element to top, and sift-down from top. (hp-set-vect heap (vconcat (vector (aref vect (1- len))) (subseq vect 1 (1- len)))) (hp-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 (hp-vect heap)) (i 0)) ;; search vector for the first match (while (and (< i (length vect)) (not (funcall match-function (aref vect i)))) (setq i (1+ i))) ;; if a match was found, modify it (if (< i (length vect)) (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 (hp-cmpfun heap) data olddata) (hp-sift-up heap i) (hp-sift-down heap i)) t ; return t if the match was successfully modified ) nil ; return nil if no match was found ) ) ) ;;; heap.el ends here _______________________________________________ gnu-emacs-sources mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
