;;;; "priorque.scm" priority queues for Scheme. ;;; Copyright (C) 1992, 1993, 1994, 1995, 1997 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is ;granted, subject to the following restrictions and understandings. ; ;1. Any copy made of this software must include this copyright notice ;in full. ; ;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. ; ;3. In conjunction with products arising from the use of this ;material, there shall be no use of my name in any advertising, ;promotional, or sales literature without prior written consent in ;each case. ;;@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 s (vector-length ra)) (let ((nra (make-vector (+ s (quotient s 2))))) (do ((i (+ -1 (vector-length ra)) (+ -1 i))) ((negative? i) (am a nra)) (vector-set! nra i (vector-ref ra i))))) (sm a s))))) (define (heap:parent i) (quotient i 2)) (define (heap:left i) (* 2 i)) (define (heap:right i) (+ 1 (* 2 i))) (define (heap:heapify a i) (let* ((l (heap:left i)) (r (heap:right i)) (largest (if (and (<= l (heap:length a)) ((heap:heap i 1) ((heap:heap