diff options
Diffstat (limited to 'priorque.scm')
-rw-r--r-- | priorque.scm | 73 |
1 files changed, 34 insertions, 39 deletions
diff --git a/priorque.scm b/priorque.scm index 0ad3007..9f1591f 100644 --- a/priorque.scm +++ b/priorque.scm @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -17,21 +17,20 @@ ;promotional, or sales literature without prior written consent in ;each case. -;;; Algorithm from: -;;; Introduction to Algorithms by T. Cormen, C. Leiserson, R. Rivest. -;;; 1989 MIT Press. +;;@code{(require 'priority-queue)} +;;@ftindex priority-queue +;; +;;@noindent +;;This algorithm for priority queues is due to +;;@cite{Introduction to Algorithms} +;;by T. Cormen, C. Leiserson, R. Rivest. +;;1989 MIT Press. (require 'record) ;; Record type. (define heap:rtd (make-record-type "heap" '(array size heap<?))) -;; Constructor. -(define heap:make-heap - (let ((cstr (record-constructor heap:rtd))) - (lambda (pred<?) - (cstr (make-vector 4) 0 pred<?)))) - ;; Reference an element. (define heap:ref (let ((ra (record-accessor heap:rtd 'array))) @@ -55,10 +54,6 @@ (vector-set! ra i (vector-ref ra j)) (vector-set! ra j tmp))))) - -;; Get length. -(define heap:length (record-accessor heap:rtd 'size)) - (define heap:heap<? (record-accessor heap:rtd 'heap<?)) (define heap:set-size! @@ -92,7 +87,24 @@ (heap:exchange a i largest) (heap:heapify a largest))))) -(define (heap:insert! a key) +;;;; Externals + +;;@body +;;Returns a binary heap suitable which can be used for priority queue +;;operations. +(define make-heap + (let ((cstr (record-constructor heap:rtd))) + (lambda (pred<?) + (cstr (make-vector 4) 0 pred<?)))) + +;;@args heap +;;Returns the number of elements in @1. +(define heap-length (record-accessor heap:rtd 'size)) + +;;@args heap item +;;Inserts @2 into @1. @2 can be inserted multiple +;;times. The value returned is unspecified. +(define (heap-insert! a key) (define i (+ 1 (heap:length a))) (heap:set-size! a i) (do () @@ -102,7 +114,11 @@ (set! i (heap:parent i))) (heap:set! a i key)) -(define (heap:extract-max! a) +;;@args heap +;;Returns the item which is larger than all others according to the +;;@var{pred<?} argument to @code{make-heap}. If there are no items in +;;@1, an error is signaled. +(define (heap-extract-max! a) (if (< (heap:length a) 1) (slib:error "heap underflow" a)) (let ((max (heap:ref a 1))) @@ -111,26 +127,5 @@ (heap:heapify a 1) max)) -;; -;; Externals. -;; -(define make-heap heap:make-heap) -(define heap-insert! heap:insert!) -(define heap-extract-max! heap:extract-max!) -(define heap-length heap:length) - -(define (heap:test) - (require 'debug) - (let ((heap #f)) - (set! heap (make-heap char>?)) - (heap-insert! heap #\A) - (heap-insert! heap #\Z) - (heap-insert! heap #\G) - (heap-insert! heap #\B) - (heap-insert! heap #\G) - (heap-insert! heap #\Q) - (heap-insert! heap #\S) - (heap-insert! heap #\R) - (do ((i 7 (+ -1 i))) - ((negative? i)) - (write (heap-extract-max! heap)) (newline)))) +;; Internal protect. +(define heap:length heap-length) |