unit HeapQC;
//*******************************************************
// Heap-based priority queue class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

type
    QueueEntry = record
        value    : String[10];
        priority : Integer;
    end;
    THeapQueue = class(TObject)
        private
            Queue    : array [1..100] of QueueEntry;
            NumItems : Integer;

        public
            procedure Push(new_value : String; priority : Integer);
            function Pop : String;
            function QueueEmpty : Boolean;
            function TextValue : String;
            procedure HeapPushDown;
            procedure HeapPushUp;
    end;

implementation

// Add an item to the queue.
procedure THeapQueue.Push(new_value : String; priority : Integer);
begin
    NumItems := NumItems + 1;
    Queue[NumItems].value := new_value;
    Queue[NumItems].priority := priority;
    HeapPushUp;
end;

// Remove highest priority last from the queue.
function THeapQueue.Pop : String;
begin
    if (QueueEmpty) then exit;
    Result := Queue[1].value;
    Queue[1] := Queue[NumItems];
    NumItems := NumItems - 1;
    HeapPushDown;
end;

// Return True if the queue is empty.
function THeapQueue.QueueEmpty : Boolean;
begin
    QueueEmpty := (NumItems < 1);
end;

// Return a textual representation of the queue.
function THeapQueue.TextValue : String;
const
    CR = #13#10;
var
    i : Integer;
begin
    Result := '';
    for i := 1 to NumItems do
        Result := Result + Format('%s (%d)',
            [Queue[i].value, Queue[i].priority]) + CR;
end;

// Push the top item down through the heap until it
// can go no farther.
procedure THeapQueue.HeapPushDown;
var
    parent, child : Integer;
    top_priority  : Integer;
    top_value     : String;
begin
    top_priority := Queue[1].priority;
    top_value := Queue[1].value;
    parent := 1;
    repeat // Repeat infinitely.
        child := 2 * parent;
        if (child > NumItems) then
            break // Done. Past end of heap.
        else begin
            // Make child the higher priority child.
            if (child < NumItems) then
                if (Queue[child + 1].priority > Queue[child].priority) then
                    child := child + 1;

            if (Queue[child].priority > top_priority) then
            begin
                // A child has higher priority.
                // Swap the parent and child.
                Queue[parent] := Queue[child];
                // Push down beneath that child.
                parent := child;
            end else
                // The parent has higher priority. We're done.
                break;
        end;
    until (False);
    Queue[parent].priority := top_priority;
    Queue[parent].value := top_value;
end;

// Push an item up towards the root.
procedure THeapQueue.HeapPushUp;
var
    child, parent   : Integer;
    bottom_priority : Integer;
    bottom_value    : String;
begin
    bottom_priority := Queue[NumItems].priority;
    bottom_value := Queue[NumItems].value;
    child := NumItems;
    repeat // Repeat infinitely.
        parent := child div 2;
        if (parent < 1) then break;
        if (Queue[parent].priority < bottom_priority) then
        begin
            Queue[child] := Queue[parent];
            child := parent;
        end else
            break;
    until (False);
    Queue[child].priority := bottom_priority;
    Queue[child].value := bottom_value;
end;

end.
