;;;; "priorque.scm" priority queues for Scheme. ;;; Copyright (C) 1992, 1993, 1994, 1995, 1997 Aubrey Jaffer. ; ;Permission to copy this software, to redistribute it, 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 warrantee 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. ;;; Algorithm from: ;;; 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?)) (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))))