* Re: binary heap
1994-11-09 12:21 binary heap JC
@ 1994-11-14 23:47 ` Tucker Taft
1994-11-15 15:59 ` Tucker Taft
0 siblings, 1 reply; 4+ messages in thread
From: Tucker Taft @ 1994-11-14 23:47 UTC (permalink / raw)
In article <39qese$kcm@columbia.acc.brad.ac.uk>,
JC <J.Coates@bradford.ac.uk> wrote:
>I am looking for a fully working priority queue bibary heap package
>including functions find_min and is_empty etc , any help would be great so I
>can implement a program i am writing to emulate priority interupts. Cheers.
>
>
> JC
Here is some Ada 83 code for a binary heap used to implement a priority
queue (FIFO within priority); this code (or a slight variation of it)
has been used successfully for many years.
Hope you find it useful.
-Tucker Taft stt@inmet.com
Intermetrics, Inc.
Cambridge, MA 02138
-------------------------------------------------
package Priority_Queue is
-- Provide a priority queue; greater priority means more urgent.
-- Copyright (C) 1994 Intermetrics, Inc. Cambridge, MA 02138
-- May be freely copied so long as this copyright notice is retained
Min_Prio : constant := 0;
Max_Prio : constant := 100;
type Priority is range Min_Prio .. Max_Prio;
type Queue_Entry_Record;
type Queue_Entry is access Queue_Entry_Record;
type Queue_Entry_Record is
record
Prio : Priority;
Next : Queue_Entry;
Other_Info : Integer; -- Or whatever
end record;
procedure Add_Entry(Ent : Queue_Entry);
-- Add Ent to priority queue
procedure Remove_Top_Prio(Ent : out Queue_Entry);
-- Remove and return an entry with the highest priority
-- Ent set to null if queue is empty.
function Top_Prio return Queue_Entry;
-- Return pointer to entry with highest priority (leave in queue)
-- Returns null if queue is empty.
function Is_Empty return Boolean;
-- Return True if queue is empty
end Priority_Queue;
package body Priority_Queue is
-- Implement a priority queue; greater priority means more urgent.
-- Internal representation is a binary heap,
-- plus an array of FIFO queues.
-- Copyright (C) 1994 Intermetrics, Inc. Cambridge, MA 02138
-- May be freely copied so long as this copyright notice is retained
type FIFO_Queue_Header is
record
First, Last : Queue_Entry := null;
end record;
FIFO_Queues : array(Priority) of FIFO_Queue_Header;
-- Array of singly-linked FIFO queues
Num_Prio : constant := Max_Prio - Min_Prio + 1;
type Heap_Count is range 0 .. Num_Prio;
subtype Heap_Index is Heap_Count range 1 .. Num_Prio;
Heap : array(Heap_Index) of Priority := (Heap_Index => Min_Prio);
-- Heap of priority values, Heap(Heap'First) is highest priority
-- with non-empty FIFO queue;
-- Heap preinitialized to Min_Prio to simplify removal.
-- Binary heap condition is: Heap(N) > Max(Heap(2*N), Heap(2*N+1))
Num_In_Heap : Heap_Count := 0; -- Count of number in heap
procedure Add_Entry(Ent : Queue_Entry) is
-- Add Ent to priority queue
-- Algorithm:
-- Add new entry to its FIFO queue. If its FIFO queue was empty,
-- add its priority to bottom of heap, and then "sift" it up
-- until binary heap condition is restored.
Parent, Child : Heap_Index;
Prio_To_Add : constant Priority := Ent.Prio;
FIFO_Queue : FIFO_Queue_Header renames FIFO_Queues(Prio_To_Add);
begin
Ent.Next := null;
if FIFO_Queue.Last /= null then
-- There are already elements for this priority;
-- Just add to end of its FIFO queue and return.
FIFO_Queue.Last.Next := Ent;
return;
end if;
-- This is a new priority, add to binary heap
Num_In_Heap := Num_In_Heap + 1;
-- Start at end of heap
Child := Num_In_Heap;
-- Loop until reach top of heap, or parent greater than new prio
while Child > 1 loop
Parent := Child / 2; -- Find slot which should be greater
exit when Heap(Parent) >= Prio_To_Add;
-- All done if parent now greater
-- Parent smaller, move it down to child's slot
Heap(Child) := Heap(Parent);
-- Advance up to parent slot and iterate
Child := Parent;
end loop;
-- ASSERT: Prio_To_Add < Heap(Child/2) or reached top-of-heap
Heap(Child) := Prio_To_Add;
-- Now initialize FIFO queue header to point to new entry
FIFO_Queue.First := Ent;
FIFO_Queue.Last := Ent;
end Add_Entry;
procedure Remove_Top_Prio(Ent : out Queue_Entry) is
-- Remove and return an entry with the highest priority
-- Ent set to null if FIFO queue is empty.
-- Algorithm:
-- Retrieve highest priority in heap. Remove first element
-- from corresponding FIFO queue. If FIFO queue now empty,
-- remove corresponding priority from heap, and "sift"
-- priority at bottom of heap down from top of heap,
-- until binary heap condition is restored.
Top_Prio : Priority;
Prio_To_Sift : Priority;
Parent, Child : Heap_Index;
Parent_Limit : Heap_Index;
Top : Queue_Entry; -- Temp needed since Ent is "out" param
-- (not needed in Ada 9X).
begin
if Num_In_Heap = 0 then
-- Priority queue is empty
Ent := null;
return;
end if;
Top_Prio := Heap(Heap'First); -- Get highest priority
-- Remove first element from appropriate FIFO queue
Top := FIFO_Queues(Top_Prio).First;
FIFO_Queues(Top_Prio).First := Top.Next;
Ent := Top;
if Top.Next /= null then
-- There are more in same FIFO queue, just return now
Top.Next := null;
return;
end if;
-- This is only entry in this FIFO queue, set Last to null
-- and remove its priority from binary heap
FIFO_Queues(Top_Prio).Last := null;
-- Get priority from bottom of heap to sift down
Prio_To_Sift := Heap(Num_In_Heap);
-- Replace it with min-prio to allow us to ignore
-- special case when parent has exactly one child.
Heap(Num_In_Heap) := Min_Prio;
-- Shorten the heap
Num_In_Heap := Num_In_Heap - 1;
if Num_In_Heap = 0 then
-- All done if heap now empty
return;
end if;
-- Start at top of heap
Parent := 1;
-- Calculate limit on parent (to avoid overflow on
-- child calculation).
Parent_Limit := Num_In_Heap / 2;
-- Loop until reach bottom of heap,
-- or prio-to-sift > both children
while Parent <= Parent_Limit loop
-- Determine larger "child"
Child := Parent * 2;
if Heap(Child + 1) > Heap(Child) then
-- 2*N+1 child is larger than 2*N child
Child := Child + 1;
end if;
exit when Prio_To_Sift >= Heap(Child);
-- All done when found slot for prio-to-sift
-- Move larger child up, and iterate
Heap(Parent) := Heap(Child);
Parent := Child;
end loop;
-- ASSERT: Prio_To_Sift > both children (2*Parent, 2*Parent+1)
-- or slot has no children
-- Put prio in its new slot
Heap(Parent) := Prio_To_Sift;
end Remove_Top_Prio;
function Top_Prio return Queue_Entry is
-- Return pointer to entry with highest priority (leave in queue)
-- Returns null if queue is empty.
begin
if Num_In_Heap = 0 then
return null;
else
return FIFO_Queues(Heap(Heap'First)).First;
end if;
end Top_Prio;
function Is_Empty return Boolean is
-- Return true if queue is empty
begin
return Num_In_Heap = 0;
end Is_Empty;
end Priority_Queue;
^ permalink raw reply [flat|nested] 4+ messages in thread